X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FThingy.pm;h=c1f010c11e3a7c2790759a87acac08187e83fc6e;hb=9311d6940faf0e9952d6d65d9ead572b06a52434;hp=ed33fde027491b84b041187d6e464aedcfc8771c;hpb=87b2f58b1b0df6c0cb5c5f0070db554ec2d2a961;p=spider.git diff --git a/perl/Thingy.pm b/perl/Thingy.pm index ed33fde0..c1f010c1 100644 --- a/perl/Thingy.pm +++ b/perl/Thingy.pm @@ -42,6 +42,8 @@ sub new { my $class = shift; my $thing = {@_}; + + $thing->{origin} ||= $main::mycall; bless $thing, $class; return $thing; @@ -53,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 @_ @@ -83,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); } } @@ -96,14 +121,24 @@ sub queue push @queue, $thing; } +# # this is the main commutator loop. In due course it will -# become the *only* commutator loop +# become the *only* commutator loop, This can be called in one +# of two ways: either with 2 args or with none. +# +# The two arg form is an immediate "queue and handle" and does +# a full cycle, immediately +# sub process { my $thing; + if (@_ == 2) { + $thing = shift; + $thing->queue(shift); + } while (@queue) { $thing = shift @queue; - my $dxchan = DXChannel->get($thing->{dxchan}); + my $dxchan = DXChannel::get($thing->{dxchan}); if ($dxchan) { if ($thing->can('in_filter')) { next unless $thing->in_filter($dxchan); @@ -161,5 +196,14 @@ sub ascii $dd->Quotekeys($] < 5.005 ? 1 : 0); return $dd->Dumpxs; } + +sub add_auth +{ + my $thing = shift; + my $s = $thing->{'s'} = sprintf "%X", int(rand() * 100000000); + my $auth = Verify->new("DXSp,$main::mycall,$s,$main::version,$main::build"); + $thing->{auth} = $auth->challenge($main::me->user->passphrase); +} + 1;