+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
# for doing connections and things
#
1 0 * * 0 DXUser::export("$main::data/user_asc")
+0 3 * * * Spot::daily()
+
--- /dev/null
+#
+# 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;
--- /dev/null
+#
+# 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;
--- /dev/null
+#!/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 => '<Branch>'},
+ {path => '/_File/Quit', callback => sub {Gtk->exit(0)}},
+ {path => '/_Help', type => '<LastBranch>'},
+ {path => '/_Help/About'},
+ );
+my $accel = new Gtk::AccelGroup();
+my $itemf = new Gtk::ItemFactory('Gtk::MenuBar', '<main>', $accel);
+$itemf->create_items(@menu);
+$main->add_accel_group($accel);
+my $menu = $itemf->get_widget('<main>');
+$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");
+}
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;
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;
}
if (-e $localfn) {
$t = -M $localfn;
- cread($localfn);
+ @lcrontab = cread($localfn);
$mtime = $t if $t <= $mtime;
}
+ @crontab = (@scrontab, @lcrontab);
}
}
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 $!");
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;
$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
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
{
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
{
mkdir "$dirprefix", 0777 if !-e "$dirprefix";
$fp = DXLog::new($dirprefix, "dat", 'd');
+ $statp = DXLog::new($dirprefix, "bys", 'd');
}
sub prefix
{
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;
projects / spider.git / commitdiff