If the throttle option is set and a message is to be sent out that does not have...

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

diff --git a/commands.yaml b/commands.yaml
index 5117c0b..32ea7eb 100644 (file)
--- a/commands.yaml
+++ b/commands.yaml
@@ -211,7 +211,7 @@ IDENTIFY: |-
     use Digest::MD5 qw( md5_hex );
     my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
     my( $whom, $password );
-    print( "IDENTIFY: $who for ***** from $src to $dest via $replypath\n" );
+    print( "IDENTIFY: $who for ***** from $src to ".$dest->{ "dest" }." via $replypath\n" );
   
     my @array = split( / /, $what );
     if( scalar( @array ) > 1 ) {
@@ -323,7 +323,7 @@ CONFIG: |-
 DEFINE: |-
   sub {
     my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
-    print( "DEFINE: $who for $what from $src to $dest via $replypath\n" );
+    print( "DEFINE: $who for $what from $src to ".$dest->{ "dest" }." via $replypath\n" );
     my( $subj, $predicate ) = split( / as /, $what, 2 );
     if( $subj ) {
       if( $predicate ) {
@@ -343,7 +343,7 @@ DEFINE: |-
 APPEND: |-
   sub {
     my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
-    print( "APPEND: $who for $what from $src to $dest via $replypath\n" );
+    print( "APPEND: $who for $what from $src to ".$dest->{ "dest" }." via $replypath\n" );
     my( $subj, $predicate ) = split( / with /, $what, 2 );
     if( exists( $heap->{ 'db' }->{ uc( $subj ) } ) ) {
       if( length( $predicate ) > 0 ) {
@@ -362,7 +362,6 @@ PARSE: |-
   sub {
     use YAML qw(LoadFile DumpFile);
     my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
-    print( "PARSE: $who for $what from $src to $dest via $replypath\n" );
     print( "PARSE: $what is ".$heap->{ 'db' }->{ uc( $what ) }."\n" );
 
     if( !exists( $heap->{ 'factoidAccess' } ) && -e 'factoidAccess.yaml' ) {
@@ -408,7 +407,7 @@ PARSE: |-
 LITERAL: |-
   sub {
     my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
-    print( "LITERAL: $who for $what from $src to $dest via $replypath\n" );
+    print( "LITERAL: $who for $what from $src to ".$dest->{ "dest" }." via $replypath\n" );
     if( exists( $heap->{ 'db' }->{ uc( $what ) } ) ) {
       $kernel->post( "$src", $replypath, "$what is ".$heap->{ 'db' }->{ uc( $what ) }, $dest );
     } else {
@@ -632,7 +631,7 @@ WIKI: |-
 ADVERTISE: |-
   sub {
     my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
-    print( "ADVERTISE: $who for $what from $src to $dest via $replypath\n" );
+    print( "ADVERTISE: $who for $what from $src to ".$dest->{ "dest" }." via $replypath\n" );
     my( $time, $how, $message ) = split( / /, $what, 3 );
     my( $prot, $type, $targ ) = split( /:/, $how, 3 );
     $time = int( $time );
@@ -1487,7 +1486,7 @@ TINYURL: |-
       $kernel->post( $src, $replypath, $arr[2]." [first: ".$arr[0]."/".$arr[1]."]", $dest );
     } else {
       my $url = makeashorterlink( $what ) or return;
-      $heap->{ 'urls' }->{ uc( $what ) } = [ $who, $dest, $url ];
+      $heap->{ 'urls' }->{ uc( $what ) } = [ $who, $dest->{ 'text' }, $url ];
       $kernel->post( $src, $replypath, "$url [$who]", $dest );
     }
   }

diff --git a/core.pl b/core.pl
index 712f78d..20c3008 100644 (file)
--- a/core.pl
+++ b/core.pl
@@ -138,22 +138,28 @@ sub cmd {
        print( "CORE: <$who> $cmd -- $subj\n" ) unless( !exists $Destult::config{ 'DEBUG' } );
 
        my $noparse = 0;
+       my $no_throttle = 0;
+       $cmd =~ s/^@\+/+@/;
        if( substr( $cmd, 0, 1 ) eq "+" ) {
                $noparse = 1;
                $cmd = substr( $cmd, 1 );
        }
+       if( substr( $cmd, 0, 1 ) eq "@" ) {
+               $no_throttle = 1;
+               $cmd = substr( $cmd, 1 );
+       }
 
        if( exists( $heap->{ 'commands' }->{ uc( $cmd ) } ) ) {
                if( !exists $heap->{ 'cmdaccess' }->{ uc( $cmd ) } || 
                        $heap->{ 'cmdaccess' }->{ uc( $cmd ) } == 0 || (
                        exists $heap->{ 'identified' }->{ $src.uc( $who ) } &&
                        accessLevel( $kernel, $heap, uc( $who ), $src ) >= $heap->{ 'cmdaccess' }->{ uc( $cmd ) } ) ) {
-                       &{ $heap->{ 'commands' }->{ uc( $cmd ) } }( $kernel, $heap, $who, $subj, $src, $dest, $replypath );
+                       &{ $heap->{ 'commands' }->{ uc( $cmd ) } }( $kernel, $heap, $who, $subj, $src, { dest => $dest, src=>$who, no_throttle => $no_throttle }, $replypath );
                } else {
-                       $kernel->post( $src, $replypath, "$who: An access level of ".$heap->{ 'cmdaccess' }->{ uc( $cmd ) }." is required for '$cmd'", $dest );
+                       $kernel->post( $src, $replypath, "$who: An access level of ".$heap->{ 'cmdaccess' }->{ uc( $cmd ) }." is required for '$cmd'", { dest=>$dest, src=>$who, no_throttle=>$no_throttle } );
                }
        } elsif( exists( $heap->{ 'db' }->{ uc( $what ) } ) && !$noparse ) {
-               &{ $heap->{ 'commands' }->{ 'PARSE' } }( $kernel, $heap, $who, $what, $src, $dest, $replypath );
+               &{ $heap->{ 'commands' }->{ 'PARSE' } }( $kernel, $heap, $who, $what, $src, { dest => $dest, src=>$who, no_throttle => $no_throttle }, $replypath );
        } else {
                $kernel->post( $src, "send_private", "Huh?", $who );
        }

diff --git a/irc.pl b/irc.pl
index b8d786d..941e0cf 100644 (file)
--- a/irc.pl
+++ b/irc.pl
@@ -33,6 +33,7 @@ sub new {
        $self->{ "port" } = 6667;
        $self->{ "password" } = "";
        $self->{ "trap" } = 0;
+       $self->{ "throttle" } = 0;
        while( $_ = shift ) {
                print( "IRC : Parsing Option '$_'\n" );
                my( $name, $value ) = split( /=/, $_, 2 );
@@ -216,31 +217,41 @@ sub send_public {
        my( $kernel, $heap, $msg ) = @_[ KERNEL, HEAP, ARG0 ];
        for my $chan (split( /,/, $self->{ "channel" } ) ) {
                $chan = (split( /:/, $chan ))[0];
-               $kernel->yield( "send_public_to", $msg, $chan );
+               $kernel->yield( "send_public_to", $msg, { dest=>$chan, no_throttle=>1 } );
        }
 }
 
 sub send_public_to {
        my( $kernel, $heap, $msg, $target ) = @_[ KERNEL, HEAP, ARG0, ARG1 ];
-       if( $target =~ /^[#&][a-zA-Z0-9-_]+$/ ) {
-               print( "IRC : =>$target: $msg\n" );
-               local( $Text::Wrap::columns = 354 );
-               my @msg = split( /\n/, wrap( '', '', $msg ) );
-               for( @msg ) {
-                       $kernel->post( $heap->{ 'ircobject' }->session_id(), "privmsg", $target, $_ );
+       use Data::Dumper;
+       my $self = $heap->{ "self" };
+       my $no_throttle = $target->{ "no_throttle" };
+       print(
+               "n_t: ".$no_throttle."\n".
+               "s-t: ".$self->{ "throttle" }."\n".
+               "len: ".length($msg)."\n" );
+       if( $target->{ "dest" } =~ /^[#&][a-zA-Z0-9-_]+$/ ) {
+               if( $no_throttle || !$self->{ "throttle" } || length $msg <= 354 ) {
+                       print( "IRC : =>".$target->{ "dest" }.": $msg\n" );
+                       local( $Text::Wrap::columns = 354 );
+                       my @msg = split( /\n/, wrap( '', '', $msg ) );
+                       for( @msg ) {
+                               $kernel->post( $heap->{ 'ircobject' }->session_id(), "privmsg", $target->{ "dest" }, $_ );
+                       }
+               } else {
+                       $kernel->yield( "send_private", $msg, { dest=>$target->{ "src" }, src=>$target->{ "src" } } );
                }
        } else {
-               print( "IRC : Could not send '$msg' to '$target' -- '$target' is not a channel\n" );
+               print( "IRC : Could not send '$msg' to '".$target->{ "dest" }."' -- '".$target->{ "dest" }."' is not a channel\n" );
        }
 }
 
 sub send_private {
        my( $kernel, $heap, $msg, $who ) = @_[ KERNEL, HEAP, ARG0, ARG1 ];
-       my $nick = ( split( /!/, $target, 2 ) )[0];
        local( $Text::Wrap::columns = 354 );
        my @msg = split( /\n/, wrap( '', '', $msg ) );
        for( @msg ) {
-               $kernel->post( $heap->{ 'ircobject' }->session_id(), "notice", $who, $_ );
+               $kernel->post( $heap->{ 'ircobject' }->session_id(), "notice", $who->{ "dest" }, $_ );
        }
 }