LP#1760223: Update HTTP headers to follow standard
[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 ( BinaryEncoding => 'UTF-8' );
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         return Apache2::Const::OK;
51 }
52
53 sub handler {
54     my $r = shift;
55     my $cgi = new CGI;
56
57     # find some IDs ...
58     my @records;
59
60     @records = map { $_ ? ($_) : () } $cgi->param('id');
61
62     if (!@records) { # try for a file
63         my $file = $cgi->param('idfile');
64         if ($file) {
65             my $col = $cgi->param('idcolumn') || 0;
66             my $csv = new Text::CSV;
67
68             while (<$file>) {
69                 $csv->parse($_);
70                 my @data = $csv->fields;
71                 my $id = $data[$col];
72                 $id =~ s/\D+//o;
73                 next unless ($id);
74                 push @records, $id;
75             }
76         }
77     }
78
79     if (!@records) { # try pathinfo
80         my $path_rec = $cgi->path_info();
81         if ($path_rec) {
82             @records = map { $_ ? ($_) : () } split '/', $path_rec;
83         }
84     }
85
86     my $ses = OpenSRF::AppSession->create('open-ils.cstore');
87
88     # still no records ...
89     my $container = $cgi->param('containerid');
90     if ($container) {
91         my $bucket = $ses->request( 'open-ils.cstore.direct.container.biblio_record_entry_bucket.retrieve', $container )->gather(1);
92         unless($bucket) {
93             $r->log->error("No such bucket $container"); 
94             $logger->error("No such bucket $container"); 
95             return Apache2::Const::NOT_FOUND;
96         }
97         if ($bucket->pub !~ /t|1/oi) {
98             my $authid = $cgi->cookie('ses') || $cgi->param('ses');
99             my $auth = verify_login($authid);
100             if (!$auth) {
101                 return 403;
102             }
103         }
104         my $recs = $ses->request( 'open-ils.cstore.direct.container.biblio_record_entry_bucket_item.search.atomic', { bucket => $container } )->gather(1);
105         @records = map { ($_->target_biblio_record_entry) } @$recs;
106     }
107
108     my $type = $cgi->param('rectype') || 'biblio';
109     my $retrieve_func;
110     # STILL no records ...
111     my $queue_id = $cgi->param('queueid');
112     if ($queue_id) {
113         # check that we're logged in -- XXX necessary? conservative for now
114         my $authid = $cgi->cookie('ses') || $cgi->param('ses');
115         my $auth = verify_login($authid);
116         if (!$auth) {
117             return 403;
118         }
119
120         # validate type
121         my $queue_type;
122         if ($type eq 'biblio') {
123             $queue_type = 'bib';
124         } elsif ($type eq 'authority') {
125             $queue_type = $type;
126         } else {
127             return 400;
128         }
129
130         # does queue exist?  This check is really just for better error logging
131         my $queue = $ses->request( "open-ils.cstore.direct.vandelay.${queue_type}_queue.retrieve", $queue_id )->gather(1);
132         unless($queue) {
133             $r->log->error("No such queue $queue_id");
134             $logger->error("No such queue $queue_id");
135             return Apache2::Const::NOT_FOUND;
136         }
137
138         # fetch the records
139         my $query = {queue => $queue_id};
140         if ($cgi->param('nonimported')) {
141             $query->{import_time} = undef;
142         }
143         $retrieve_func = "vandelay.queued_${queue_type}_record";
144         my $recs = $ses->request( "open-ils.cstore.direct.${retrieve_func}.id_list.atomic", $query )->gather(1);
145         @records = @$recs;
146     } else {
147         $retrieve_func = "$type.record_entry";
148     }
149
150     return show_template($r) unless (@records);
151
152     if ($type ne 'biblio' && $type ne 'authority') {
153         return 400;
154     }
155
156     my $tcn_v = 'tcn_value';
157     my $tcn_s = 'tcn_source';
158
159     my $holdings = $cgi->param('holdings') if ($type eq 'biblio');
160     my $location = $cgi->param('location') || 'gaaagpl'; # just because...
161
162     my $format = $cgi->param('format') || 'USMARC';
163     $format = uc($format);
164
165     my $encoding = $cgi->param('encoding') || 'UTF-8';
166     $encoding = uc($encoding);
167
168     my $filename = $cgi->param('filename') || "export.$type.$encoding.$format";
169
170     binmode(STDOUT, ':raw') if ($encoding ne 'UTF-8');
171     binmode(STDOUT, ':utf8') if ($encoding eq 'UTF-8');
172
173     if (!grep { uc($format) eq $_ } @formats) {
174         return 400;
175     }
176
177     if ($format ne 'XML') {
178         my $ftype = 'MARC::File::' . $format;
179         $ftype->require;
180     }
181
182
183     $r->headers_out->set("Content-Disposition" => "attachment; filename=$filename");
184
185     if (uc($format) eq 'XML') {
186         $r->content_type('application/xml');
187     } else {
188         $r->content_type('application/octet-stream');
189     }
190
191     $r->print( <<"    HEADER" ) if (uc($format) eq 'XML');
192 <?xml version="1.0" encoding="$encoding"?>
193 <collection xmlns='http://www.loc.gov/MARC21/slim'>
194     HEADER
195
196     my %orgs;
197     my %shelves;
198     my %statuses;
199
200     my $flesh = {};
201     if ($holdings) {
202
203         my $req = $ses->request( 'open-ils.cstore.direct.actor.org_unit.search', { id => { '!=' => undef } } );
204
205             while (my $o = $req->recv) {
206                 next if ($req->failed);
207                 $o = $o->content;
208                 last unless ($o);
209                 $orgs{$o->id} = $o;
210             }
211             $req->finish;
212
213         $req = $ses->request( 'open-ils.cstore.direct.asset.copy_location.search', { id => { '!=' => undef } } );
214
215             while (my $s = $req->recv) {
216                 next if ($req->failed);
217                 $s = $s->content;
218                 last unless ($s);
219                 $shelves{$s->id} = $s;
220             }
221             $req->finish;
222
223         $req = $ses->request( 'open-ils.cstore.direct.config.copy_status.search', { id => { '!=' => undef } } );
224
225             while (my $s = $req->recv) {
226                 next if ($req->failed);
227                 $s = $s->content;
228                 last unless ($s);
229                 $statuses{$s->id} = $s;
230             }
231             $req->finish;
232
233             $flesh = { flesh => 2, flesh_fields => { bre => [ 'call_numbers' ], acn => [ 'copies' ] } };
234     }
235
236     for my $i ( @records ) {
237             my $bib;
238             try {
239                 local $SIG{ALRM} = sub { die "TIMEOUT\n" };
240                 alarm(1);
241                 $bib = $ses->request( "open-ils.cstore.direct.$retrieve_func.retrieve", $i, $flesh )->gather(1);
242                 alarm(0);
243             } otherwise {
244                 warn "\n!!!!!! Timed out trying to read record $i\n";
245             };
246             alarm(0);
247
248         next unless $bib;
249
250             if (uc($format) eq 'BRE') {
251                 $r->print( OpenSRF::Utils::JSON->perl2JSON($bib) . "\n" );
252                 next;
253             }
254
255         try {
256
257             my $req = MARC::Record->new_from_xml( $bib->marc, $encoding, $format );
258             $req->encoding($encoding) if ($encoding eq 'UTF-8');
259
260             if ($holdings) {
261                 $req->delete_field( $_ ) for ($req->field('852')); # remove any legacy 852s
262
263                     my $cn_list = $bib->call_numbers;
264                     if ($cn_list && @$cn_list) {
265                             $cn_list = [ grep { $_->deleted eq 'f' } @$cn_list ];
266                             my $cp_list = [ grep { $_->deleted eq 'f' } map { @{ $_->copies } } @$cn_list ];
267                             if ($cp_list && @$cp_list) {
268
269                                 my %cn_map;
270                                 push @{$cn_map{$_->call_number}}, $_ for (@$cp_list);
271                                 
272                                 for my $cn ( @$cn_list ) {
273                                     my $cn_map_list = $cn_map{$cn->id};
274     
275                                     for my $cp ( @$cn_map_list ) {
276                                 
277                                 $req->append_fields(
278                                     MARC::Field->new(
279                                         852, '4', '', 
280                                         a => $location,
281                                         b => $orgs{$cn->owning_lib}->shortname,
282                                         b => $orgs{$cp->circ_lib}->shortname,
283                                         c => $shelves{$cp->location}->name,
284                                         j => $cn->label,
285                                         ($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
286                                         p => $cp->barcode,
287                                         ($cp->price ? ( y => $cp->price ) : ()),
288                                         ($cp->copy_number ? ( t => $cp->copy_number ) : ()),
289                                         ($cp->ref eq 't' ? ( x => 'reference' ) : ( x => 'nonreference' )),
290                                         ($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ( x => 'holdable' )),
291                                         ($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ( x => 'circulating' )),
292                                         ($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ( x => 'visible' )),
293                                         z => $statuses{$cp->status}->name,
294                                     )
295                                 );
296
297                             }
298                         }
299                     }
300                     }
301             }
302
303             if (uc($format) eq 'XML') {
304                 my $x = $req->as_xml_record;
305                 $x =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
306                 $r->print($x);
307             } elsif (uc($format) eq 'UNIMARC') {
308                 $r->print($req->as_usmarc);
309             } elsif (uc($format) eq 'USMARC') {
310                 $r->print($req->as_usmarc);
311             }
312
313             $r->rflush();
314
315         } otherwise {
316             my $e = shift;
317             warn "\n$e\n";
318         };
319
320     }
321
322     $r->print("</collection>\n") if ($format eq 'XML');
323
324     return Apache2::Const::OK;
325
326 }
327
328 sub verify_login {
329         my $auth_token = shift;
330         return undef unless $auth_token;
331
332         my $user = OpenSRF::AppSession
333                 ->create("open-ils.auth")
334                 ->request( "open-ils.auth.session.retrieve", $auth_token )
335                 ->gather(1);
336
337         if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
338                 return undef;
339         }
340
341         return $user if ref($user);
342         return undef;
343 }
344
345 sub show_template {
346     my $r = shift;
347
348     $r->content_type('text/html');
349     $r->print(<<HTML);
350
351 <html>
352     <head>
353         <title>Record Export</title>
354     </head>
355     <body>
356         <form method="POST" enctype="multipart/form-data">
357             Use field number <input type="text" size="2" maxlength="2" name="idcolumn" value="0"/> (starting from 0)
358             from CSV file <input type="file" name="idfile"/>
359             <br/><br/> <b>or</b> <br/><br/>
360             Record ID <input type="text" size="12" maxlength="12" name="id"/>
361             <br/><br/> Record Type:
362             <select name="rectype">
363                 <option value="biblio">Bibliographic Records</option>
364                 <option value="authority">Authority Records</option>
365             </select>
366             <br/> Record Format:
367             <select name="format">
368                 <option value="USMARC">MARC21</option>
369                 <option value="UNIMARC">UNIMARC</option>
370                 <option value="XML">MARC XML</option>
371                 <option value="BRE">Evergreen BRE</option>
372             </select>
373             <br/> Record Encoding:
374             <select name="encoding">
375                 <option value="UTF-8">UTF-8</option>
376                 <option value="MARC8">MARC8</option>
377             </select>
378             <br/> Include holdings in Bibliographic Records:
379             <input type="checkbox" name="holdings" value="1">
380             <br/><br/><input type="submit" value="Retrieve Records"/>
381         </form>
382     </body>
383 </html>
384
385 HTML
386
387     return Apache2::Const::OK;
388 }
389
390 1;