2 package OpenILS::Application::Search::Z3950;
3 use strict; use warnings;
4 use base qw/OpenSRF::Application/;
10 use OpenSRF::Utils::SettingsClient;
11 use Unicode::Normalize;
14 use OpenILS::Utils::FlatXML;
15 use OpenILS::Application::Cat::Utils;
16 use OpenILS::Application::AppUtils;
19 use OpenSRF::Utils::Logger qw/$logger/;
21 use OpenSRF::EX qw(:try);
23 my $utils = "OpenILS::Application::Cat::Utils";
24 my $apputils = "OpenILS::Application::AppUtils";
27 use OpenILS::Utils::ModsParser;
30 my $output = "USMARC"; # only support output for now
52 $stuff =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
57 $settings_client = OpenSRF::Utils::SettingsClient->new();
59 $defserv = $settings_client->config_value("z3950", "default" );
61 ( $host, $port, $database, $username, $password ) = _load_settings($defserv);
62 $tcnattr = $settings_client->config_value("z3950", $defserv, "tcnattr");
63 $isbnattr = $settings_client->config_value("z3950", $defserv, "isbnattr");
65 $logger->info("z3950: Loading Defaults: service=$defserv, host=$host, port=$port, ".
66 "db=$database, tcnattr=$tcnattr, isbnattr=$isbnattr, username=$username, password=$password" );
72 if( $service eq $defserv and $host ) {
73 return ( $host, $port, $database, $username, $password );
77 $settings_client->config_value("z3950", $service, "host"),
78 $settings_client->config_value("z3950", $service, "port"),
79 $settings_client->config_value("z3950", $service, "db"),
80 $settings_client->config_value("z3950", $service, "username"),
81 $settings_client->config_value("z3950", $service, "password"),
86 __PACKAGE__->register_method(
87 method => "marcxml_to_brn",
88 api_name => "open-ils.search.z3950.marcxml_to_brn",
92 my( $self, $client, $marcxml ) = @_;
97 # Strip the namespace info from the <collection> node and shove it into
98 # the <record> node, if the collection node exists
99 my ($ns) = ( $marcxml =~ /<collection(.*)?>/og );
100 $logger->info("marcxml_to_brn extracted namespace info: $ns") if $ns;
101 $marcxml =~ s/<collection(.*)?>//og;
102 $marcxml =~ s/<\/collection>//og;
103 $marcxml =~ s/<record>/<record $ns>/og if $ns;
105 my $flat = OpenILS::Utils::FlatXML->new( xml => $marcxml );
106 my $doc = $flat->xml_to_doc();
108 $logger->debug("z3950: Turning doc into a nodeset...");
111 my $nodes = OpenILS::Utils::FlatXML->new->xmldoc_to_nodeset($doc);
112 $logger->debug("z3950: turning nodeset into tree");
113 $tree = $utils->nodeset2tree( $nodes->nodeset );
119 $logger->error("z3950: Error turning doc into nodeset/node tree: $err");
126 __PACKAGE__->register_method(
127 method => "z39_search_by_string",
128 api_name => "open-ils.search.z3950.raw_string",
131 sub z39_search_by_string {
133 my( $self, $connection, $authtoken, $params ) = @_;
134 my( $hst, $prt, $db, $usr, $pw );
137 my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
139 my $service = $$params{service};
140 my $search = $$params{search};
144 ($hst, $prt, $db, $usr, $pw ) = _load_settings($$params{service});
145 $usr = ($$params{username}) ? $$params{username} : $usr;
146 $pw = ($$params{password}) ? $$params{password} : $pw;
149 $hst = $$params{host};
150 $prt = $$params{prt};
152 $usr = $$params{username};
153 $pw = $$params{password};
154 $service = "(custom)";
158 $logger->info("z3950: Search App connecting: service=$service, ".
159 "host=$hst, port=$prt, db=$db, username=$usr, password=$pw, search=$search" );
161 return OpenILS::Event->new('BAD_PARAMS') unless ($hst and $prt and $db);
163 $usr ||= ""; $pw ||= "";
165 my $conn = new Net::Z3950::Connection(
170 preferredRecordSyntax => $output,
174 $logger->error("Unable to create Z3950 connection: $hst, $prt, $db, $usr, $pw, $output");
175 return OpenILS::Event->new('UNKNOWN'); # XXX needs to be a real event
178 my $rs = $conn->search( $search );
179 return OpenILS::Event->new('Z3950_SEARCH_FAILED') unless $rs;
181 # We want nice full records
182 $rs->option(elementSetName => "f");
187 $hash->{count} = $rs->size();
188 $logger->info("z3950: Search recovered " . $hash->{count} . " records");
190 # until there is a more graceful way to handle this
191 if($hash->{count} > 20) { return $hash; }
193 for( my $x = 0; $x != $hash->{count}; $x++ ) {
194 $logger->debug("z3950: Churning on z39 record count $x");
196 my $rec = $rs->record($x+1);
197 my $marc = MARC::Record->new_from_usmarc($rec->rawdata());
200 my $doc = XML::LibXML->new->parse_string($marc->as_xml_record());
202 # strip the <xml> declaration and run through entityize
203 my $marcxml = entityize( $doc->documentElement->toString );
206 my $u = OpenILS::Utils::ModsParser->new();
208 warn "z3950: creating mvr\n";
209 $u->start_mods_batch( $marcxml );
210 $mods = $u->finish_mods_batch();
212 push @$records, { 'mvr' => $mods, 'marcxml' => $marcxml };
215 $logger->debug("z3950: got here near the end with " . scalar(@$records) . " records." );
217 $hash->{records} = $records;
223 __PACKAGE__->register_method(
224 method => "tcn_search",
225 api_name => "open-ils.search.z3950.tcn",
229 my($self, $connection, $authtoken, $tcn, $service, $username, $password) = @_;
231 my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
233 $service ||= $defserv;
235 my $attr = $settings_client->config_value("z3950", $service, "tcnattr");
237 $logger->info("z3950: Searching for TCN $tcn");
239 return $self->z39_search_by_string(
240 $connection, $authtoken, {
241 search => "\@attr 1=$attr \"$tcn\"",
243 username => $username,
244 password => $password,
250 __PACKAGE__->register_method(
251 method => "isbn_search",
252 api_name => "open-ils.search.z3950.isbn",
256 my( $self, $connection, $authtoken, $isbn, $service, $username, $password ) = @_;
258 my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
260 $service ||= $defserv;
262 my $attr = $settings_client->config_value("z3950", $service, "isbnattr");
264 $logger->info("z3950: Performing ISBN search : $isbn");
266 return $self->z39_search_by_string(
267 $connection, $authtoken, {
268 search => "\@attr 1=$attr \"$isbn\"",
269 service => $service ,
270 username => $username,
271 password => $password,
277 __PACKAGE__->register_method(
278 method => "query_interfaces",
279 api_name => "open-ils.search.z3950.services.retrieve",
282 sub query_interfaces {
283 my( $self, $client, $authtoken ) = @_;
284 my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
286 my $services = $settings_client->config_value("z3950");
287 $services = { $services } unless ref($services);
289 return [ grep { $_ ne 'default' } keys %$services ];