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 use Unicode::Normalize;
  12 use XML::LibXML;
  13
  14 use OpenILS::Utils::FlatXML;
  15 use OpenILS::Application::Cat::Utils;
  16 use OpenILS::Application::AppUtils;
  17 use OpenILS::Event;
  18
  19 use OpenSRF::Utils::Logger qw/$logger/;
  20
  21 use OpenSRF::EX qw(:try);
  22
  23 my $utils = "OpenILS::Application::Cat::Utils";
  24 my $apputils = "OpenILS::Application::AppUtils";
  25 my $U = $apputils;
  26
  27 use OpenILS::Utils::ModsParser;
  28 use Data::Dumper;
  29
  30 my $output = "USMARC"; # only support output for now
  31 my $host;
  32 my $port;
  33 my $database;
  34 my $tcnattr;
  35 my $isbnattr;
  36 my $username;
  37 my $password;
  38 my $defserv;
  39
  40 my $settings_client;
  41
  42 sub entityize {
  43         my $stuff = shift;
  44         my $form = shift;
  45
  46         if ($form eq 'D') {
  47                 $stuff = NFD($stuff);
  48         } else {
  49                 $stuff = NFC($stuff);
  50         }
  51
  52         $stuff =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
  53         return $stuff;
  54 }
  55
  56 sub initialize {
  57         $settings_client = OpenSRF::Utils::SettingsClient->new();
  58
  59         $defserv                = $settings_client->config_value("z3950", "default" );
  60
  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");
  64
  65         $logger->info("z3950: Loading Defaults: service=$defserv, host=$host, port=$port, ".
  66                 "db=$database, tcnattr=$tcnattr, isbnattr=$isbnattr, username=$username, password=$password" );
  67 }
  68
  69 sub _load_settings {
  70         my $service = shift;
  71
  72         if( $service eq $defserv and $host ) {
  73                 return ( $host, $port, $database, $username, $password );
  74         }
  75
  76         return (
  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"),
  82         );
  83 }
  84
  85
  86 __PACKAGE__->register_method(
  87         method  => "marcxml_to_brn",
  88         api_name        => "open-ils.search.z3950.marcxml_to_brn",
  89 );
  90
  91 sub marcxml_to_brn {
  92         my( $self, $client, $marcxml ) = @_;
  93
  94         my $tree;
  95         my $err;
  96
  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;
 104
 105         my $flat = OpenILS::Utils::FlatXML->new( xml => $marcxml );
 106         my $doc = $flat->xml_to_doc();
 107
 108         $logger->debug("z3950: Turning doc into a nodeset...");
 109
 110         try {
 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 );
 114         } catch Error with {
 115                 $err = shift;
 116         };
 117
 118         if($err) {
 119                 $logger->error("z3950: Error turning doc into nodeset/node tree: $err");
 120                 return undef;
 121         } else {
 122                 return $tree;
 123         }
 124 }
 125
 126 __PACKAGE__->register_method(
 127         method  => "z39_search_by_string",
 128         api_name        => "open-ils.search.z3950.raw_string",
 129 );
 130
 131 sub z39_search_by_string {
 132
 133         my( $self, $connection, $authtoken, $params ) = @_;
 134         my( $hst, $prt, $db, $usr, $pw );
 135
 136
 137         my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
 138         return $evt if $evt;
 139         my $service = $$params{service};
 140         my $search      = $$params{search};
 141
 142         if( $service ) {
 143
 144                 ($hst, $prt, $db, $usr, $pw ) = _load_settings($$params{service});
 145                 $usr    = ($$params{username}) ? $$params{username} : $usr;
 146                 $pw     = ($$params{password}) ? $$params{password} : $pw;
 147
 148         } else {
 149                 $hst    = $$params{host};
 150                 $prt    = $$params{prt};
 151                 $db     = $$params{db};
 152                 $usr    = $$params{username};
 153                 $pw     = $$params{password};
 154                 $service = "(custom)";
 155         }
 156
 157
 158         $logger->info("z3950:  Search App connecting:  service=$service, ".
 159                 "host=$hst, port=$prt, db=$db, username=$usr, password=$pw, search=$search" );
 160
 161         return OpenILS::Event->new('BAD_PARAMS') unless ($hst and $prt and $db);
 162
 163         $usr ||= ""; $pw        ||= "";
 164
 165         my $conn = new Net::Z3950::Connection(
 166                 $hst, $prt,
 167                 databaseName                            => $db,
 168                 user                                                    => $usr,
 169                 password                                                => $pw,
 170                 preferredRecordSyntax   => $output,
 171         );
 172
 173         if(!$conn) {
 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
 176         }
 177
 178         my $rs = $conn->search( $search );
 179         return OpenILS::Event->new('Z3950_SEARCH_FAILED') unless $rs;
 180
 181         # We want nice full records
 182         $rs->option(elementSetName => "f");
 183
 184         my $records = [];
 185         my $hash = {};
 186
 187         $hash->{count} =  $rs->size();
 188         $logger->info("z3950: Search recovered " . $hash->{count} . " records");
 189
 190         # until there is a more graceful way to handle this
 191         if($hash->{count} > 20) { return $hash; }
 192
 193         for( my $x = 0; $x != $hash->{count}; $x++ ) {
 194                 $logger->debug("z3950: Churning on z39 record count $x");
 195
 196                 my $rec = $rs->record($x+1);
 197                 my $marc = MARC::Record->new_from_usmarc($rec->rawdata());
 198
 199                 # parse the XML
 200                 my $doc = XML::LibXML->new->parse_string($marc->as_xml_record());
 201
 202                 # strip the <xml> declaration and run through entityize
 203                 my $marcxml = entityize( $doc->documentElement->toString );
 204                 my $mods;
 205
 206                 my $u = OpenILS::Utils::ModsParser->new();
 207
 208                 warn "z3950: creating mvr\n";
 209                 $u->start_mods_batch( $marcxml );
 210                 $mods = $u->finish_mods_batch();
 211
 212                 push @$records, { 'mvr' => $mods, 'marcxml' => $marcxml };
 213         }
 214
 215         $logger->debug("z3950: got here near the end with " . scalar(@$records) . " records." );
 216
 217         $hash->{records} = $records;
 218         return $hash;
 219
 220 }
 221
 222
 223 __PACKAGE__->register_method(
 224         method  => "tcn_search",
 225         api_name        => "open-ils.search.z3950.tcn",
 226 );
 227
 228 sub tcn_search {
 229         my($self, $connection, $authtoken, $tcn, $service, $username, $password) = @_;
 230
 231         my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
 232         return $evt if $evt;
 233         $service ||= $defserv;
 234
 235         my $attr = $settings_client->config_value("z3950", $service, "tcnattr");
 236
 237         $logger->info("z3950: Searching for TCN $tcn");
 238
 239         return $self->z39_search_by_string(
 240                 $connection, $authtoken, {
 241                         search  => "\@attr 1=$attr \"$tcn\"",
 242                         service => $service,
 243                         username        => $username,
 244                         password        => $password,
 245                 }
 246         );
 247 }
 248
 249
 250 __PACKAGE__->register_method(
 251         method  => "isbn_search",
 252         api_name        => "open-ils.search.z3950.isbn",
 253 );
 254
 255 sub isbn_search {
 256         my( $self, $connection, $authtoken, $isbn, $service, $username, $password ) = @_;
 257
 258         my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
 259         return $evt if $evt;
 260         $service ||= $defserv;
 261
 262         my $attr = $settings_client->config_value("z3950", $service, "isbnattr");
 263
 264         $logger->info("z3950: Performing ISBN search : $isbn");
 265
 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,
 272                 }
 273         );
 274 }
 275
 276
 277 __PACKAGE__->register_method(
 278         method  => "query_interfaces",
 279         api_name        => "open-ils.search.z3950.services.retrieve",
 280 );
 281
 282 sub query_interfaces {
 283         my( $self, $client, $authtoken ) = @_;
 284         my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
 285
 286         my $services = $settings_client->config_value("z3950");
 287         $services = { $services } unless ref($services);
 288
 289         return [ grep { $_ ne 'default' } keys %$services ];
 290 }
 291
 292
 293
 294
 295
 296 1;