-# $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
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)
my $n = $rs->size();
my $this = bless {
+ host => $conn->option("host"),
conn => $conn,
query => $query,
rs => $rs,
# 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
# 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.
+ }
}
}
$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}
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});
+ }
}