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
  16 use OpenSRF::EX qw(:try);
  17
  18 my $utils = "OpenILS::Application::Cat::Utils";
  19 my $apputils = "OpenILS::Application::AppUtils";
  20
  21 use OpenILS::Utils::ModsParser;
  22 use Data::Dumper;
  23
  24 my $output = "USMARC"; # only support output for now
  25 my $host;
  26 my $port;
  27 my $database;
  28 my $attr;
  29 my $username;
  30 my $password;
  31
  32 my $settings_client;
  33
  34 sub initialize {
  35         $settings_client = OpenSRF::Utils::SettingsClient->new();
  36         $host                   = $settings_client->config_value("z3950", "oclc", "host");
  37         $port                   = $settings_client->config_value("z3950", "oclc", "port");
  38         $database       = $settings_client->config_value("z3950", "oclc", "db");
  39         $attr                   = $settings_client->config_value("z3950", "oclc", "attr");
  40         $username       = $settings_client->config_value("z3950", "oclc", "username");
  41         $password       = $settings_client->config_value("z3950", "oclc", "password");
  42 }
  43
  44
  45 __PACKAGE__->register_method(
  46         method  => "z39_search_by_string",
  47         api_name        => "open-ils.search.z3950.raw_string",
  48 );
  49
  50 sub z39_search_by_string {
  51
  52         my( $self, $client, $server,
  53                         $port, $db, $search, $user, $pw ) = @_;
  54
  55         throw OpenSRF::EX::InvalidArg unless(
  56                         $server and $port and $db and $search);
  57
  58
  59         warn "Z39.50 search for $search\n";
  60
  61         $user ||= "";
  62         $pw     ||= "";
  63
  64         my $conn = new Net::Z3950::Connection(
  65                 $server, $port,
  66                 databaseName                            => $db,
  67                 user                                                    => $user,
  68                 password                                                => $pw,
  69                 preferredRecordSyntax   => $output,
  70         );
  71
  72
  73         my $rs = $conn->search( $search );
  74         if(!$rs) {
  75                 throw OpenSRF::EX::ERROR ("z39 search failed");
  76         }
  77
  78         my $records = [];
  79         my $hash = {};
  80
  81         $hash->{count} =  $rs->size();
  82         warn "Z3950 Search recovered " . $hash->{count} . " records\n";
  83
  84         # until there is a more graceful way to handle this
  85         if($hash->{count} > 20) { return $hash; }
  86
  87
  88         for( my $x = 0; $x != $hash->{count}; $x++ ) {
  89                 warn "Churning on z39 record count $x\n";
  90
  91                 my $rec = $rs->record($x+1);
  92                 my $marc = MARC::Record->new_from_usmarc($rec->rawdata());
  93
  94                 my $marcxml = $marc->as_xml();
  95                 my $flat = OpenILS::Utils::FlatXML->new( xml => $marcxml );
  96                 my $doc = $flat->xml_to_doc();
  97
  98
  99                 if( $doc->documentElement->nodeName =~ /collection/io ) {
 100                         $doc->setDocumentElement( $doc->documentElement->firstChild );
 101                         $doc->documentElement->setNamespace(
 102                                         "http://www.loc.gov/MARC21/slim", undef, 1);
 103                 }
 104
 105                 warn "Z3950 XML doc:\n" . $doc->toString . "\n";
 106
 107                 warn "Turning doc into a nodeset...\n";
 108
 109                 my $tree;
 110                 my $err;
 111
 112                 try {
 113                         my $nodes = OpenILS::Utils::FlatXML->new->xmldoc_to_nodeset($doc);
 114                         #use Data::Dumper;
 115                         #warn Dumper $nodes;
 116                         warn "turning nodeset into tree\n";
 117                         $tree = $utils->nodeset2tree( $nodes->nodeset );
 118                 } catch Error with {
 119                         $err = shift;
 120                 };
 121
 122                 if($err) {
 123                         warn "Error turning doc into nodeset/node tree: $err\n";
 124                 } else {
 125                         push @$records, $tree;
 126                 }
 127
 128         }
 129
 130         use Data::Dumper;
 131         warn "Returning marc tree " . Dumper($records) . "\n";
 132
 133         $hash->{records} = $records;
 134         return $hash;
 135
 136 }
 137
 138
 139 __PACKAGE__->register_method(
 140         method  => "import_search",
 141         api_name        => "open-ils.search.z3950.import",
 142 );
 143
 144 sub import_search {
 145         my($self, $client, $user_session, $string) = @_;
 146
 147         my $user_obj =
 148                 $apputils->check_user_session( $user_session ); #throws EX on error
 149
 150         return $self->z39_search_by_string(
 151                 $client, $host, $port, $database,
 152                         "\@attr 1=$attr \"$string\"", $username, $password );
 153 }
 154
 155
 156
 157
 158 1;