From: Mike Taylor Date: Mon, 18 Dec 2006 15:34:27 +0000 (+0000) Subject: Add support for analysing Explain results. X-Git-Tag: CPAN-v1.02~54^2~604 X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=commitdiff_plain;h=c3ce1a514156d9b69e789cd329ec5d3a78b5a152 Add support for analysing Explain results. Add support for analysing Z39.50 Init Response results. {host} element set from connections, so that it's available in a Stats object that's been serialised/deserialised and which therefore no longer has a real ZOOM::Connection inside it. --- diff --git a/lib/ZOOM/IRSpy/Stats.pm b/lib/ZOOM/IRSpy/Stats.pm index f79545c..c7780f4 100644 --- a/lib/ZOOM/IRSpy/Stats.pm +++ b/lib/ZOOM/IRSpy/Stats.pm @@ -1,4 +1,4 @@ -# $Id: Stats.pm,v 1.4 2006-12-15 17:24:59 mike Exp $ +# $Id: Stats.pm,v 1.5 2006-12-18 15:34:27 mike Exp $ package ZOOM::IRSpy::Stats; @@ -82,6 +82,7 @@ sub new { my $n = $rs->size(); my $this = bless { + host => $conn->option("host"), conn => $conn, query => $query, rs => $rs, @@ -116,12 +117,16 @@ sub _gather_stats { # Explain support foreach my $node ($xc->findnodes('i:status/i:explain[@ok="1"]/@category')) { - print $node; $this->{explain}->{$node->findvalue(".")}++; } # Z39.50 Protocol Services Support - ### Requires XSLT fix + foreach my $node ($xc->findnodes('e:configInfo/e:supports')) { + my $supports = $node->findvalue('@type'); + if ($node->findvalue(".") && $supports =~ s/^z3950_//) { + $this->{z3950_init_opt}->{$supports}++; + } + } # Z39.50 Server Atlas ### TODO -- awkward, should be considered an enhancement @@ -179,6 +184,14 @@ sub print { $key, $hr->{$key}, 100*$hr->{$key}/$this->{n}); } + print "\nZ39.50 PROTOCOL SERVICES SUPPORT\n"; + $hr = $this->{z3950_init_opt}; + foreach my $key (sort { $hr->{$b} <=> $hr->{$a} + || $a cmp $b } keys %$hr) { + print sprintf("%-26s%5d (%d%%)\n", + $key, $hr->{$key}, 100*$hr->{$key}/$this->{n}); + } + print "\nTOP-LEVEL DOMAINS\n"; $hr = $this->{domains}; foreach my $key (sort { $hr->{$b} <=> $hr->{$a}