X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=blobdiff_plain;f=lib%2FZOOM%2FPod.pm;h=5faee4d7cb74098b02ea26b4385b406e22d87bea;hp=e338459b586e87a5732fe28ad00ec9a4fdf9403d;hb=d3725cdc5d765df0eff9c525c6e3de015c8ca47c;hpb=aa4c34afe1c7150edfdbfd276381d7015955d2de diff --git a/lib/ZOOM/Pod.pm b/lib/ZOOM/Pod.pm index e338459..5faee4d 100644 --- a/lib/ZOOM/Pod.pm +++ b/lib/ZOOM/Pod.pm @@ -1,4 +1,4 @@ -# $Id: Pod.pm,v 1.15 2006-07-18 13:45:36 mike Exp $ +# $Id: Pod.pm,v 1.22 2006-10-06 11:33:07 mike Exp $ package ZOOM::Pod; @@ -8,7 +8,7 @@ use warnings; use ZOOM; BEGIN { - # Just register the name + # Just register the names: this doesn't turn the levels on ZOOM::Log::mask_str("pod"); ZOOM::Log::mask_str("pod_unhandled"); } @@ -111,6 +111,21 @@ sub new { }, $class; } + +=head2 connections() + + @c = $pod->connections(); + +Returns a list of the connection objects in the pod. + +=cut + +sub connections { + my $this = shift(); + return @{ $this->{conn} } +} + + =head2 option() $oldElemSet = $pod->option("elementSetName"); @@ -205,12 +220,25 @@ sub callback { my($event, $sub) = @_; my $old = $this->{callback}->{$event}; - $this->{callback}->{$event} = $sub - if defined $sub; + $this->{callback}->{$event} = $sub; return $old; } +=head2 remove_callbacks() + + $pod->remove_callbacks(); + +Removes all registed callbacks from the pod. This is useful when the +pod has completed one operation and is about to start the next. + +=cut + +sub remove_callbacks { + my $this = shift(); + $this->{callback} = {}; +} + =head2 search_pqf() $pod->search_pqf("@attr 1=1003 wedel"); @@ -228,8 +256,8 @@ have one search active on it at a time: this allows the pod to maintain the one-to-one mapping between connections and result-sets. Submitting a new search on a connection before the old one has completed will result in a total failure in the nature of causality, -and the spontaneous existence-failure of the universe. Do not do -this. +and the spontaneous existence-failure of the universe. Try to avoid +doing this too often. =cut @@ -238,7 +266,9 @@ sub search_pqf { my($pqf) = @_; foreach my $i (0..@{ $this->{conn} }-1) { - $this->{rs}->[$i] = $this->{conn}->[$i]->search_pqf($pqf); + my $conn = $this->{conn}->[$i]; + $this->{rs}->[$i] = $conn->search_pqf($pqf) + if !$conn->option("pod_omit"); } } @@ -277,21 +307,29 @@ sub wait { my $res = 0; - my(@conn, @imap); - foreach my $i (0 .. @{ $this->{conn} }-1) { - my $conn = $this->{conn}->[$i]; - if (!$conn->option("pod_omit")) { - push @conn, $conn; - } else { - # If we don't push anything onto @conn, then the index $i - # will be meaningless in the loop below, and the - # references to $rs[$i] will be wrong. Ouch. - push @conn, undef; + while (1) { + my @conn; + my @idxmap; # maps indexes into conn to global indexes + foreach my $i (0 .. @{ $this->{conn} }-1) { + my $conn = $this->{conn}->[$i]; + if ($conn->option("pod_omit")) { + #ZOOM::Log::log("pod", "connection $i omitted (", + #$conn->option("host"), ")"); + } else { + push @conn, $conn; + push @idxmap, $i; + #ZOOM::Log::log("pod", "connection $i included (", + #$conn->option("host"), ")"); + } } - } - while ((my $i = ZOOM::event(\@conn)) != 0) { - my $conn = $conn[$i-1]; + last if @conn == 0; + my $i0 = ZOOM::event(\@conn); + last if $i0 == 0; + my $i = 1+$idxmap[$i0-1]; + my $conn = $this->{conn}->[$i-1]; + die "connection-mapping screwup" if $conn ne $conn[$i0-1]; + my $ev = $conn->last_event(); my $evstr = ZOOM::event_str($ev); ZOOM::Log::log("pod", "connection ", $i-1, ": event $ev ($evstr)");