X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FThingy.pm;h=c1f010c11e3a7c2790759a87acac08187e83fc6e;hb=2841b340579dae85808c5a571df3140b736c2fb2;hp=a420206d5ef402a7c70f038927ab575a068fd41d;hpb=c3c15883cf25add24fc49e32eb0d17dce6839a62;p=spider.git diff --git a/perl/Thingy.pm b/perl/Thingy.pm index a420206d..c1f010c1 100644 --- a/perl/Thingy.pm +++ b/perl/Thingy.pm @@ -55,25 +55,44 @@ sub send my $thing = shift; my $dxchan = shift; my $class; + my $sub; + if (@_) { $class = shift; } elsif ($dxchan->isa('DXChannel')) { $class = ref $dxchan; } + # BEWARE!!!!! + no strict 'refs'; + # do output filtering if ($thing->can('out_filter')) { return unless $thing->out_filter($dxchan); } - # generate the line which may (or not) be cached + # before send (and line generation) things + # function must return true to make the send happen + $sub = "before_send_$class"; + if ($thing->can($sub)) { + return $thing->$sub($dxchan); + } + + # generate the protocol line which may (or not) be cached my $ref; unless ($ref = $thing->{class}) { - no strict 'refs'; - my $sub = "gen_$class"; + $sub = "gen_$class"; $ref = $thing->$sub($dxchan) if $thing->can($sub); } $dxchan->send(ref $ref ? @$ref : $ref) if $ref; + + # after send + if ($thing->can('after_send_all')) { + $thing->after_send_all($dxchan); + } else { + $sub = "after_send_$class"; + $thing->$sub($dxchan) if $thing->can($sub); + } } # broadcast to all except @_ @@ -85,6 +104,10 @@ sub broadcast foreach my $dxchan (DXChannel::get_all()) { next if $dxchan == $main::me; next if grep $dxchan == $_, @_; + next if $dxchan->{call} eq $thing->{origin}; + next if $thing->{user} && !$dxchan->is_user && $dxchan->{call} eq $thing->{user}; + + dbg("Thingy::broadcast: sending to $dxchan->{call}") if isdbg('thing'); $thing->send($dxchan); } }