From 30dbf70f84b53174005810f64f546d2181e1a8c6 Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 5 Jul 1999 22:06:34 +0000 Subject: [PATCH] added stat/cluster and stat/msg commands --- Changes | 3 +++ cmd/merge.pl | 3 ++- cmd/stat/cluster.pl | 24 ++++++++++++++++++++++++ cmd/stat/msg.pl | 24 ++++++++++++++++++++++++ perl/DXChannel.pm | 22 +++++++++++----------- perl/DXCluster.pm | 18 ++++++++++++++---- perl/DXMsg.pm | 22 +++++++++++----------- perl/Messages | 1 + 8 files changed, 90 insertions(+), 27 deletions(-) create mode 100644 cmd/stat/cluster.pl create mode 100644 cmd/stat/msg.pl diff --git a/Changes b/Changes index 3907a654..dfc59e34 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,6 @@ +05Jul99======================================================================= +1. added stat/msg and stat/cluster commands to allow me to poke about inside +the msg and cluster node tables. 04Jul99======================================================================= 1. removed silly 'new message has arrived' to connected nodes if message is 2. added a ! command to the console.pl program; works like the bash shell. diff --git a/cmd/merge.pl b/cmd/merge.pl index c5f31f5a..4e35cb8b 100644 --- a/cmd/merge.pl +++ b/cmd/merge.pl @@ -8,11 +8,12 @@ my ($self, $line) = @_; my @f = split /\s+/, $line; -my $call = uc $f[0]; # check for callsign return (1, $self->msg('e5')) if $self->priv < 5; return (1, $self->msg('e12')) if !$f[0]; + +my $call = uc $f[0]; return (1, $self->msg('e11')) if $call eq $main::mycall; my $ref = DXCluster->get_exact($call); diff --git a/cmd/stat/cluster.pl b/cmd/stat/cluster.pl new file mode 100644 index 00000000..539a1136 --- /dev/null +++ b/cmd/stat/cluster.pl @@ -0,0 +1,24 @@ +# +# show a cluster thingy +# +# $Id$ +# + +my ($self, $line) = @_; +my @list = split /\s+/, $line; # generate a list of callsigns +@list = ($self->call) if !@list; # my channel if no callsigns + +my $call; +my @out; +foreach $call (@list) { + $call = uc $call; + my $ref = DXCluster->get_exact($call); + if ($ref) { + @out = print_all_fields($self, $ref, "Cluster Information $call"); + } else { + push @out, "Cluster: $call not found"; + } + push @out, "" if @list > 1; +} + +return (1, @out); diff --git a/cmd/stat/msg.pl b/cmd/stat/msg.pl new file mode 100644 index 00000000..557170e8 --- /dev/null +++ b/cmd/stat/msg.pl @@ -0,0 +1,24 @@ +# +# show all the values on a message header +# +# $Id$ +# + +my ($self, $line) = @_; +my @list = split /\s+/, $line; # generate a list of msg nos +my @out; + +return (1, $self->msg('e5')) if $self->priv < 5; +return (1, $self->msg('m16')) if @list == 0; + +foreach my $msgno (@list) { + my $ref = DXMsg::get($msgno); + if ($ref) { + @out = print_all_fields($self, $ref, "Msg Parameters $msgno"); + } else { + push @out, $self->msg('m4', $msgno); + } + push @out, "" if @list > 1; +} + +return (1, @out); diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 6495e7a7..f577ded8 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -42,14 +42,14 @@ use vars qw(%channels %valid); user => '9,DXUser ref', startt => '0,Start Time,atime', t => '9,Time,atime', - pc50_t => '9,Last PC50 Time,atime', + pc50_t => '5,Last PC50 Time,atime', priv => '9,Privilege', state => '0,Current State', oldstate => '5,Last State', list => '9,Dep Chan List', name => '0,User Name', - consort => '9,Connection Type', - 'sort' => '9,Type of Channel', + consort => '5,Connection Type', + 'sort' => '5,Type of Channel', wwv => '0,Want WWV,yesno', wx => '0,Want WX,yesno', talk => '0,Want Talk,yesno', @@ -59,20 +59,20 @@ use vars qw(%channels %valid); dx => '0,DX Spots,yesno', redirect => '0,Redirect messages to', lang => '0,Language', - func => '9,Function', + func => '5,Function', loc => '9,Local Vars', # used by func to store local variables in beep => '0,Want Beeps,yesno', - lastread => '9,Last Msg Read', - outbound => '9,outbound?,yesno', + lastread => '5,Last Msg Read', + outbound => '5,outbound?,yesno', remotecmd => '9,doing rcmd,yesno', pagelth => '0,Page Length', pagedata => '9,Page Data Store', group => '0,Access Group,parray', # used to create a group of users/nodes for some purpose or other - isolate => '9,Isolate network,yesno', - delayed => '9,Delayed messages,parray', - annfilter => '9,Announce Filter', - wwvfilter => '9,WWV Filter', - spotfilter => '9,Spot Filter', + isolate => '5,Isolate network,yesno', + delayed => '5,Delayed messages,parray', + annfilter => '5,Announce Filter', + wwvfilter => '5,WWV Filter', + spotfilter => '5,Spot Filter', passwd => '9,Passwd List,parray', ); diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index aee8fe4d..205c30fb 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -17,6 +17,7 @@ package DXCluster; use Exporter; @ISA = qw(Exporter); use DXDebug; +use DXUtil; use Carp; use strict; @@ -25,13 +26,13 @@ use vars qw(%cluster %valid); %cluster = (); # this is where we store the dxcluster database %valid = ( - mynode => '0,Parent Node,showcall', + mynode => '0,Parent Node,DXCluster::showcall', call => '0,Callsign', confmode => '0,Conference Mode,yesno', here => '0,Here?,yesno', - dxchan => '5,Channel ref', + dxchan => '5,Channel ref,DXCluster::showcall', pcversion => '5,Node Version', - list => '5,User List,dolist', + list => '5,User List,DXCluster::dolist', users => '0,No of Users', ); @@ -102,6 +103,14 @@ sub field_prompt my ($self, $ele) = @_; return $valid{$ele}; } +# +# return a list of valid elements +# + +sub fields +{ + return keys(%valid); +} # this expects a reference to a list in a node NOT a ref to a node sub dolist @@ -110,7 +119,8 @@ sub dolist my $out; my $ref; - foreach $ref (@{$self}) { + foreach my $call (keys %{$self}) { + $ref = $$self{$call}; my $s = $ref->{call}; $s = "($s)" if !$ref->{here}; $out .= "$s "; diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 42d5c65e..2028f8b1 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -52,28 +52,28 @@ $badmsgfn = "$msgdir/badmsg.pl"; # list of TO address we wont store $forwardfn = "$msgdir/forward.pl"; # the forwarding table %valid = ( - fromnode => '9,From Node', - tonode => '9,To Node', + fromnode => '5,From Node', + tonode => '5,To Node', to => '0,To', from => '0,From', t => '0,Msg Time,cldatetime', - private => '9,Private', + private => '5,Private', subject => '0,Subject', linesreq => '0,Lines per Gob', - rrreq => '9,Read Confirm', + rrreq => '5,Read Confirm', origin => '0,Origin', lines => '5,Data', stream => '9,Stream No', - count => '9,Gob Linecnt', - file => '9,File?,yesno', - gotit => '9,Got it Nodes,parray', - lines => '9,Lines,parray', - 'read' => '9,Times read', + count => '5,Gob Linecnt', + file => '5,File?,yesno', + gotit => '5,Got it Nodes,parray', + lines => '5,Lines,parray', + 'read' => '5,Times read', size => '0,Size', msgno => '0,Msgno', keep => '0,Keep this?,yesno', - lastt => '9,Last processed,cldatetime', - waitt => '9,Wait until,cldatetime', + lastt => '5,Last processed,cldatetime', + waitt => '5,Wait until,cldatetime', ); sub DESTROY diff --git a/perl/Messages b/perl/Messages index 646840c8..38fd802b 100644 --- a/perl/Messages +++ b/perl/Messages @@ -86,6 +86,7 @@ package DXM; m13 => 'Message no $_[0] missing', m14 => 'Message no $_[0] marked as sent to $_[1]', m15 => 'Message no $_[0] unmarked as sent to $_[1]', + m16 => 'Need a Message number', merge1 => 'Merge request for $_[1] spots and $_[2] WWV sent to $_[0]', namee1 => 'Please enter your name, set/name ', namee2 => 'Can\'t find user $_[0]!', -- 2.34.1