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