Make Evergreen Perl modules installable via Module::Build to match OpenSRF
[working/Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / WWW / Exporter.pm
1 package OpenILS::WWW::Exporter;
2 use strict;
3 use warnings;
4 use bytes;
5
6 use Apache2::Log;
7 use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
8 use APR::Const    -compile => qw(:error SUCCESS);
9 use APR::Table;
10
11 use Apache2::RequestRec ();
12 use Apache2::RequestIO ();
13 use Apache2::RequestUtil;
14 use CGI;
15 use Data::Dumper;
16 use Text::CSV;
17
18 use OpenSRF::EX qw(:try);
19 use OpenSRF::Utils qw/:datetime/;
20 use OpenSRF::Utils::Cache;
21 use OpenSRF::System;
22 use OpenSRF::AppSession;
23 use XML::LibXML;
24 use XML::LibXSLT;
25
26 use Encode;
27 use Unicode::Normalize;
28 use OpenILS::Utils::Fieldmapper;
29 use OpenSRF::Utils::Logger qw/$logger/;
30
31 use MARC::Record;
32 use MARC::File::XML;
33
34 use UNIVERSAL::require;
35
36 our @formats = qw/USMARC UNIMARC XML BRE/;
37
38 # set the bootstrap config and template include directory when
39 # this module is loaded
40 my $bootstrap;
41
42 sub import {
43         my $self = shift;
44         $bootstrap = shift;
45 }
46
47
48 sub child_init {
49         OpenSRF::System->bootstrap_client( config_file => $bootstrap );
50 }
51
52 sub handler {
53         my $r = shift;
54         my $cgi = new CGI;
55
56         # find some IDs ...
57         my @records;
58
59         @records = map { $_ ? ($_) : () } $cgi->param('id');
60
61         if (!@records) { # try for a file
62                 my $file = $cgi->param('idfile');
63                 if ($file) {
64                         my $col = $cgi->param('idcolumn') || 0;
65                         my $csv = new Text::CSV;
66
67                         while (<$file>) {
68                                 $csv->parse($_);
69                                 my @data = $csv->fields;
70                                 my $id = $data[$col];
71                                 $id =~ s/\D+//o;
72                                 next unless ($id);
73                                 push @records, $id;
74                         }
75                 }
76         }
77
78         if (!@records) { # try pathinfo
79                 my $path_rec = $cgi->path_info();
80                 if ($path_rec) {
81                         @records = map { $_ ? ($_) : () } split '/', $path_rec;
82                 }
83         }
84
85         my $ses = OpenSRF::AppSession->create('open-ils.cstore');
86
87         # still no records ...
88         my $container = $cgi->param('containerid');
89         if ($container) {
90                 my $bucket = $ses->request( 'open-ils.cstore.direct.container.biblio_record_entry_bucket.retrieve', $container )->gather(1);
91         unless($bucket) {
92             $r->log->error("No such bucket $container"); 
93             $logger->error("No such bucket $container"); 
94             return Apache2::Const::NOT_FOUND;
95         }
96         if ($bucket->pub !~ /t|1/oi) {
97                 my $authid = $cgi->cookie('ses') || $cgi->param('ses');
98                 my $auth = verify_login($authid);
99                     if (!$auth) {
100                             return 403;
101                 }
102         }
103                 my $recs = $ses->request( 'open-ils.cstore.direct.container.biblio_record_entry_bucket_item.search.atomic', { bucket => $container } )->gather(1);
104                 @records = map { ($_->target_biblio_record_entry) } @$recs;
105         }
106
107         return show_template($r) unless (@records);
108
109         my $type = $cgi->param('rectype') || 'biblio';
110         if ($type ne 'biblio' && $type ne 'authority') {
111                 return 400;
112         }
113
114         my $tcn_v = 'tcn_value';
115         my $tcn_s = 'tcn_source';
116
117         my $holdings = $cgi->param('holdings') if ($type eq 'biblio');
118         my $location = $cgi->param('location') || 'gaaagpl'; # just because...
119
120         my $format = $cgi->param('format') || 'USMARC';
121         $format = uc($format);
122
123         my $encoding = $cgi->param('encoding') || 'UTF-8';
124         $encoding = uc($encoding);
125
126         my $filename = $cgi->param('filename') || "export.$type.$encoding.$format";
127
128         binmode(STDOUT, ':raw') if ($encoding ne 'UTF-8');
129         binmode(STDOUT, ':utf8') if ($encoding eq 'UTF-8');
130
131         if (!grep { uc($format) eq $_ } @formats) {
132                 return 400;
133         }
134
135         if ($format ne 'XML') {
136                 my $ftype = 'MARC::File::' . $format;
137                 $ftype->require;
138         }
139
140
141         $r->headers_out->set("Content-Disposition" => "inline; filename=$filename");
142
143         if (uc($format) eq 'XML') {
144                 $r->content_type('application/xml');
145         } else {
146                 $r->content_type('application/octet-stream');
147         }
148
149         $r->print( <<"  HEADER" ) if (uc($format) eq 'XML');
150 <?xml version="1.0" encoding="$encoding"?>
151 <collection xmlns='http://www.loc.gov/MARC21/slim'>
152         HEADER
153
154         my %orgs;
155         my %shelves;
156         my %statuses;
157
158         my $flesh = {};
159         if ($holdings) {
160
161                 my $req = $ses->request( 'open-ils.cstore.direct.actor.org_unit.search', { id => { '!=' => undef } } );
162
163                 while (my $o = $req->recv) {
164                         next if ($req->failed);
165                         $o = $o->content;
166                         last unless ($o);
167                         $orgs{$o->id} = $o;
168                 }
169                 $req->finish;
170
171                 $req = $ses->request( 'open-ils.cstore.direct.asset.copy_location.search', { id => { '!=' => undef } } );
172
173                 while (my $s = $req->recv) {
174                         next if ($req->failed);
175                         $s = $s->content;
176                         last unless ($s);
177                         $shelves{$s->id} = $s;
178                 }
179                 $req->finish;
180
181                 $req = $ses->request( 'open-ils.cstore.direct.config.copy_status.search', { id => { '!=' => undef } } );
182
183                 while (my $s = $req->recv) {
184                         next if ($req->failed);
185                         $s = $s->content;
186                         last unless ($s);
187                         $statuses{$s->id} = $s;
188                 }
189                 $req->finish;
190
191                 $flesh = { flesh => 2, flesh_fields => { bre => [ 'call_numbers' ], acn => [ 'copies' ] } };
192         }
193
194         for my $i ( @records ) {
195                 my $bib;
196                 try {
197                         local $SIG{ALRM} = sub { die "TIMEOUT\n" };
198                         alarm(1);
199                         $bib = $ses->request( "open-ils.cstore.direct.$type.record_entry.retrieve", $i, $flesh )->gather(1);
200                         alarm(0);
201                 } otherwise {
202                         warn "\n!!!!!! Timed out trying to read record $i\n";
203                 };
204                 alarm(0);
205
206                 next unless $bib;
207
208                 if (uc($format) eq 'BRE') {
209                         $r->print( OpenSRF::Utils::JSON->perl2JSON($bib) . "\n" );
210                         next;
211                 }
212
213                 try {
214
215                         my $req = MARC::Record->new_from_xml( $bib->marc, $encoding, $format );
216                         $req->encoding($encoding) if ($encoding eq 'UTF-8');
217
218                         if ($holdings) {
219                                 $req->delete_field( $_ ) for ($req->field('852')); # remove any legacy 852s
220                                 my $cn_list = $bib->call_numbers;
221                                 if ($cn_list && @$cn_list) {
222
223                                         my $cp_list = [ map { @{ $_->copies } } @$cn_list ];
224                                         if ($cp_list && @$cp_list) {
225
226                                                 my %cn_map;
227                                                 push @{$cn_map{$_->call_number}}, $_ for (@$cp_list);
228                                         
229                                                 for my $cn ( @$cn_list ) {
230                                                         my $cn_map_list = $cn_map{$cn->id};
231         
232                                                         for my $cp ( @$cn_map_list ) {
233                                         
234                                                                 $req->append_fields(
235                                                                         MARC::Field->new(
236                                                                                 852, '4', '', 
237                                                                                 a => $location,
238                                                                                 b => $orgs{$cn->owning_lib}->shortname,
239                                                                                 b => $orgs{$cp->circ_lib}->shortname,
240                                                                                 c => $shelves{$cp->location}->name,
241                                                                                 j => $cn->label,
242                                                                                 ($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
243                                                                                 p => $cp->barcode,
244                                                                                 ($cp->price ? ( y => $cp->price ) : ()),
245                                                                                 ($cp->copy_number ? ( t => $cp->copy_number ) : ()),
246                                                                                 ($cp->ref eq 't' ? ( x => 'reference' ) : ( x => 'nonreference' )),
247                                                                                 ($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ( x => 'holdable' )),
248                                                                                 ($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ( x => 'circulating' )),
249                                                                                 ($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ( x => 'visible' )),
250                                                                                 z => $statuses{$cp->status}->name,
251                                                                         )
252                                                                 );
253
254                                                         }
255                                                 }
256                                         }
257                                 }
258                         }
259
260                         if (uc($format) eq 'XML') {
261                                 my $x = $req->as_xml_record;
262                                 $x =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
263                                 $r->print($x);
264                         } elsif (uc($format) eq 'UNIMARC') {
265                                 $r->print($req->as_usmarc);
266                         } elsif (uc($format) eq 'USMARC') {
267                                 $r->print($req->as_usmarc);
268                         }
269
270             $r->rflush();
271
272                 } otherwise {
273                         my $e = shift;
274                         warn "\n$e\n";
275                 };
276
277         }
278
279         $r->print("</collection>\n") if ($format eq 'XML');
280
281         return Apache2::Const::OK;
282
283 }
284
285 sub verify_login {
286         my $auth_token = shift;
287         return undef unless $auth_token;
288
289         my $user = OpenSRF::AppSession
290                 ->create("open-ils.auth")
291                 ->request( "open-ils.auth.session.retrieve", $auth_token )
292                 ->gather(1);
293
294         if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
295                 return undef;
296         }
297
298         return $user if ref($user);
299         return undef;
300 }
301
302 sub show_template {
303         my $r = shift;
304
305         $r->content_type('text/html');
306         $r->print(<<HTML);
307
308 <html>
309         <head>
310                 <title>Record Export</title>
311         </head>
312         <body>
313                 <form method="POST" enctype="multipart/form-data">
314                         Use field number <input type="text" size="2" maxlength="2" name="idcolumn" value="0"/> (starting from 0)
315                         from CSV file <input type="file" name="idfile"/>
316                         <br/><br/> <b>or</b> <br/><br/>
317                         Record ID <input type="text" size="12" maxlength="12" name="id"/>
318                         <br/><br/> Record Type:
319                         <select name="rectype">
320                                 <option value="biblio">Bibliographic Records</option>
321                                 <option value="authority">Authority Records</option>
322                         </select>
323                         <br/> Record Format:
324                         <select name="format">
325                                 <option value="USMARC">MARC21</option>
326                                 <option value="UNIMARC">UNIMARC</option>
327                                 <option value="XML">MARC XML</option>
328                                 <option value="BRE">Evergreen BRE</option>
329                         </select>
330                         <br/> Record Encoding:
331                         <select name="encoding">
332                                 <option value="UTF-8">UTF-8</option>
333                                 <option value="MARC8">MARC8</option>
334                         </select>
335                         <br/> Include holdings in Bibliographic Records:
336                         <input type="checkbox" name="holdings" value="1">
337                         <br/><br/><input type="submit" value="Retrieve Records"/>
338                 </form>
339         </body>
340 </html>
341
342 HTML
343
344         return Apache2::Const::OK;
345 }
346
347 1;