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