From: minima Date: Sun, 22 Jul 2001 10:25:22 +0000 (+0000) Subject: added gtkconsole X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=3b0eeaaa6152345bcd42380e385c04fb7e50a064;p=spider.git added gtkconsole started some work on spot statistics --- diff --git a/Changes b/Changes index 49a4de6d..3bf65f20 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,11 @@ +21Jul01======================================================================= +1. started a gtkconsole program. It appears to sort of work. Requires Gtk- +Perl-0.7007. 19Jul01======================================================================= 1. changes to Admin Manual to reflect route filtering. Some alterations to the help files (g0vgs) +09Jul01======================================================================= +1. fix cron so that it allows stuff to be executed on the hour (ie min=0) 06Jul01======================================================================= 1. fix talk and routing problems to mycall 2. add unset/privilege command to relinquish any sysop privileges you might diff --git a/cmd/crontab b/cmd/crontab index d385a844..5ebf80c7 100644 --- a/cmd/crontab +++ b/cmd/crontab @@ -6,3 +6,5 @@ # for doing connections and things # 1 0 * * 0 DXUser::export("$main::data/user_asc") +0 3 * * * Spot::daily() + diff --git a/gtkconsole/DebugHandler.pm b/gtkconsole/DebugHandler.pm new file mode 100644 index 00000000..f6e51d37 --- /dev/null +++ b/gtkconsole/DebugHandler.pm @@ -0,0 +1,115 @@ +# +# Gtk Handler for Debug Files +# + +package DebugHandler; + +use strict; + +use Gtk; +use DXVars; +use DXLog; +use DXUtil; + +use vars qw(@ISA); +@ISA = qw(Gtk::Window); + +sub new +{ + my $pkg = shift; + my $parent = shift; + my $regexp = shift || ''; + my $nolines = shift || 1; + + my $self = new Gtk::Window; + bless $self, $pkg; + $self->set_default_size(400, 400); + $self->set_transient_for($parent) if $parent; + $self->signal_connect('destroy', sub {$self->destroy} ); + $self->signal_connect('delete_event', sub {$self->destroy; return undef;}); + $self->set_title("Debug Output - $regexp"); + $self->border_width(0); + $self->show; + + my $box1 = new Gtk::VBox(0, 0); + $self->add($box1); + $box1->show; + + my $swin = new Gtk::ScrolledWindow(undef, undef); + $swin->set_policy('automatic', 'automatic'); + $box1->pack_start($swin, 1, 1, 0); + $swin->show; + + my $button = new Gtk::Button('close'); + $button->signal_connect('clicked', sub {$self->destroy}); + $box1->pack_end($button, 0, 1, 0); + $button->show; + + my $clist = new_with_titles Gtk::CList('Time', 'Data'); + $swin->add($clist); + $clist->show; + + $self->{fp} = DXLog::new('debug', 'dat', 'd'); + + my @today = Julian::unixtoj(time); + my $fh = $self->{fh} = $self->{fp}->open(@today); + $fh->seek(0, 2); + $self->{regexp} = $regexp if $regexp; + $self->{nolines} = $nolines; + $self->{clist} = $clist; + + $self->{id} = Gtk::Gdk->input_add($fh->fileno, ['read'], sub {$self->handleinp(@_); 1;}, $fh); + + $self->show_all; + return $self; +} + +sub destroy +{ + my $self = shift; + $self->{fp}->close; + Gtk::Gdk->input_remove($self->{id}); + delete $self->{clist}; +} + +sub handleinp +{ + my ($self, $socket, $fd, $flags) = @_; + if ($flags->{read}) { + my $offset = exists $self->{rbuf} ? length $self->{rbuf} : 0; + my $l = sysread($socket, $self->{rbuf}, 1024, $offset); + if (defined $l) { + if ($l) { + while ($self->{rbuf} =~ s/^([^\015\012]*)\015?\012//) { + my $line = $1; + if ($self->{regexp}) { + push @{$self->{prev}}, $line; + shift @{$self->{prev}} while @{$self->{prev}} > $self->{nolines}; + if ($line =~ m{$self->{regexp}}oi) { + $self->printit(@{$self->{prev}}); + @{$self->{prev}} = []; + } + } else { + $self->printit($line); + } + } + } + } + } +} + +sub printit +{ + my $self = shift; + my $clist = $self->{clist}; + while (@_) { + my $line = shift; + $line =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02X", ord($1))/eg; + my @line = split /\^/, $line, 2; + my $t = shift @line; + my ($sec,$min,$hour) = gmtime((defined $t) ? $t : time); + my $buf = sprintf "%02d:%02d:%02d", $hour, $min, $sec; + $clist->append($buf, @line); + } +} +1; diff --git a/gtkconsole/Text.pm b/gtkconsole/Text.pm new file mode 100644 index 00000000..f3b7debc --- /dev/null +++ b/gtkconsole/Text.pm @@ -0,0 +1,50 @@ +# +# create a text area with scroll bars +# +# Copyright (c) 2001 Dirk Koopman G1TLH +# +# $Id$ +# + +package Text; + +use strict; +use Gtk; + +use vars qw(@ISA); +@ISA = qw(Gtk::Text); + +sub new +{ + my $pkg = shift; + my ($vbar, $hbar) = @_; + + my $font = Gtk::Gdk::Font->load("-misc-fixed-medium-r-normal-*-*-130-*-*-c-*-koi8-r"); + my $text = new Gtk::Text(undef,undef); + $text->show; + my $vscroll = new Gtk::VScrollbar($text->vadj); + $vscroll->show; + my $box = new Gtk::HBox(); + $box->add($text); + $box->pack_start($vscroll, 0,0,0); + $box->show; + + my $self = bless $box, $pkg; + $self->{text} = $text; + $self->{text}->{font} = $font; + return $self; +} + +sub destroy +{ + my $self = shift; + delete $self->{text}->{font}; + delete $self->{text}; +} + +sub text +{ + return shift->{text}; +} + +1; diff --git a/gtkconsole/gtkconsole b/gtkconsole/gtkconsole new file mode 100755 index 00000000..e67ff0c9 --- /dev/null +++ b/gtkconsole/gtkconsole @@ -0,0 +1,200 @@ +#!/usr/bin/perl -w +# +# A GTK based console program +# +# Copyright (c) 2001 Dirk Koopman G1TLH +# +# $Id$ +# + +# search local then perl directories +BEGIN { + # root of directory tree for this system + $root = "/spider"; + $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; + + unshift @INC, "$root/perl"; # this IS the right way round! + unshift @INC, "$root/local"; +} + +use strict; + +use vars qw(@modules); + +@modules = (); # is the list of modules that need init calling + # on them. It is set up by each 'use'ed module + # that has Gtk stuff in it + +use DXVars; +use IO::Socket::INET; +use Gtk qw(-init); +use Text; +use DebugHandler; + +# +# main initialisation +# +my $call = uc shift @ARGV if @ARGV; +$call = uc $main::myalias unless $call; +my ($scall, $ssid) = split /-/, $call; +$ssid = undef unless $ssid && $ssid =~ /^\d+$/; +if ($ssid) { + $ssid = 15 if $ssid > 15; + $call = "$scall-$ssid"; +} + +die "You cannot connect as your cluster callsign ($main::mycall)\n" if $call eq $main::mycall; + + +my $sock = IO::Socket::INET->new(PeerAddr=>$main::clusteraddr, PeerPort=>$main::clusterport); +die "Cannot connect to $main::clusteraddr/$main::clusterport ($!)\n" unless $sock; +sendmsg('A', 'local'); + +# +# start of GTK stuff +# + + +# main window +my $main = new Gtk::Window('toplevel'); +$main->set_default_size(600, 600); +$main->set_policy(0, 1, 0); +$main->signal_connect('destroy', sub { Gtk->exit(0); }); +$main->signal_connect('delete_event', sub { Gtk->exit(0); }); +$main->set_title("gtkconsole - The DXSpider Console - $call"); + +# the main vbox +my $vbox = new Gtk::VBox(0, 1); +$vbox->border_width(1); +$main->add($vbox); +$vbox->show; + +# the menu bar +my @menu = ( + {path => '/_File', type => ''}, + {path => '/_File/Quit', callback => sub {Gtk->exit(0)}}, + {path => '/_Help', type => ''}, + {path => '/_Help/About'}, + ); +my $accel = new Gtk::AccelGroup(); +my $itemf = new Gtk::ItemFactory('Gtk::MenuBar', '
', $accel); +$itemf->create_items(@menu); +$main->add_accel_group($accel); +my $menu = $itemf->get_widget('
'); +$vbox->pack_start($menu, 0, 1, 0); +$menu->show; + +# create a vertically paned window and stick it in the bottom of the screen +my $paned = new Gtk::VPaned; +$vbox->pack_end($paned, 1, 1, 0); + +my $top = new Text(1); +my $toplist = $top->text; +$toplist->set_editable(0); +$paned->pack1($top, 1, 1); + +# add the handler for incoming messages from the node +my $tophandler = Gtk::Gdk->input_add($sock->fileno, ['read'], \&tophandler, $sock); +my $rbuf = ""; # used in handler + +# the bottom handler +my $bot = new Text(1); +my $botlist = $bot->text; +$botlist->set_editable(1); +$botlist->signal_connect('activate', \&bothandler); +$botlist->can_focus(1); +$botlist->can_default(1); +$botlist->grab_focus; +$botlist->grab_default; +$toplist->{signalid} = $toplist->signal_connect(insert_text => \&doinsert); +$paned->pack2($bot, 0, 1); +$paned->show; + +# the main loop +$main->show_all; +Gtk->main; + +# +# handlers +# + +sub doinsert { + my ($self, $text) = @_; + + # we temporarily block this handler to avoid recursion + $self->signal_handler_block($self->{signalid}); + my $pos = $self->insert($self->{font}, undef, undef, $text); + $self->signal_handler_unblock($self->{signalid}); + + # we already inserted the text if it was valid: no need + # for the self to process this signal emission + $self->signal_emit_stop_by_name('insert-text'); + $self->signal_emit('activate') if $text eq "\n"; + 1; +} + +sub bothandler +{ + my ($self, $data) = @_; + my ($msg) = $self->get_chars =~ /([^\n]*)\r?\n$/; + $msg ||= ''; + senddata($msg); +} + +sub tophandler +{ + my ($socket, $fd, $flags) = @_; + if ($flags->{read}) { + my $offset = length $rbuf; + my $l = sysread($socket, $rbuf, 1024, $offset); + if (defined $l) { + my $freeze; + if ($l) { + while ($rbuf =~ s/^([^\015\012]*)\015?\012//) { + my $msg = $1; + $msg =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; + $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g; # immutable CSI sequence + control characters + $toplist->freeze unless $freeze++; + handlemsg($msg); + } + if ($freeze) { + $toplist->thaw; + $toplist->vadj->set_value($toplist->vadj->upper); + $toplist->vadj->value_changed; + } + } else { + Gtk->exit(0); + } + } else { + Gtk->exit(0); + } + } +} + +sub handlemsg +{ + my $msg = shift; + my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/; + if ($sort eq 'D') { + $toplist->insert($toplist->{font}, undef, undef, "$line\n"); + } elsif ($sort eq 'Z') { + Gtk->exit(0); + } +} + +# +# subroutine +# + +sub senddata +{ + my $msg = shift; + sendmsg('I', $msg); +} + +sub sendmsg +{ + my ($let, $msg) = @_; + $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; + $sock->print("$let$call|$msg\n"); +} diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 589dd246..870c395e 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -16,9 +16,8 @@ use IO::File; use strict; -use vars qw{@crontab $mtime $lasttime $lastmin}; +use vars qw{@crontab @lcrontab @scrontab $mtime $lasttime $lastmin}; -@crontab = (); $mtime = 0; $lasttime = 0; $lastmin = 0; @@ -33,13 +32,11 @@ sub init if ((-e $localfn && -M $localfn < $mtime) || (-e $fn && -M $fn < $mtime) || $mtime == 0) { my $t; - @crontab = (); - # first read in the standard one if (-e $fn) { $t = -M $fn; - cread($fn); + @scrontab = cread($fn); $mtime = $t if !$mtime || $t <= $mtime; } @@ -47,9 +44,10 @@ sub init if (-e $localfn) { $t = -M $localfn; - cread($localfn); + @lcrontab = cread($localfn); $mtime = $t if $t <= $mtime; } + @crontab = (@scrontab, @lcrontab); } } @@ -59,6 +57,7 @@ sub cread my $fn = shift; my $fh = new IO::File; my $line = 0; + my @out; dbg("cron: reading $fn\n") if isdbg('cron'); open($fh, $fn) or confess("cron: can't open $fn $!"); @@ -67,7 +66,7 @@ sub cread chomp; next if /^\s*#/o or /^\s*$/o; my ($min, $hour, $mday, $month, $wday, $cmd) = /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.+)$/o; - next if !$min; + next unless defined $min; my $ref = bless {}; my $err; @@ -78,13 +77,14 @@ sub cread $err |= parse($ref, 'wday', $wday, 0, 6, "sun", "mon", "tue", "wed", "thu", "fri", "sat"); if (!$err) { $ref->{cmd} = $cmd; - push @crontab, $ref; + push @out, $ref; dbg("cron: adding $_\n") if isdbg('cron'); } else { dbg("cron: error on line $line '$_'\n") if isdbg('cron'); } } close($fh); + return @out; } sub parse diff --git a/perl/DXLog.pm b/perl/DXLog.pm index 9f15c225..80336e3e 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -88,6 +88,16 @@ sub open return $self->{fh}; } +sub mtime +{ + my ($self, $year, $thing) = @_; + + my $fn = sprintf "$self->{prefix}/$year/%02d", $thing if $self->{'sort'} eq 'm'; + $fn = sprintf "$self->{prefix}/$year/%03d", $thing if $self->{'sort'} eq 'd'; + $fn .= ".$self->{suffix}" if $self->{suffix}; + return (stat $fn)[9]; +} + # open the previous log file in sequence sub openprev { diff --git a/perl/Spot.pm b/perl/Spot.pm index 8e836678..074ae740 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -16,11 +16,13 @@ use DXLog; use Julian; use Prefix; use DXDupe; +use Data::Dumper; use strict; -use vars qw($fp $maxspots $defaultspots $maxdays $dirprefix $duplth $dupage $filterdef); +use vars qw($fp $statp $maxspots $defaultspots $maxdays $dirprefix $duplth $dupage $filterdef); $fp = undef; +$statp = undef; $maxspots = 50; # maximum spots to return $defaultspots = 10; # normal number of spots to return $maxdays = 100; # normal maximum no of days to go back @@ -88,6 +90,7 @@ sub init { mkdir "$dirprefix", 0777 if !-e "$dirprefix"; $fp = DXLog::new($dirprefix, "dat", 'd'); + $statp = DXLog::new($dirprefix, "bys", 'd'); } sub prefix @@ -313,6 +316,87 @@ sub listdups { return DXDupe::listdups('X', $dupage, @_); } + +sub genstats +{ + my @date = @_; + my $in = $fp->open(@date); + my $out = $statp->open(@date, 'w'); + my @freq = ( + [0, Bands::get_freq('160m')], + [1, Bands::get_freq('80m')], + [2, Bands::get_freq('40m')], + [3, Bands::get_freq('30m')], + [4, Bands::get_freq('20m')], + [5, Bands::get_freq('17m')], + [6, Bands::get_freq('15m')], + [7, Bands::get_freq('12m')], + [8, Bands::get_freq('10m')], + [9, Bands::get_freq('6m')], + [10, Bands::get_freq('4m')], + [11, Bands::get_freq('2m')], + [12, Bands::get_freq('70cm')], + [13, Bands::get_freq('13cm')], + [14, Bands::get_freq('9cm')], + [15, Bands::get_freq('6cm')], + [16, Bands::get_freq('3cm')], + [17, Bands::get_freq('12mm')], + [18, Bands::get_freq('6cm')], + ); + my %list; + my @tot; + + if ($in && $out) { + while (<$in>) { + chomp; + my ($freq, $by, $dxcc) = (split /\^/)[0,4,6]; + my $ref = $list{$by} || [0, $dxcc]; + for (@freq) { + if ($freq >= $_->[1] && $freq <= $_->[2]) { + $$ref[$_->[0]+2]++; + $tot[$_->[0]+2]++; + $$ref[0]++; + $tot[0]++; + $list{$by} = $ref; + last; + } + } + } + + my $i; + for ($i = 0; $i < @freq+2; $i++) { + $tot[$i] ||= 0; + } + $out->write(join('^', 'TOTALS', @tot) . "\n"); + + for (sort {$list{$b}->[0] <=> $list{$a}->[0]} keys %list) { + my $ref = $list{$_}; + my $call = $_; + for ($i = 0; $i < @freq+2; ++$i) { + $ref->[$i] ||= 0; + } + $out->write(join('^', $call, @$ref) . "\n"); + } + $out->close; + } +} + +# return true if the stat file is newer than than the spot file +sub checkstats +{ + my @date = @_; + my $in = $fp->mtime(@date); + my $out = $statp->mtime(@date); + return defined $out && defined $in && $out >= $in; +} + +# daily processing +sub daily +{ + my @date = Julian::unixtoj($main::systime); + @date = Julian::sub(@date, 1); + genstats(@date) unless checkstats(@date); +} 1;