added Log Parsing
authordjk <djk>
Mon, 30 Nov 1998 00:02:20 +0000 (00:02 +0000)
committerdjk <djk>
Mon, 30 Nov 1998 00:02:20 +0000 (00:02 +0000)
started work on allowing SSID for local users/clusters

cmd/set/homenode.pl
cmd/show/announce.pl
cmd/show/log.pl
cmd/show/station.pl
cmd/show/talk.pl
perl/DXCluster.pm
perl/DXCommandmode.pm
perl/DXLog.pm
perl/DXLogPrint.pm [new file with mode: 0644]
perl/cluster.pl
perl/create_sysop.pl

index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..2c7c6c9f65d0340720ba240f199bd5e10af8bc5d 100644 (file)
@@ -0,0 +1,7 @@
+#
+# set the user's home node
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..89d8719239caaf36ec360f51b652a6b4660b3b33 100644 (file)
@@ -0,0 +1,34 @@
+#
+# print out the general log file for announces only
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my $self = shift;
+
+return (1, $self->msg('e5')) if $self->priv < 9;
+
+my $cmdline = shift;
+my @f = split /\s+/, $cmdline;
+my $f;
+my @out;
+my ($from, $to); 
+
+$from = 0;
+while ($f = shift @f) {                 # next field
+       #  print "f: $f list: ", join(',', @list), "\n";
+       if (!$from && !$to) {
+               ($from, $to) = $f =~ /^(\d+)-(\d+)$/o;         # is it a from -> to count?
+               next if $from && $to > $from;
+       }
+       if (!$to) {
+               ($to) = $f =~ /^(\d+)$/o if !$to;              # is it a to count?
+               next if $to;
+       }
+}
+
+$to = 20 if !$to;
+
+@out = DXLog::print($from, $to, $main::systime, '^ann');
+return (1, @out);
index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..63326b7ba80903b2710c91adccd1c7ef672ae980 100644 (file)
@@ -0,0 +1,34 @@
+#
+# print out the general log file
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my $self = shift;
+
+return (1, $self->msg('e5')) if $self->priv < 9;
+
+my $cmdline = shift;
+my @f = split /\s+/, $cmdline;
+my $f;
+my @out;
+my ($from, $to); 
+
+$from = 0;
+while ($f = shift @f) {                 # next field
+       #  print "f: $f list: ", join(',', @list), "\n";
+       if (!$from && !$to) {
+               ($from, $to) = $f =~ /^(\d+)-(\d+)$/o;         # is it a from -> to count?
+               next if $from && $to > $from;
+       }
+       if (!$to) {
+               ($to) = $f =~ /^(\d+)$/o if !$to;              # is it a to count?
+               next if $to;
+       }
+}
+
+$to = 20 if !$to;
+
+@out = DXLog::print($from, $to, $main::systime);
+return (1, @out);
index 9efa5b1f9176e688ddd5f25321d2f5da1d6fe7fb..6c78f45ce16ddde6f19c4fbf4e964530e0856f9b 100644 (file)
@@ -20,19 +20,19 @@ if (@f == 0) {
        my $sort = $ref->sort;
        my $qth = $ref->qth;
        my $home = $ref->node;
-    push @out, "$call $sort $home $qth";
+    push @out, "$call $sort $qth $node";
   }
 } else {
   foreach $call (@f) {
-    my $ref = DXUser::get_current($call);
+    my $ref = DXUser->get_current($call);
        if ($ref) {
-         my $name;
-      my $qth;
-         my $lat;
-         my $long;
-         my $node;
-         my $homenode;
-         push @out, "$call $qth";
+         my $name = $ref->name;  
+      my $qth = $ref->qth;
+         my $lat = $ref->lat;
+         my $long = $ref->long;
+         my $node = $ref->node;
+#        my $homenode = $ref->homenode;
+         push @out, "$call $qth $lat $long $node";
        } else {
          push @out, "$call not known";
        }
index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..612f2b089358bebda4c03095677a49de616b90ed 100644 (file)
@@ -0,0 +1,34 @@
+#
+# print out the general log file for talks only
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my $self = shift;
+
+return (1, $self->msg('e5')) if $self->priv < 9;
+
+my $cmdline = shift;
+my @f = split /\s+/, $cmdline;
+my $f;
+my @out;
+my ($from, $to); 
+
+$from = 0;
+while ($f = shift @f) {                 # next field
+       #  print "f: $f list: ", join(',', @list), "\n";
+       if (!$from && !$to) {
+               ($from, $to) = $f =~ /^(\d+)-(\d+)$/o;         # is it a from -> to count?
+               next if $from && $to > $from;
+       }
+       if (!$to) {
+               ($to) = $f =~ /^(\d+)$/o if !$to;              # is it a to count?
+               next if $to;
+       }
+}
+
+$to = 20 if !$to;
+
+@out = DXLog::print($from, $to, $main::systime, '^talk');
+return (1, @out);
index 6daf65a3874a5ebfd29ba8326e45b13b733854d0..51c63f8239ed7af492148b68cf5f67007a5254af 100644 (file)
@@ -97,8 +97,9 @@ sub cluster
 {
        my $users = DXCommandmode::get_all();
        my $uptime = main::uptime();
-       
-       return " $DXNode::nodes nodes, $users local / $DXNode::users total users  Max users $DXNode::maxusers  Uptime $uptime";
+       my $tot = $DXNode::users + 1;
+               
+       return " $DXNode::nodes nodes, $users local / $tot total users  Max users $DXNode::maxusers  Uptime $uptime";
 }
 
 sub DESTROY
index ab8d9573dd4c4f8e446472cd71737f23bd889d67..84d809fd257e730e30ed388dd324be25e3d93665 100644 (file)
@@ -18,6 +18,7 @@ use DXVars;
 use DXDebug;
 use DXM;
 use DXLog;
+use DXLogPrint;
 use CmdAlias;
 use FileHandle;
 use Carp;
@@ -51,13 +52,10 @@ sub start
   my $user = $self->{user};
   my $call = $self->{call};
   my $name = $user->{name};
-  my $info = DXCluster::cluster();
   
   $self->{name} = $name ? $name : $call;
   $self->send($self->msg('l2',$self->{name}));
   $self->send_file($main::motd) if (-e $main::motd);
-  $self->send("Cluster:$info");
-  $self->send($self->msg('pr', $call));
   $self->state('prompt');                  # a bit of room for further expansion, passwords etc
   $self->{priv} = $user->priv;
   $self->{lang} = $user->lang;
@@ -79,6 +77,11 @@ sub start
   my @pc16 = DXProt::pc16($nchan, $cuser);
   DXProt::broadcast_ak1a(@pc16);
   Log('DXCommand', "$call connected");
+
+  # send prompts and things
+  my $info = DXCluster::cluster();
+  $self->send("Cluster:$info");
+  $self->send($self->msg('pr', $call));
 }
 
 #
index 96b39971091563c21b5eb08a9498a03e94b09f7d..3a6e0e3589ec86b3b53ff00cb665e804b80299e0 100644 (file)
@@ -176,7 +176,7 @@ sub Log
        $log->writeunix($t, join('^', $t, @_) );
 }
 
-sub DESTROY                                            # catch undefs and do what is required further do the tree
+sub DESTROY                                            # catch undefs and do what is required further down the tree
 {
        my $self = shift;
        DXDebug::dbg("dxlog", "closing $self->{fn}\n");
diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm
new file mode 100644 (file)
index 0000000..fff39d1
--- /dev/null
@@ -0,0 +1,108 @@
+#
+# Log Printing routines
+#
+# Copyright (c) - 1998 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+package DXLog;
+
+use FileHandle;
+use DXVars;
+use DXDebug ();
+use DXUtil;
+use DXLog;
+use Julian;
+use Carp;
+
+use strict;
+
+#
+# print some items from the log backwards in time
+#
+# This command outputs a list of n lines starting from time t with $pattern tags
+#
+sub print
+{
+       my $self = $DXLog::log;
+       my $from = shift;
+       my $to = shift;
+       my @date = $self->unixtoj(shift);
+       my $pattern = shift;
+       my $search;
+       my @in;
+       my @out;
+       my $eval;
+       my $count;
+           
+       $search = $pattern ? "\$ref->[1] =~ /$pattern/" : '1' ;
+       $eval = qq(
+                          my \$c;
+                          my \$ref;
+                          for (\$c = \$#in; \$c >= 0; \$c--) {
+                                       \$ref = \$in[\$c];
+                                       if ($search) {
+                                               \$count++;
+                                               next if \$count < $from;
+                                               push \@out, print_item(\$ref);
+                                               last LOOP if \$count >= \$to;                  # stop after n
+                                       }
+                               }
+                         );
+       
+       $self->close;                                      # close any open files
+
+       my $fh = $self->open(@date); 
+LOOP:
+       while ($count < $to) {
+               my @spots = ();
+               if ($fh) {
+                       while (<$fh>) {
+                               chomp;
+                               push @in, [ split '\^' ];
+                       }
+                       eval $eval;               # do the search on this file
+                       return ("Spot search error", $@) if $@;
+               }
+               $fh = $self->openprev();      # get the next file
+               last if !$fh;
+       }
+
+       return @out;
+}
+
+#
+# the standard log printing interpreting routine.
+#
+# every line that is printed should call this routine to be actually visualised
+#
+# Don't really know whether this is the correct place to put this stuff, but where
+# else is correct?
+#
+# I get a reference to an array of items
+#
+sub print_item
+{
+       my $r = shift;
+       my @ref = @$r;
+       my $d = atime($ref[0]);
+       my $s = 'undef';
+       
+       if ($ref[1] eq 'rcmd') {
+               if ($ref[2] eq 'in') {
+                       $s = "$ref[4] (priv: $ref[3]) rcmd: $ref[5]";
+               } else {
+                       $s = "$ref[3] reply: $ref[4]";
+               }
+       } elsif ($ref[1] eq 'talk') {
+               $s = "$ref[3] -> $ref[2] ($ref[4]) $ref[5]";
+       } elsif ($ref[1] eq 'ann') {
+               $s = "$ref[2] -> $ref[3] $ref[4]";
+       } else {
+               $s = "$ref[2]";
+       }
+       return "$d $s";
+}
+
+1;
index d783bff33fa553deb411d410752bca80b51e87ef..666f4f87fd0b59d0b167b297f3ef11cbec3d454c 100755 (executable)
@@ -27,6 +27,7 @@ use Msg;
 use DXVars;
 use DXDebug;
 use DXLog;
+use DXLogPrint;
 use DXUtil;
 use DXChannel;
 use DXUser;
@@ -149,7 +150,7 @@ sub process_inqueue
        
        my $data = $self->{data};
        my $dxchan = $self->{dxchan};
-       my ($sort, $call, $line) = $data =~ /^(\w)(\w+)\|(.*)$/;
+       my ($sort, $call, $line) = $data =~ /^(\w)(\S+)\|(.*)$/;
        
        # do the really sexy console interface bit! (Who is going to do the TK interface then?)
        dbg('chan', "<- $sort $call $line\n");
index 1e553209d9045dacc65d7b2712cc0e83e2182428..da242811ffe19f981efad33e2c5c98ce1fe59bd3 100755 (executable)
@@ -58,7 +58,8 @@ sub create_it
   $self->{lastin} = 0;
   $self->{dxok} = 1;
   $self->{annok} = 1;
-
+  $self->{lang} = 'en';
+  
   # write it away
   $self->close();