lib/ZOOM/IRSpy/Stats.pm

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