lib/ZOOM/IRSpy/Stats.pm

   1 # $Id: Stats.pm,v 1.4 2006-12-15 17:24:59 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         conn => $conn,
  86         query => $query,
  87         rs => $rs,
  88         n => $n,
  89     }, $class;
  90
  91     $this->_gather_stats();
  92     $conn->option(preferredRecordSyntax => $oldSyntax);
  93     $conn->option(elementSetName => $oldESN);
  94     $conn->option(presentChunk => $oldPC);
  95
  96     return $this;
  97 }
  98
  99
 100 sub _gather_stats {
 101     my $this = shift();
 102
 103     foreach my $i (0 .. $this->{n}-1) {
 104         my $rec = $this->{rs}->record($i);
 105         my $xc = irspy_xpath_context($rec);
 106
 107         # The ten most commonly supported Bib-1 Use attributes
 108         foreach my $node ($xc->findnodes('e:indexInfo/e:index[@search="true"]/e:map/e:attr[@type=1 and @set="bib-1"]')) {
 109             $this->{bib1AccessPoints}->{$node->findvalue(".")}++;
 110         }
 111
 112         # Record syntax support by database
 113         foreach my $node ($xc->findnodes('e:recordInfo/e:recordSyntax/@name')) {
 114             $this->{recordSyntaxes}->{$node->findvalue(".")}++;
 115         }
 116
 117         # Explain support
 118         foreach my $node ($xc->findnodes('i:status/i:explain[@ok="1"]/@category')) {
 119             print $node;
 120             $this->{explain}->{$node->findvalue(".")}++;
 121         }
 122
 123         # Z39.50 Protocol Services Support
 124         ### Requires XSLT fix
 125
 126         # Z39.50 Server Atlas
 127         ### TODO -- awkward, should be considered an enhancement
 128
 129         # Top Domains
 130         my $host = $xc->findvalue('e:serverInfo/e:host');
 131         $host =~ s/.*\.//;
 132         $this->{domains}->{$host}++;
 133
 134         # Implementation
 135         ### Requires XSLT fix
 136     }
 137 }
 138
 139
 140 =head2 print()
 141
 142  $stats->print();
 143
 144 Prints an ugly but human-readable summary of the statistics on
 145 standard output.
 146
 147 =cut
 148
 149 sub print {
 150     my $this = shift();
 151
 152     print "database = '", $this->{conn}->option("host"), "'\n";
 153     print "query = '", $this->{query}, "'\n";
 154     print "result set = '", $this->{rs}, "'\n";
 155     print "count = '", $this->{n}, "'\n";
 156     my $hr;
 157
 158     print "\nTOP 10 BIB-1 ATTRIBUTES\n";
 159     $hr = $this->{bib1AccessPoints};
 160     foreach my $key ((sort { $hr->{$b} <=> $hr->{$a}
 161                              || $a <=> $b } keys %$hr)[0..9]) {
 162         print sprintf("%6d%20s%5d (%d%%)\n",
 163                       $key, "", $hr->{$key}, 100*$hr->{$key}/$this->{n});
 164     }
 165
 166     print "\nRECORD SYNTAXES\n";
 167     $hr = $this->{recordSyntaxes};
 168     foreach my $key (sort { $hr->{$b} <=> $hr->{$a}
 169                             || $a cmp $b } keys %$hr) {
 170         print sprintf("%-26s%5d (%d%%)\n",
 171                       $key, $hr->{$key}, 100*$hr->{$key}/$this->{n});
 172     }
 173
 174     print "\nEXPLAIN SUPPORT\n";
 175     $hr = $this->{explain};
 176     foreach my $key (sort { $hr->{$b} <=> $hr->{$a}
 177                             || $a cmp $b } keys %$hr) {
 178         print sprintf("%-26s%5d (%d%%)\n",
 179                       $key, $hr->{$key}, 100*$hr->{$key}/$this->{n});
 180     }
 181
 182     print "\nTOP-LEVEL DOMAINS\n";
 183     $hr = $this->{domains};
 184     foreach my $key (sort { $hr->{$b} <=> $hr->{$a}
 185                             || $a cmp $b } keys %$hr) {
 186         print sprintf("%-26s%5d (%d%%)\n",
 187                       $key, $hr->{$key}, 100*$hr->{$key}/$this->{n});
 188     }
 189 }
 190
 191
 192 =head1 SEE ALSO
 193
 194 ZOOM::IRSpy
 195
 196 =head1 AUTHOR
 197
 198 Mike Taylor, E<lt>mike@indexdata.comE<gt>
 199
 200 =head1 COPYRIGHT AND LICENSE
 201
 202 Copyright (C) 2006 by Index Data ApS.
 203
 204 This library is free software; you can redistribute it and/or modify
 205 it under the same terms as Perl itself, either Perl version 5.8.7 or,
 206 at your option, any later version of Perl 5 you may have available.
 207
 208 =cut
 209
 210 1;