Tweak memos a bit to be more reliable. Add MEMOLIST, MEMOMOVE, MEMOWIPE. Still need...

git-svn-id: https://www.cernu.us/~pdbogen/svn/destult2@83 088b83a4-0077-4247-935c-42ec02c2848b

diff --git a/cmdaccess.yaml b/cmdaccess.yaml
index 67d6ed4..a1d108b 100644 (file)
--- a/cmdaccess.yaml
+++ b/cmdaccess.yaml
@@ -12,6 +12,9 @@ FLUSHURLS: 1
 IGNORE: 2
 JOIN: 1
 KARMACLEAN: 2
+MEMOLIST: 2
+MEMOMOVE: 2
+MEMOWIPE: 2
 OP: 1
 OPME: 1
 PART: 1

diff --git a/commands.yaml b/commands.yaml
index 231cc03..310516a 100644 (file)
--- a/commands.yaml
+++ b/commands.yaml
@@ -1507,7 +1507,7 @@ CHECKMEMO: |-
     for my $memo( @memos ) {
        my @memo = @$memo;
         my $t = time - $memo[1];
-        my $response;
+        my $response = "";
         if( $t > 86400 ) {
           $response .= floor($t/86400)."d ";
           $t = $t % 86400;
@@ -1522,11 +1522,79 @@ CHECKMEMO: |-
         }
         $response .= $t."s";
        $kernel->post( $src, $replypath, "From: ".$memo[0].", $response ago: ".$memo[2], $dest );
+       print( "MEMO: Delivered from $memo[0] to $who after $response\n" );
     }
     delete $heap->{ 'memo' }->{ uc( $who ) };
        DumpFile( "memos.yaml", $heap->{ 'memo' } );
   }
 
+MEMOLIST: |-
+  sub {
+    my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
+    if( !exists( $heap->{ 'memo' } ) ) {
+      $kernel->post( $src, $replypath, "No memos.", $dest );
+      return 0;
+    }
+    if( length $what > 0 ) {
+      if( !exists( $heap->{ "memo" }->{ uc( $what ) } ) ) {
+        $kernel->post( $src, $replypath, "No memos for $what.", $dest );
+        return 0;
+      }
+      my @memos = @{ $heap->{ "memo" }->{ uc( $what ) } };
+      my $i = 0;
+      my $j = scalar @memos;
+      for my $memo (@memos) {
+        my @memo = @$memo;
+       $i++;
+        $kernel->post( $src, $replypath, "($i/$j) From $memo[0] ".(time-$memo[1])."s ago: $memo[2]", $dest );
+      }
+    } else {
+      my $resp = "~MEMOLIST <name> to show user's memos. Users: ";
+      $resp .= join( ", ", keys( %{ $heap->{ "memo" } } ) );
+      $kernel->post( $src, $replypath, $resp, $dest );
+    }
+  }
+
+MEMOWIPE: |-
+  sub {
+    my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
+    if( !exists( $heap->{ 'memo' } ) ) {
+      $kernel->post( $src, $replypath, "No memos.", $dest );
+      return 0;
+    }
+    if( length $what > 0 ) {
+      if( !exists( $heap->{ "memo" }->{ uc( $what ) } ) ) {
+        $kernel->post( $src, $replypath, "No memos for $what.", $dest );
+        return 0;
+      }
+      $kernel->post( $src, $replypath, "Poof.", $dest );
+      delete $heap->{ "memo" }->{ uc( $what ) };
+    } else {
+      $kernel->post( $src, $replypath, "Usage: MEMOWIPE <user>", $dest );
+    }
+  }
+
+MEMOMOVE: |-
+  sub {
+    my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
+    if( !exists( $heap->{ 'memo' } ) ) {
+      $kernel->post( $src, $replypath, "No memos.", $dest );
+      return 0;
+    }
+    my @args = split( / /, $what );
+    if( scalar @args == 2 ) {
+      if( !exists( $heap->{ "memo" }->{ uc( $args[0] ) } ) ) {
+        $kernel->post( $src, $replypath, "No memos for $args[0].", $dest );
+        return 0;
+      }
+      $kernel->post( $src, $replypath, "Mail forwarded. Eat your heart out, USPS.", $dest );
+      push @{ $heap->{ "memo" }->{ uc( $args[1] ) } }, @{ $heap->{ "memo" }->{ uc( $args[0] ) } };
+      delete $heap->{ "memo" }->{ uc( $args[0] ) };
+    } else {
+      $kernel->post( $src, $replypath, "Usage: MEMOMOVE <from> <to>", $dest );
+    }
+  }
+
 MEMO: |-
   sub {
     my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
@@ -1535,6 +1603,8 @@ MEMO: |-
       return;
     }
     my( $rec, $msg ) = split( / /, $what, 2 );
+    $rec =~ s/:$//;
+    print( "MEMO: From $who for $rec\n" );
        if( !exists( $heap->{ 'memo' } ) ) {
                $heap->{ 'memo' } = {};
        }
@@ -1658,7 +1728,7 @@ KARMACLEAN: |-
       }
     }
     for my $k( keys %{ $heap->{ "karma" } } ) {
-      if( $k =~ /[[:space:]]/ ) {
+      if( $k =~ /[[:space:]]/ || $k =~ /^$/ ) {
         delete $heap->{ "karma" }->{ $k };
       }
     }
@@ -1688,15 +1758,19 @@ KARMA: |-
       my $mult = ($1 eq "-"?-1:1);
       my @response;
       my %karma = %{ $heap->{ "karma" } };
+      my $count = scalar keys %karma;
+      if( $target > $count ) {
+        $target = $count;
+      }
   
       for( my $i = 0; $i < $target; $i++ ) {
-        push @response, [0,""];
+        push @response, [0,undef];
       }
       
       for my $key (keys %karma) {
         INNER:
         for( my $i = 0; $i < $target; $i++ ) {
-          if( $response[ $i ]->[0]*$mult < $karma{ $key }*$mult ) {
+          if( !defined( $response[ $i ]->[1] ) || $response[ $i ]->[0]*$mult < $karma{ $key }*$mult ) {
             $response[ $i ] = [ $karma{ $key }, $key ];
             last INNER;
           }