X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=blobdiff_plain;f=lib%2FZOOM%2FIRSpy%2FStats.pm;h=6a59c6b9895d3145962397c4716a308e7f12e063;hp=f79545c897ba4cf8c03fdda9fd252e6246a64c2a;hb=42955602ebc7f77d22617ff6eae1b0dbbcddd394;hpb=39d725f7d2b64485bae8cd53addb5dfdca87a451

diff --git a/lib/ZOOM/IRSpy/Stats.pm b/lib/ZOOM/IRSpy/Stats.pm
index f79545c..6a59c6b 100644
--- a/lib/ZOOM/IRSpy/Stats.pm
+++ b/lib/ZOOM/IRSpy/Stats.pm
@@ -1,10 +1,11 @@
-# $Id: Stats.pm,v 1.4 2006-12-15 17:24:59 mike Exp $
 
 package ZOOM::IRSpy::Stats;
 
 use 5.008;
 use strict;
 use warnings;
+
+use Scalar::Util;
 use ZOOM::IRSpy::Utils qw(irspy_xpath_context);
 
 =head1 NAME
@@ -49,7 +50,7 @@ Either one or two arguments are required:
 
 An indication of the IRSpy database that statistics are required for.
 This may be in the form of a C<ZOOM::Connection> object or a
-database-name string such as C<localhost:3313/IR-Explain---1>.
+database-name string such as C<localhost:8018/IR-Explain---1>.
 
 =item $query (optional)
 
@@ -82,6 +83,7 @@ sub new {
     my $n = $rs->size();
 
     my $this = bless {
+	host => $conn->option("host"),
 	conn => $conn,
 	query => $query,
 	rs => $rs,
@@ -111,17 +113,21 @@ sub _gather_stats {
 
 	# Record syntax support by database
 	foreach my $node ($xc->findnodes('e:recordInfo/e:recordSyntax/@name')) {
-	    $this->{recordSyntaxes}->{$node->findvalue(".")}++;
+	    $this->{recordSyntaxes}->{lc($node->findvalue("."))}++;
 	}
 
 	# 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
@@ -129,10 +135,16 @@ sub _gather_stats {
 	# Top Domains
 	my $host = $xc->findvalue('e:serverInfo/e:host');
 	$host =~ s/.*\.//;
-	$this->{domains}->{$host}++;
+	$this->{domains}->{lc($host)}++;
 
 	# Implementation
-	### Requires XSLT fix
+	foreach my $node ($xc->findnodes('i:status/i:serverImplementationName/@value')) {
+	    $this->{implementation}->{$node->findvalue(".")}++;
+	    last; # This is because many of the records are still
+	          # polluted with multiple implementationName elements
+	          # from back then XSLT stylesheet that generated
+	          # ZeeRex records was wrong.
+	}
     }
 }
 
@@ -179,6 +191,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} 
@@ -186,6 +206,14 @@ sub print {
 	print sprintf("%-26s%5d (%d%%)\n",
 		      $key, $hr->{$key}, 100*$hr->{$key}/$this->{n});
     }
+
+    print "\nIMPLEMENTATIONS\n";
+    $hr = $this->{implementation};
+    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});
+    }
 }