logging an error if we can't connect to the z server
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Application / Search / Z3950.pm
1 #!/usr/bin/perl
2 package OpenILS::Application::Search::Z3950;
3 use strict; use warnings;
4 use base qw/OpenSRF::Application/;
5
6
7 use Net::Z3950;
8 use MARC::Record;
9 use MARC::File::XML;
10 use OpenSRF::Utils::SettingsClient;
11
12 use OpenILS::Utils::FlatXML;
13 use OpenILS::Application::Cat::Utils;
14 use OpenILS::Application::AppUtils;
15 use OpenILS::Event;
16
17 use OpenSRF::Utils::Logger qw/$logger/;
18
19 use OpenSRF::EX qw(:try);
20
21 my $utils = "OpenILS::Application::Cat::Utils";
22 my $apputils = "OpenILS::Application::AppUtils";
23 my $U = $apputils;
24
25 use OpenILS::Utils::ModsParser;
26 use Data::Dumper;
27
28 my $output = "USMARC"; # only support output for now
29 my $host;
30 my $port;
31 my $database;
32 my $tcnattr;
33 my $isbnattr;
34 my $username;
35 my $password;
36 my $defserv;
37
38 my $settings_client;
39
40 sub initialize {
41         $settings_client = OpenSRF::Utils::SettingsClient->new();
42
43         $defserv                = $settings_client->config_value("z3950", "default" );
44
45         ( $host, $port, $database, $username, $password ) = _load_settings($defserv);
46         $tcnattr                = $settings_client->config_value("z3950", $defserv, "tcnattr");
47         $isbnattr       = $settings_client->config_value("z3950", $defserv, "isbnattr");
48
49         $logger->info("z3950: Loading Defaults: service=$defserv, host=$host, port=$port, ".
50                 "db=$database, tcnattr=$tcnattr, isbnattr=$isbnattr, username=$username, password=$password" );
51 }
52
53 sub _load_settings {
54         my $service = shift;
55
56         if( $service eq $defserv and $host ) {
57                 return ( $host, $port, $database, $username, $password );
58         }
59
60         return (
61                 $settings_client->config_value("z3950", $service, "host"),
62                 $settings_client->config_value("z3950", $service, "port"),
63                 $settings_client->config_value("z3950", $service, "db"),
64                 $settings_client->config_value("z3950", $service, "username"),
65                 $settings_client->config_value("z3950", $service, "password"),
66         );
67 }
68
69
70 __PACKAGE__->register_method(
71         method  => "marcxml_to_brn",
72         api_name        => "open-ils.search.z3950.marcxml_to_brn",
73 );
74
75 sub marcxml_to_brn {
76         my( $self, $client, $marcxml ) = @_;
77
78         my $tree;
79         my $err;
80
81         # Strip the namespace info from the <collection> node and shove it into
82         # the <record> node, if the collection node exists
83         my ($ns) = ( $marcxml =~ /<collection(.*)?>/og );
84         $logger->info("marcxml_to_brn extracted namespace info: $ns") if $ns;
85         $marcxml =~ s/<collection(.*)?>//og;
86         $marcxml =~ s/<\/collection>//og;
87         $marcxml =~ s/<record>/<record $ns>/og if $ns;
88
89         my $flat = OpenILS::Utils::FlatXML->new( xml => $marcxml ); 
90         my $doc = $flat->xml_to_doc();
91
92         $logger->debug("z3950: Turning doc into a nodeset...");
93
94         try {
95                 my $nodes = OpenILS::Utils::FlatXML->new->xmldoc_to_nodeset($doc);
96                 $logger->debug("z3950: turning nodeset into tree");
97                 $tree = $utils->nodeset2tree( $nodes->nodeset );
98         } catch Error with {
99                 $err = shift;
100         };
101
102         if($err) {
103                 $logger->error("z3950: Error turning doc into nodeset/node tree: $err");
104                 return undef;
105         } else {
106                 return $tree;
107         }
108 }
109
110 __PACKAGE__->register_method(
111         method  => "z39_search_by_string",
112         api_name        => "open-ils.search.z3950.raw_string",
113 );
114
115 sub z39_search_by_string {
116
117         my( $self, $connection, $authtoken, $params ) = @_;
118         my( $hst, $prt, $db, $usr, $pw );
119
120
121         my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
122         return $evt if $evt;
123         my $service = $$params{service};
124         my $search      = $$params{search};
125
126         if( $service ) {
127                 ($hst, $prt, $db, $usr, $pw ) = _load_settings($$params{service});
128         } else {
129                 $hst    = $$params{host};
130                 $prt    = $$params{prt};
131                 $db     = $$params{db};
132                 $usr    = $$params{username};
133                 $pw     = $$params{password};
134                 $service = "(custom)";
135         }
136
137
138         $logger->info("z3950:  Search App connecting:  service=$service, ".
139                 "host=$hst, port=$prt, db=$db, username=$usr, password=$pw, search=$search" );
140
141         return OpenILS::Event->new('BAD_PARAMS') unless ($hst and $prt and $db);
142
143         $usr ||= ""; $pw        ||= "";
144
145         my $conn = new Net::Z3950::Connection(
146                 $hst, $prt, 
147                 databaseName                            => $db, 
148                 user                                                    => $usr,
149                 password                                                => $pw,
150                 preferredRecordSyntax   => $output, 
151         );
152
153         if(!$conn) {
154                 $logger->error("Unable to create Z3950 connection: $hst, $prt, $db, $usr, $pw, $output");
155                 return OpenILS::Event->new('UNKNOWN'); # XXX needs to be a real event
156         }
157
158         my $rs = $conn->search( $search );
159         return OpenILS::Event->new('Z3950_SEARCH_FAILED') unless $rs;
160
161         # We want nice full records
162         $rs->option(elementSetName => "f");
163
164         my $records = [];
165         my $hash = {};
166
167         $hash->{count} =  $rs->size();
168         $logger->info("z3950: Search recovered " . $hash->{count} . " records");
169
170         # until there is a more graceful way to handle this
171         if($hash->{count} > 20) { return $hash; }
172
173         for( my $x = 0; $x != $hash->{count}; $x++ ) {
174                 $logger->debug("z3950: Churning on z39 record count $x");
175
176                 my $rec = $rs->record($x+1);
177                 my $marc = MARC::Record->new_from_usmarc($rec->rawdata());
178
179                 my $marcxml = $marc->as_xml();
180                 my $mods;
181                         
182                 my $u = OpenILS::Utils::ModsParser->new();
183                 $u->start_mods_batch( $marcxml );
184                 $mods = $u->finish_mods_batch();
185
186                 push @$records, { 'mvr' => $mods, 'marcxml' => $marcxml };
187         }
188
189         $logger->debug("z3950: got here near the end with " . scalar(@$records) . " records." );
190
191         $hash->{records} = $records;
192         return $hash;
193
194 }
195
196
197 __PACKAGE__->register_method(
198         method  => "tcn_search",
199         api_name        => "open-ils.search.z3950.tcn",
200 );
201
202 sub tcn_search {
203         my($self, $connection, $authtoken, $tcn, $service) = @_;
204
205         my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
206         return $evt if $evt;
207         $service ||= $defserv;
208
209         my $attr = $settings_client->config_value("z3950", $service, "tcnattr");
210
211         $logger->info("z3950: Searching for TCN $tcn");
212
213         return $self->z39_search_by_string(
214                 $connection, $authtoken, {
215                         search => "\@attr 1=$attr \"$tcn\"", 
216                         service => $service });
217 }
218
219
220 __PACKAGE__->register_method(
221         method  => "isbn_search",
222         api_name        => "open-ils.search.z3950.isbn",
223 );
224
225 sub isbn_search {
226         my( $self, $connection, $authtoken, $isbn, $service ) = @_;
227
228         my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
229         return $evt if $evt;
230         $service ||= $defserv;
231
232         my $attr = $settings_client->config_value("z3950", $service, "isbnattr");
233
234         $logger->info("z3950: Performing ISBN search : $isbn");
235
236         return $self->z39_search_by_string(
237                 $connection, $authtoken, {
238                         search => "\@attr 1=$attr \"$isbn\"", 
239                         service => $service });
240 }
241
242
243 __PACKAGE__->register_method(
244         method  => "query_interfaces",
245         api_name        => "open-ils.search.z3950.services.retrieve",
246 );
247
248 sub query_interfaces {
249         my( $self, $client, $authtoken ) = @_;
250         my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
251
252         my $services = $settings_client->config_value("z3950");
253         $services = { $services } unless ref($services);
254
255         return [ grep { $_ ne 'default' } keys %$services ];
256 }
257
258
259
260
261
262 1;