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
 154         my $rs = $conn->search( $search );
 155         return OpenILS::Event->new('Z3950_SEARCH_FAILED') unless $rs;
 156
 157         # We want nice full records
 158         $rs->option(elementSetName => "f");
 159
 160         my $records = [];
 161         my $hash = {};
 162
 163         $hash->{count} =  $rs->size();
 164         $logger->info("z3950: Search recovered " . $hash->{count} . " records");
 165
 166         # until there is a more graceful way to handle this
 167         if($hash->{count} > 20) { return $hash; }
 168
 169         for( my $x = 0; $x != $hash->{count}; $x++ ) {
 170                 $logger->debug("z3950: Churning on z39 record count $x");
 171
 172                 my $rec = $rs->record($x+1);
 173                 my $marc = MARC::Record->new_from_usmarc($rec->rawdata());
 174
 175                 my $marcxml = $marc->as_xml();
 176                 my $mods;
 177
 178                 my $u = OpenILS::Utils::ModsParser->new();
 179                 $u->start_mods_batch( $marcxml );
 180                 $mods = $u->finish_mods_batch();
 181
 182                 push @$records, { 'mvr' => $mods, 'marcxml' => $marcxml };
 183         }
 184
 185         $logger->debug("z3950: got here near the end with " . scalar(@$records) . " records." );
 186
 187         $hash->{records} = $records;
 188         return $hash;
 189
 190 }
 191
 192
 193 __PACKAGE__->register_method(
 194         method  => "tcn_search",
 195         api_name        => "open-ils.search.z3950.tcn",
 196 );
 197
 198 sub tcn_search {
 199         my($self, $connection, $authtoken, $tcn, $service) = @_;
 200
 201         my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
 202         return $evt if $evt;
 203         $service ||= $defserv;
 204
 205         my $attr = $settings_client->config_value("z3950", $service, "tcnattr");
 206
 207         $logger->info("z3950: Searching for TCN $tcn");
 208
 209         return $self->z39_search_by_string(
 210                 $connection, $authtoken, {
 211                         search => "\@attr 1=$attr \"$tcn\"",
 212                         service => $service });
 213 }
 214
 215
 216 __PACKAGE__->register_method(
 217         method  => "isbn_search",
 218         api_name        => "open-ils.search.z3950.isbn",
 219 );
 220
 221 sub isbn_search {
 222         my( $self, $connection, $authtoken, $isbn, $service ) = @_;
 223
 224         my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
 225         return $evt if $evt;
 226         $service ||= $defserv;
 227
 228         my $attr = $settings_client->config_value("z3950", $service, "isbnattr");
 229
 230         $logger->info("z3950: Performing ISBN search : $isbn");
 231
 232         return $self->z39_search_by_string(
 233                 $connection, $authtoken, {
 234                         search => "\@attr 1=$attr \"$isbn\"",
 235                         service => $service });
 236 }
 237
 238
 239 __PACKAGE__->register_method(
 240         method  => "query_interfaces",
 241         api_name        => "open-ils.search.z3950.services.retrieve",
 242 );
 243
 244 sub query_interfaces {
 245         my( $self, $client, $authtoken ) = @_;
 246         my( $requestor, $evt ) = $U->checksesperm($authtoken, 'REMOTE_Z3950_QUERY');
 247
 248         my $services = $settings_client->config_value("z3950");
 249         $services = { $services } unless ref($services);
 250
 251         return [ grep { $_ ne 'default' } keys %$services ];
 252 }
 253
 254
 255
 256
 257
 258 1;