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