release 1.5

[spider.git] / perl / DXMsg.pm

diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index 9c032ba56f02caf41b682cd87731c6dcbd2c1c0b..bbda05cb5571c5c8718e28708c6456350a9a87d7 100644 (file)
--- a/perl/DXMsg.pm
+++ b/perl/DXMsg.pm
@@ -19,16 +19,19 @@ use DXCluster;
 use DXProtVars;
 use DXProtout;
 use DXDebug;
+use DXLog;
 use FileHandle;
 use Carp;
 
 use strict;
-use vars qw(%work @msg $msgdir %valid %busy);
+use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean);
 
 %work = ();                # outstanding jobs
 @msg = ();                 # messages we have
 %busy = ();                # station interlocks
 $msgdir = "$main::root/msg";              # directory contain the msgs
+$maxage = 30 * 86400;      # the maximum age that a message shall live for if not marked 
+$last_clean = 0;           # last time we did a clean
 
 %valid = (
   fromnode => '9,From Node',
@@ -50,6 +53,7 @@ $msgdir = "$main::root/msg";              # directory contain the msgs
   read => '9,Times read',
   size => '0,Size',
   msgno => '0,Msgno',
+  keep => '0,Keep this?,yesno',
 );
 
 # allocate a new object
@@ -66,6 +70,7 @@ sub alloc
   $self->{subject} = shift;
   $self->{origin} = shift;
   $self->{read} = shift;
+  $self->{rrreq} = shift;
   $self->{gotit} = [];
     
   return $self;
@@ -131,7 +136,7 @@ sub process
          $ref->{count} = 0;
          $ref->{linesreq} = 5;
          $work{"$f[2]$f[3]"} = $ref;        # new ref
-         dbg('msg', "incoming subject ack stream $[3]\n");
+         dbg('msg', "incoming subject ack stream $f[3]\n");
          $busy{$f[2]} = $ref;                       # interlock
          $ref->{lines} = [];
          push @{$ref->{lines}}, ($ref->read_msg_body);
@@ -166,6 +171,9 @@ sub process
              push @{$ref->{gotit}}, $f[2];           # mark this up as being received
                  $ref->store($ref->{lines});
                  add_dir($ref);
+                 my $dxchan = DXChannel->get($ref->{to});
+                 $dxchan->send("New mail has arrived for you") if $dxchan;
+                 Log('msg', "Message $ref->{msgno} from $ref->{from} received from $f[2] for $ref->{to}");
                }
                $ref->stop_msg($self);
                queue_msg();
@@ -180,10 +188,12 @@ sub process
          my $ref = $work{"$f[2]$f[3]"};
          if ($ref) {
                if ($ref->{private}) {                   # remove it if it private and gone off site#
-             $ref->del_msg;
+                       Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $f[2] and deleted");
+                       $ref->del_msg;
            } else {
-             push @{$ref->{gotit}}, $f[2];           # mark this up as being received
-                 $ref->store($ref->{lines});             # re- store the file
+                       Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $f[2]");
+                       push @{$ref->{gotit}}, $f[2];           # mark this up as being received
+                       $ref->store($ref->{lines});             # re- store the file
            }
        $ref->stop_msg($self);
          } else {
@@ -238,6 +248,8 @@ sub process
          last SWITCH;
        }
   }
+
+  clean_old() if $main::systime - $last_clean > 3600 ;    # clean the message queue
 }
 
 
@@ -265,6 +277,7 @@ sub store
          }
          $fh->close;
          dbg('msg', "file $ref->{to} stored\n");
+         Log('msg', "file $ref->{to} from $ref->{from} stored" );
     } else {
       confess "can't open file $ref->{to} $!";  
     }
@@ -291,6 +304,7 @@ sub store
          }
          $fh->close;
          dbg('msg', "msg $ref->{msgno} stored\n");
+         Log('msg', "msg $ref->{msgno} from $ref->{from} to $ref->{to} stored" );
     } else {
       confess "can't open msg file $fn $!";  
     }
@@ -314,6 +328,27 @@ sub del_msg
   dbg('msg', "deleting $self->{msgno}\n");
 }
 
+# clean out old messages from the message queue
+sub clean_old
+{
+       my $ref;
+       
+       # mark old messages for deletion
+       foreach $ref (@msg) {
+               if (!$ref->{keep} && $ref->{t} < $main::systime - $maxage) {
+                       $ref->{deleteme} = 1;
+                       delete $ref->{gotit};
+                       delete $ref->{list};
+                       unlink filename($ref->{msgno});
+                       dbg('msg', "deleting old $ref->{msgno}\n");
+               }
+       }
+
+       # remove them all from the active message list
+       @msg = map { $_->{deleteme} ? () : $_ } @msg;
+       $last_clean = $main::systime;
+}
+
 # read in a message header
 sub read_msg_header
 { 
@@ -591,18 +626,8 @@ sub field_prompt
   return $valid{$ele};
 }
 
-no strict;
-sub AUTOLOAD
-{
-  my $self = shift;
-  my $name = $AUTOLOAD;
-  return if $name =~ /::DESTROY$/;
-  $name =~ s/.*:://o;
-  
-  confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
-  @_ ? $self->{$name} = shift : $self->{$name} ;
-}
-
+#
+# send a message state machine
 sub do_send_stuff
 {
   my $self = shift;
@@ -623,7 +648,7 @@ sub do_send_stuff
        my $loc = $self->{loc};
        if ($line eq "\032" || uc $line eq "/EX") {
       my $to;
-   
+
       if (@{$loc->{lines}} > 0) {
            foreach $to (@{$loc->{to}}) {
              my $ref;
@@ -635,12 +660,15 @@ sub do_send_stuff
                                                        $systime,
                                                        $loc->{private}, 
                                                        $loc->{subject}, 
-                                                       $mycall, 
+                                                       $mycall,
+                                                       '0',
                                                        $loc->{rrreq});
              $ref->store($loc->{lines});
                  $ref->add_dir();
                  #push @out, $self->msg('sendsent', $to);
                  push @out, "msgno $ref->{msgno} sent to $to";
+                 my $dxchan = DXChannel->get(uc $to);
+                 $dxchan->send("New mail has arrived for you") if $dxchan;
            }
          }
          delete $loc->{lines};
@@ -666,6 +694,27 @@ sub do_send_stuff
   return (1, @out);
 }
 
+# return the standard directory line for this ref 
+sub dir
+{
+  my $ref = shift;
+  return sprintf "%6d%s%s%5d %8.8s %8.8s %-6.6s %5.5s %-30.30s", 
+    $ref->msgno, $ref->read ? '-' : ' ', $ref->private ? 'p' : ' ', $ref->size,
+       $ref->to, $ref->from, cldate($ref->t), ztime($ref->t), $ref->subject;
+}
+
+no strict;
+sub AUTOLOAD
+{
+  my $self = shift;
+  my $name = $AUTOLOAD;
+  return if $name =~ /::DESTROY$/;
+  $name =~ s/.*:://o;
+  
+  confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
+  @_ ? $self->{$name} = shift : $self->{$name} ;
+}
+
 1;
 
 __END__