X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FThingy.pm;h=c1f010c11e3a7c2790759a87acac08187e83fc6e;hb=cce337f777f0b7668cceebb40527fd1e106729c9;hp=7bbf3edb1568673e265769b36926ea0068dea786;hpb=393e17fd3a08dd94596f1c02d4d20f6f9a44954f;p=spider.git diff --git a/perl/Thingy.pm b/perl/Thingy.pm index 7bbf3edb..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,27 +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 - my @out; - if (my $ref = $thing->{class}) { - push @out, ref $ref ? @$ref : $ref; + # 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}) { + $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 { - no strict 'refs'; - my $sub = "gen_$class"; - push @out, $thing->$sub($dxchan) if $thing->can($sub); + $sub = "after_send_$class"; + $thing->$sub($dxchan) if $thing->can($sub); } - $dxchan->send(@out) if @out; } # 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); } } @@ -98,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); @@ -163,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;