FEFO for irspy_search() if a hash is passed in place of a hash-reference.
[irspy-moved-to-github.git] / 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;