723b8228c4bd6787238a03a6d0e380685c5d36e3
[Evergreen.git] / 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;