From 27eade18da06163cd9170396983b43813f5ec14c Mon Sep 17 00:00:00 2001 From: pdbogen Date: Tue, 17 Jun 2008 19:26:55 +0000 Subject: [PATCH] If the throttle option is set and a message is to be sent out that does not have the no_throttle flag set in its dest hashref and the length of the message exceeds 354 characters, the message will instead be PM'd to the requestor. Additionally, modify code to understand that the destination for send_public_to and send_private must now be a hashref. git-svn-id: https://www.cernu.us/~pdbogen/svn/destult2@47 088b83a4-0077-4247-935c-42ec02c2848b --- commands.yaml | 13 ++++++------- core.pl | 12 +++++++++--- irc.pl | 31 +++++++++++++++++++++---------- 3 files changed, 36 insertions(+), 20 deletions(-) diff --git a/commands.yaml b/commands.yaml index 5117c0b..32ea7eb 100644 --- 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 --- 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 --- 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" }, $_ ); } } -- 2.11.0