lib/ZOOM/IRSpy/Stats.pm

   1
   2 package ZOOM::IRSpy::Stats;
   3
   4 use 5.008;
   5 use strict;
   6 use warnings;
   7
   8 use Scalar::Util;
   9 use ZOOM::IRSpy::Utils qw(irspy_xpath_context);
  10
  11 =head1 NAME
  12
  13 ZOOM::IRSpy::Stats - statistics generated for IRSpy about its targets
  14
  15 =head1 SYNOPSIS
  16
  17  $stats = new ZOOM::IRSpy::Stats($dbname);
  18  $stats->print();
  19
  20 =head1 DESCRIPTION
  21
  22 Provides a simple API to obtaining statistics about targets registered
  23 in IRSpy.  This is done just by creating a Stats object.  Once this
  24 object is made, it can be crudely printed using the built-in debugging
  25 C<print()> method, or the application can walk the structure to
  26 produce nice output.
  27
  28 =head1 METHODS
  29
  30 =head2 new()
  31
  32  $stats = new ZOOM::IRSpy::Stats($dbname, "dc.creator=wedel");
  33  # Or:
  34  $stats = new ZOOM::IRSpy::Stats($dbname,
  35          new ZOOM::Query::PQF('@attr 1=1003 wedel');
  36  # Or:
  37  $spy = new ZOOM::Connection("target/string/for/irspy/database");
  38  $stats = new ZOOM::IRSpy::Stats($spy, $query);
  39
  40 Creates a new C<ZOOM::IRSpy::Stats> object and populates it with
  41 statistics for the targets in the nominated database.  This process
  42 involves analysing the nominated IRSpy database at some length, and
  43 which therefore takes some time
  44
  45 Either one or two arguments are required:
  46
  47 =over 4
  48
  49 =item $conn (mandatory)
  50
  51 An indication of the IRSpy database that statistics are required for.
  52 This may be in the form of a C<ZOOM::Connection> object or a
  53 database-name string such as C<localhost:8018/IR-Explain---1>.
  54
  55 =item $query (optional)
  56
  57 The query with which to select a subset of the database to be
  58 analysed.  This may be in the form of a C<ZOOM::Query> object (using
  59 any of the supported subclasses) or a CQL string.  If this is omitted,
  60 then all records in the database are included in the generated
  61 statistics.
  62
  63 =back
  64
  65 =cut
  66
  67 sub new {
  68     my $class = shift();
  69     my($conn, $query) = @_;
  70
  71     $query ||= "cql.allRecords=1",
  72     $conn = new ZOOM::Connection($conn) if !ref $conn;
  73     $query = new ZOOM::Query::CQL($query) if !ref $query;
  74
  75     my $oldSyntax = $conn->option("preferredRecordSyntax");
  76     my $oldESN = $conn->option("elementSetName");
  77     my $oldPC = $conn->option("presentChunk");
  78     $conn->option(preferredRecordSyntax => "xml");
  79     $conn->option(elementSetName => "zeerex");
  80 #    $conn->option(presentChunk => 10);
  81
  82     my $rs = $conn->search($query);
  83     my $n = $rs->size();
  84
  85     my $this = bless {
  86         host => $conn->option("host"),
  87         conn => $conn,
  88         query => $query,
  89         rs => $rs,
  90         n => $n,
  91     }, $class;
  92
  93     $this->_gather_stats();
  94     $conn->option(preferredRecordSyntax => $oldSyntax);
  95     $conn->option(elementSetName => $oldESN);
  96     $conn->option(presentChunk => $oldPC);
  97
  98     return $this;
  99 }
 100
 101
 102 sub _gather_stats {
 103     my $this = shift();
 104
 105     foreach my $i (0 .. $this->{n}-1) {
 106         my $rec = $this->{rs}->record($i);
 107         my $xc = irspy_xpath_context($rec);
 108
 109         # The ten most commonly supported Bib-1 Use attributes
 110         foreach my $node ($xc->findnodes('e:indexInfo/e:index[@search="true"]/e:map/e:attr[@type=1 and @set="bib-1"]')) {
 111             $this->{bib1AccessPoints}->{$node->findvalue(".")}++;
 112         }
 113
 114         # Record syntax support by database
 115         foreach my $node ($xc->findnodes('e:recordInfo/e:recordSyntax/@name')) {
 116             $this->{recordSyntaxes}->{lc($node->findvalue("."))}++;
 117         }
 118
 119         # Explain support
 120         foreach my $node ($xc->findnodes('i:status/i:explain[@ok="1"]/@category')) {
 121             $this->{explain}->{$node->findvalue(".")}++;
 122         }
 123
 124         # Z39.50 Protocol Services Support
 125         foreach my $node ($xc->findnodes('e:configInfo/e:supports')) {
 126             my $supports = $node->findvalue('@type');
 127             if ($node->findvalue(".") && $supports =~ s/^z3950_//) {
 128                 $this->{z3950_init_opt}->{$supports}++;
 129             }
 130         }
 131
 132         # Z39.50 Server Atlas
 133         ### TODO -- awkward, should be considered an enhancement
 134
 135         # Top Domains
 136         my $host = $xc->findvalue('e:serverInfo/e:host');
 137         $host =~ s/.*\.//;
 138         $this->{domains}->{lc($host)}++;
 139
 140         # Implementation
 141         foreach my $node ($xc->findnodes('i:status/i:serverImplementationName/@value')) {
 142             $this->{implementation}->{$node->findvalue(".")}++;
 143             last; # This is because many of the records are still
 144                   # polluted with multiple implementationName elements
 145                   # from back then XSLT stylesheet that generated
 146                   # ZeeRex records was wrong.
 147         }
 148     }
 149 }
 150
 151
 152 =head2 print()
 153
 154  $stats->print();
 155
 156 Prints an ugly but human-readable summary of the statistics on
 157 standard output.
 158
 159 =cut
 160
 161 sub print {
 162     my $this = shift();
 163
 164     print "database = '", $this->{conn}->option("host"), "'\n";
 165     print "query = '", $this->{query}, "'\n";
 166     print "result set = '", $this->{rs}, "'\n";
 167     print "count = '", $this->{n}, "'\n";
 168     my $hr;
 169
 170     print "\nTOP 10 BIB-1 ATTRIBUTES\n";
 171     $hr = $this->{bib1AccessPoints};
 172     foreach my $key ((sort { $hr->{$b} <=> $hr->{$a}
 173                              || $a <=> $b } keys %$hr)[0..9]) {
 174         print sprintf("%6d%20s%5d (%d%%)\n",
 175                       $key, "", $hr->{$key}, 100*$hr->{$key}/$this->{n});
 176     }
 177
 178     print "\nRECORD SYNTAXES\n";
 179     $hr = $this->{recordSyntaxes};
 180     foreach my $key (sort { $hr->{$b} <=> $hr->{$a}
 181                             || $a cmp $b } keys %$hr) {
 182         print sprintf("%-26s%5d (%d%%)\n",
 183                       $key, $hr->{$key}, 100*$hr->{$key}/$this->{n});
 184     }
 185
 186     print "\nEXPLAIN SUPPORT\n";
 187     $hr = $this->{explain};
 188     foreach my $key (sort { $hr->{$b} <=> $hr->{$a}
 189                             || $a cmp $b } keys %$hr) {
 190         print sprintf("%-26s%5d (%d%%)\n",
 191                       $key, $hr->{$key}, 100*$hr->{$key}/$this->{n});
 192     }
 193
 194     print "\nZ39.50 PROTOCOL SERVICES SUPPORT\n";
 195     $hr = $this->{z3950_init_opt};
 196     foreach my $key (sort { $hr->{$b} <=> $hr->{$a}
 197                             || $a cmp $b } keys %$hr) {
 198         print sprintf("%-26s%5d (%d%%)\n",
 199                       $key, $hr->{$key}, 100*$hr->{$key}/$this->{n});
 200     }
 201
 202     print "\nTOP-LEVEL DOMAINS\n";
 203     $hr = $this->{domains};
 204     foreach my $key (sort { $hr->{$b} <=> $hr->{$a}
 205                             || $a cmp $b } keys %$hr) {
 206         print sprintf("%-26s%5d (%d%%)\n",
 207                       $key, $hr->{$key}, 100*$hr->{$key}/$this->{n});
 208     }
 209
 210     print "\nIMPLEMENTATIONS\n";
 211     $hr = $this->{implementation};
 212     foreach my $key (sort { $hr->{$b} <=> $hr->{$a}
 213                             || $a cmp $b } keys %$hr) {
 214         print sprintf("%-26s%5d (%d%%)\n",
 215                       $key, $hr->{$key}, 100*$hr->{$key}/$this->{n});
 216     }
 217 }
 218
 219
 220 =head1 SEE ALSO
 221
 222 ZOOM::IRSpy
 223
 224 =head1 AUTHOR
 225
 226 Mike Taylor, E<lt>mike@indexdata.comE<gt>
 227
 228 =head1 COPYRIGHT AND LICENSE
 229
 230 Copyright (C) 2006 by Index Data ApS.
 231
 232 This library is free software; you can redistribute it and/or modify
 233 it under the same terms as Perl itself, either Perl version 5.8.7 or,
 234 at your option, any later version of Perl 5 you may have available.
 235
 236 =cut
 237
 238 1;