gtkconsole/gtkconsole

   1 #!/usr/bin/perl -w
   2 #
   3 # A GTK based console program
   4 #
   5 # usage: gtkconsole [<callsign>] [<host> <port>]
   6 #
   7 # Copyright (c) 2006-2007 Dirk Koopman G1TLH
   8 #
   9 #
  10 #
  11
  12 use strict;
  13
  14 our $VERSION = '$Revision$';
  15 $VERSION =~ s|[^\d\.]+||g;
  16
  17 our $root;
  18
  19 # search local then perl directories
  20 BEGIN {
  21         # root of directory tree for this system
  22         $root = "/spider";
  23         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  24 }
  25
  26 use Glib;
  27 use Gtk2 qw(-init);
  28 use Gtk2::Helper;
  29 use Gtk2::SimpleMenu;
  30 use Data::Dumper;
  31 use IO::File;
  32
  33 use Screen;
  34
  35 use vars qw(@modules $font);
  36
  37 @modules = ();                                  # is the list of modules that need init calling
  38                                                                 # on them. It is set up by each  'use'ed module
  39                                                                 # that has Gtk stuff in it
  40 use IO::Socket::INET;
  41
  42 our @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  43
  44 # various GTK handles
  45 our $main;                                              # the main screen
  46 our $scr_width;                                 # calculated screen dimensions
  47 our $scr_height;
  48 our ($dx, $cmd, $ann, $wcy, $wwv, $chat); # scrolling list windows
  49 our $bot;                                               # the cmd entry window
  50 our $date;                                              # the current date
  51
  52 # other windows
  53 our $annwin;                                    # the announcement window handle
  54 our $dxwin;                                             # the dx spot window handle
  55 our $wwvwin;                                    # wwv window handle
  56 our $wcywin;                                    # wcy window handle
  57 our $chatwin;                                   # chat window handle
  58
  59 require "$root/local/DXVars.pm" if -e "$root/local/DXVars.pm";
  60
  61 # read in the user data
  62 our $userfn = "$ENV{HOME}/.gtkconsole_data";
  63 our $user = read_user_data();
  64 our $call;
  65 our $passwd;
  66 our $host = 'localhost';
  67 our $port = 7300;
  68
  69 #
  70 # read in gtkconsole file
  71 #
  72
  73 Gtk2::Rc->set_default_files("$root/gtkconsole/gtkconsolerc", "$ENV{HOME}/.gtkconsolerc", ".gtkconsolerc");
  74 Gtk2::Rc->reparse_all;
  75
  76 # sort out a callsign, host and port, looking in order
  77 #  1. the command line
  78 #  2. any defaults in the user data;
  79 #  3. poke about in any spider tree that we can find
  80 #
  81
  82 if (@ARGV) {
  83         $call = uc shift @ARGV;
  84         $host = shift @ARGV if @ARGV;
  85         $port = shift @ARGV if @ARGV;
  86 }
  87
  88 unless ($call) {
  89         $call = $main::myalias;
  90 }
  91
  92 unless ($host) {
  93         my $node = $user->{clusters}->{$user->{node}};
  94
  95         if ($node->{call} || $user->{call}) {
  96                 $host = $node->{host};
  97                 $port ||= $node->{port};
  98         }
  99
 100         unless ($host) {
 101                 if (-e "$root/local/Listeners.pm") {
 102                         require  "$root/local/Listeners.pm";
 103                         $host = $main::listen->[0]->[0];
 104                         $port = $main::listen->[0]->[1];
 105                         $host ||= '127.0.0.1';
 106                         $host = "127.0.0.1" if !$host && ($host eq '0.0.0.0' || $host eq '::');
 107                         $port ||= 7300;
 108                 }
 109         }
 110 }
 111
 112 $call ||= '';
 113 $host ||= '';
 114 $port ||= '';
 115 die "You need a callsign ($call), a hostname($host) and a port($port) to proceed" unless $call && $host && $port;
 116
 117 #
 118 # start of GTK stuff
 119 #
 120
 121 gtk_create_main_screen();
 122
 123 $main->set_title("gtkconsole $VERSION - DXSpider Console - $call \@ $host:$port");
 124
 125 # connect and send stuff
 126 my $sock = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port);
 127 die "Cannot connect to  $/$port ($!)\n" unless $sock;
 128 sendmsg($call);
 129 sendmsg($passwd) if $passwd;
 130 sendmsg('set/gtk');
 131 sendmsg('set/page 500');
 132 sendmsg('set/nobeep');
 133
 134 my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock);
 135
 136 # the main loop
 137 $main->show_all;
 138 $bot->grab_focus;
 139 Gtk2->main;
 140 exit(0);
 141
 142 #
 143 # handlers
 144 #
 145
 146 sub updatetime
 147 {
 148         $_[0]->set_text(cldatetime(time));
 149         1;
 150 }
 151
 152 sub bothandler
 153 {
 154         my ($self, $data) = @_;
 155         my $msg = $self->get_text;
 156         $msg =~ s/\r?\n$//;
 157         $self->set_text('');
 158         $self->grab_focus;
 159         sendmsg($msg);
 160 }
 161
 162 my $rbuf = '';
 163
 164 sub tophandler
 165 {
 166         my ($fd, $condx, $socket) = @_;
 167
 168         my $offset = defined $rbuf ? length $rbuf : 0;
 169         my $l = sysread($socket, $rbuf, 1024, $offset);
 170         if (defined $l) {
 171                 if ($l) {
 172                         while ($rbuf =~ s/^([^\015\012]*)\015?\012//) {
 173                                 my $msg = $1;
 174                                 handlemsg($msg);
 175                         }
 176                 } else {
 177                         Gtk2->main_quit;
 178                 }
 179         } else {
 180                 Gtk2->main_quit;
 181         }
 182         1;
 183
 184 }
 185
 186 sub handlemsg
 187 {
 188         my $line = shift;
 189
 190         # this is truely evil and I bet there is a better way...
 191         chomp $line;
 192         my $list;
 193         if ($line =~ /^'\w{2,4}',/) {
 194                 $list = eval qq([$line]);
 195         } else {
 196                 $list = ['cmd', $line];
 197         }
 198         unless ($@) {
 199                 no strict 'refs';
 200                 my $cmd = shift @$list;
 201                 my $handle = "handle_$cmd";
 202                 if (__PACKAGE__->can($handle)) {
 203                         __PACKAGE__->$handle($list);
 204                 } else {
 205                         unshift @$list, $cmd;
 206                         __PACKAGE__->handle_def($list);
 207                 }
 208         }
 209 }
 210
 211 sub handle_cmd
 212 {
 213         my $self = shift;
 214         my $ref = shift;
 215         my ($t, $ts) = (time, '');
 216         my $s;
 217         $s = ref $ref ? join ', ',@$ref : $ref;
 218
 219         if (($cmd->{lasttime}||0) != $t) {
 220                 $ts = tim($t);
 221                 $cmd->{lasttime} = $t;
 222         }
 223
 224         chomp $s;
 225         $cmd->add_data([$ts,  $s]);
 226 }
 227
 228 sub handle_def
 229 {
 230         my $self = shift;
 231         my $ref = shift;
 232         my ($t, $ts) = (time, '');
 233         my $s;
 234         $s = ref $ref ? join(', ', @$ref) : $ref;
 235         if (($cmd->{lasttime}||0) != $t) {
 236                 $ts = tim($t);
 237                 $cmd->{lasttime} = $t;
 238         }
 239         $cmd->add_data([$ts,  $s]);
 240 }
 241
 242 sub handle_dx
 243 {
 244         my $self = shift;
 245         my $ref = shift;
 246         my ($t, $ts) = (time, '');
 247
 248         if (($dx->{lasttime}||0) != $t) {
 249                 $ts = tim($t);
 250                 $dx->{lasttime} = $t;
 251         }
 252         $dx->add_data([$ts,  @$ref[0,1,15,3,4,16], stim($ref->[2]) ]);
 253         $dxwin->show_all;
 254 }
 255
 256 sub handle_ann
 257 {
 258         my $self = shift;
 259         my $ref = shift;
 260         my ($t, $ts) = (time, '');
 261 #       my $s;
 262 #       $s = ref $ref ? (join ', ',@$ref) : $ref;
 263
 264         if (($ann->{lasttime}||0) != $t) {
 265                 $ts = tim($t);
 266                 $ann->{lasttime} = $t;
 267         }
 268
 269 #       chomp $s;
 270         $ann->add_data([$ts,  @$ref[3,1,2]]);
 271         $annwin->show_all;
 272 }
 273
 274 sub handle_wcy
 275 {
 276         my $self = shift;
 277         my $ref = shift;
 278 #       my $s;
 279 #       $s = ref $ref ? join ', ',@$ref : $ref;
 280
 281 #       chomp $s;
 282
 283         $wcy->add_data([tim(),  @$ref[10,4,5,3,6,2,7,8,9,1] ]);
 284         $wcywin->show_all;
 285 }
 286
 287 sub handle_wwv
 288 {
 289         my $self = shift;
 290         my $ref = shift;
 291 #       my $s;
 292 #       $s = ref $ref ? join ', ',@$ref : $ref;
 293
 294 #       chomp $s;
 295         $wwv->add_data([tim(),  @$ref[6,2,3,4,5,1] ]);
 296         $wwvwin->show_all;
 297 }
 298
 299
 300 sub handle_chat
 301 {
 302         my $self = shift;
 303         my $ref = shift;
 304         my ($t, $ts) = (time, '');
 305         my $s;
 306         $s = ref $ref ? (join ', ',@$ref) : $ref;
 307
 308         if (($ann->{lasttime}||0) != $t) {
 309                 $ts = tim($t);
 310                 $ann->{lasttime} = $t;
 311         }
 312
 313         chomp $s;
 314         $chat->add_data([$ts,  @$ref[3,1,2]]);
 315         $chatwin->show_all;
 316 }
 317
 318
 319
 320 #
 321 # subroutine
 322 #
 323
 324 sub sendmsg
 325 {
 326         my $msg = shift;
 327         $sock->print("$msg\n");
 328 }
 329
 330 sub tim
 331 {
 332         my $t = shift || time;
 333         return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0];
 334 }
 335
 336 sub stim
 337 {
 338         my $t = shift || time;
 339         return sprintf "%02d:%02d", (gmtime($t))[2,1];
 340 }
 341
 342 # get a zulu time in cluster format (2300Z)
 343 sub ztime
 344 {
 345         my $t = shift;
 346         $t = defined $t ? $t : time;
 347         my $dst = shift;
 348         my ($sec,$min,$hour) = $dst ? localtime($t): gmtime($t);
 349         my $buf = sprintf "%02d%02d%s", $hour, $min, ($dst) ? '' : 'Z';
 350         return $buf;
 351 }
 352
 353 # get a cluster format date (23-Jun-1998)
 354 sub cldate
 355 {
 356         my $t = shift;
 357         $t = defined $t ? $t : time;
 358         my $dst = shift;
 359         my ($sec,$min,$hour,$mday,$mon,$year) = $dst ? localtime($t) : gmtime($t);
 360         $year += 1900;
 361         my $buf = sprintf "%2d-%s-%04d", $mday, $month[$mon], $year;
 362         return $buf;
 363 }
 364
 365 # return a cluster style date time
 366 sub cldatetime
 367 {
 368         my $t = shift;
 369         my $dst = shift;
 370         my $date = cldate($t, $dst);
 371         my $time = ztime($t, $dst);
 372         return "$date $time";
 373 }
 374
 375 sub read_user_data
 376 {
 377         my $u;
 378
 379         if (-e $userfn) {
 380                 my $fh = new IO::File $userfn;
 381                 my $s = undef;
 382                 if ($fh) {
 383                         local $/ = undef;
 384                         $s = <$fh>;
 385                         $fh->close;
 386                 }
 387                 eval "\$u = $s";
 388         }
 389         unless ($u) {
 390                 print "$userfn missing or unreadable, starting afresh!\n";
 391
 392                 $u = {
 393                           clusters => {
 394                                                    'LOCAL' => {host => '127.0.0.1', port => 7300},
 395                                                    'GB7DJK' => {host => 'gb7djk.dxcluster.net', port => 7300},
 396                                                    'WR3D' => {host => 'wr3d.dxcluster.net', port => 7300},
 397                                                    'GB7BAA' => {host => 'gb7baa.dxcluster.net', port => 7300},
 398                                                   },
 399                           node => 'LOCAL',
 400                           call => $main::myalias,
 401                          };
 402                 write_user_data($u);
 403         }
 404         return $u;
 405 }
 406
 407 sub write_user_data
 408 {
 409         my $u = shift;
 410
 411         my $fh = new IO::File ">$userfn";
 412         if ($fh) {
 413                 my $dd = new Data::Dumper([ $u ]);
 414                 $dd->Indent(1);
 415                 $dd->Quotekeys(0);
 416                 $fh->print($dd->Dumpxs);
 417                 $fh->close;
 418                 return 1;
 419         }
 420         return 0;
 421 }
 422
 423 sub def_menu_callback
 424 {
 425
 426 }
 427
 428 sub gtk_create_main_screen
 429 {
 430         $main = new Gtk2::Window('toplevel');
 431         my $scr = $main->get_screen;
 432         $scr_width = $scr->get_width;
 433         $scr_width = 700 if $scr_width > 700;
 434         $scr_height = int ($scr->get_height * 0.66);
 435         $main->set_default_size($scr_width, $scr_height);
 436         $main->signal_connect('delete_event', sub { Gtk2->main_quit; });
 437
 438         # the main vbox
 439         my $vbox = new Gtk2::VBox(0, 1);
 440         $main->add($vbox);
 441
 442         my $menutree = [
 443                                         _File => {
 444                                                           item_type => '<Branch>',
 445                                                           children => [
 446                                                                                    _Quit => {
 447                                                                                                          callback => sub { Gtk2->main_quit; },
 448                                                                                                          callback_action => 1,
 449                                                                                                          accelerator => '<ctrl>Q',
 450                                                                                                         }
 451                                                                                   ],
 452                                                          },
 453
 454                                         _Help => {
 455                                                           item_type => '<Branch>',
 456                                                           children => [
 457                                                                                    _About => {
 458                                                                                                           callback_action => 9,
 459                                                                                                          },
 460                                                                                   ],
 461                                                          },
 462
 463                                    ];
 464
 465         my $menu = Gtk2::SimpleMenu->new(menu_tree => $menutree, default_callback => \&def_menu_callback, user_data => $user);
 466         $vbox->pack_start($menu->{widget}, 0, 1, 0);
 467
 468
 469         # a paned hbox is packed as the bottom of the vbox
 470 #       my $bhpane = Gtk2::HPaned->new;
 471 #       $vbox->pack_end($bhpane, 1, 1, 0);
 472
 473         # now create the lh and rh panes
 474 #       my $lhvpane = Gtk2::VPaned->new;
 475 #       my $rhvpane = Gtk2::VPaned->new;
 476 #       $bhpane->pack1($lhvpane, 1, 0);
 477 #       $bhpane->pack2($rhvpane, 1, 0);
 478
 479
 480         # The command list
 481 #       my $lhvbox = Gtk2::VBox->new(0, 1);
 482         $cmd = Screen::List->new(fields => [
 483                                                                                 RxTime => 'tt',
 484                                                                                 Information => 'ttlong',
 485                                                                            ],
 486                                                          size => [$scr_width, $scr_height * 0.66],
 487                                                         );
 488         $vbox->pack_start($cmd->widget, 1, 1, 0);
 489
 490
 491         # callsign and current date and time
 492         my $hbox = new Gtk2::HBox;
 493         my $calllabel = new Gtk2::Label($call);
 494         my $date = new Gtk2::Label(cldatetime(time));
 495         $date->{tick} = Glib::Timeout->add(1000, \&updatetime, $date);
 496         $hbox->pack_start( $calllabel, 0, 1, 0 );
 497         $hbox->pack_end($date, 0, 1, 0);
 498         $vbox->pack_start($hbox, 0, 1, 0);
 499         $vbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0);
 500
 501         # the bottom handler
 502         $bot = new Gtk2::Entry;
 503         $bot->set_editable(1);
 504         $bot->signal_connect('activate', \&bothandler);
 505         $bot->can_default(1);
 506         $vbox->pack_end($bot, 0, 1, 0);
 507 #       $lhvpane->pack2($lhvbox, 1, 0);
 508         $bot->grab_default;
 509
 510         #
 511         #
 512         #
 513
 514         #
 515         # The announce list
 516         $annwin = new Gtk2::Window('toplevel');
 517         $ann = Screen::List->new(fields =>[
 518                                                                            RxTime => 'tt',
 519                                                                            From => 'tt',
 520                                                                            To => 'tt',
 521                                                                            Announcement => 'ttlesslong',
 522                                                                           ],
 523                                                          hint => 1,
 524                                                          frame => 'Announcements',
 525                                                          size => [$scr_width * 0.85, $scr_height * 0.25],
 526                                                         );
 527         $annwin->add($ann->widget);
 528 #       $annwin->show_all;
 529
 530         # The announce list
 531         $chatwin = new Gtk2::Window('toplevel');
 532         $chat = Screen::List->new(fields =>[
 533                                                                            RxTime => 'tt',
 534                                                                            From => 'tt',
 535                                                                            To => 'tt',
 536                                                                            Chat => 'ttlesslong',
 537                                                                           ],
 538                                                          hint => 1,
 539                                                          frame => 'Chat',
 540                                                          size => [$scr_width * 0.85, $scr_height * 0.25],
 541                                                         );
 542         $chatwin->add($chat->widget);
 543 #       $annwin->show_all;
 544
 545         # DX window
 546         $dxwin = new Gtk2::Window('toplevel');
 547         $dx = Screen::List->new(fields => [
 548                                                                            'RxTime' => 'tt',
 549                                                                            'QRG' => 'qrg',
 550                                                                            'DX Call' => 'tt',
 551                                                                            'Grid' => 'tt',
 552                                                                            'Remarks' => 'ttshort',
 553                                                                            'By' => 'tt',
 554                                                                            'Grid' => 'tt',
 555                                                                            'TxTime' => 'tt',
 556                                                                           ],
 557                                                         policy => [qw(never automatic)],
 558                                                         hint => 1,
 559                                                         frame => "DX Spots",
 560                                                         maxsize => 500,
 561                                                         size => [$scr_width * 0.9, $scr_height * 0.25],
 562                                                    );
 563 #       $rhvpane->pack1($dx->widget, 1, 0);
 564         $dxwin->add($dx->widget);
 565 #       $dxwin->show_all;
 566
 567         # The wwv list
 568         $wwvwin = new Gtk2::Window('toplevel');
 569         #       my $rhvbox = Gtk2::VBox->new(0, 1);
 570         $wwv = Screen::List->new( fields =>[
 571                                                                                 RxTime => 'tt',
 572                                                                                 From => 'tt',
 573                                                                                 SFI => 'int',
 574                                                                                 A => 'int',
 575                                                                                 K => 'int',
 576                                                                                 Remarks => 'ttshort',
 577                                                                                 Hour => 'tt'
 578                                                                            ],
 579                                                           hint => 1,
 580                                                           policy => ['never', 'automatic'],
 581                                                           frame => 'WWV Data',
 582                                                         );
 583         $wwvwin->add($wwv->widget);
 584 #       $wwvwin->show_all;
 585
 586 #       $rhvbox->pack_start($wwv->widget, 1, 1, 0);
 587
 588         # The wcy list
 589         $wcywin = new Gtk2::Window('toplevel');
 590         $wcy = Screen::List->new(fields => [
 591                                                                                 RxTime => 'tt',
 592                                                                                 From => 'tt',
 593                                                                                 K => 'int',
 594                                                                                 ExpK => 'int',
 595                                                                                 A => 'int',
 596                                                                                 R => 'int',
 597                                                                                 SFI => 'int',
 598                                                                                 SA => 'tt',
 599                                                                                 GMF => 'tt',
 600                                                                                 Aurora => 'tt',
 601                                                                                 Hour => 'tt'
 602                                                                            ],
 603                                                          hint => 1,
 604                                                          policy => ['never', 'automatic'],
 605                                                          frame => 'WCY Data',
 606                                                         );
 607
 608 #       $rhvbox->pack_start($wcy->widget, 1, 1, 0);
 609 #       $rhvbox->set_size_request($scr_width * 0.45, $scr_height * 0.33);
 610 #       $rhvpane->pack2($rhvbox, 1, 0);
 611         $wcywin->add($wcy->widget);
 612 #       $wcywin->show_all;
 613 }