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