Add support for analysing Explain results.
authorMike Taylor <mike@indexdata.com>
Mon, 18 Dec 2006 15:34:27 +0000 (15:34 +0000)
committerMike Taylor <mike@indexdata.com>
Mon, 18 Dec 2006 15:34:27 +0000 (15:34 +0000)
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.

lib/ZOOM/IRSpy/Stats.pm

index f79545c..c7780f4 100644 (file)
@@ -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}