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