Open-ILS/src/perlmods/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         if ($bucket->pub !~ /t|1/oi) {
  92                 my $authid = $cgi->cookie('ses') || $cgi->param('ses');
  93                 my $auth = verify_login($authid);
  94                     if (!$auth) {
  95                             return 403;
  96                 }
  97         }
  98                 my $recs = $ses->request( 'open-ils.cstore.direct.container.biblio_record_entry_bucket_item.search.atomic', { bucket => $container } )->gather(1);
  99                 @records = map { ($_->target_biblio_record_entry) } @$recs;
 100         }
 101
 102         return show_template($r) unless (@records);
 103
 104         my $type = $cgi->param('rectype') || 'biblio';
 105         if ($type ne 'biblio' && $type ne 'authority') {
 106                 return 400;
 107         }
 108
 109         my $tcn_v = 'tcn_value';
 110         my $tcn_s = 'tcn_source';
 111
 112         if ($type eq 'authority') {
 113                 $tcn_v = 'arn_value';
 114                 $tcn_s = 'arn_source';
 115         }
 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->delete_field( $_ ) for ($req->field(901));
 217
 218                         $req->append_fields(
 219                                 MARC::Field->new(
 220                                         901, '', '',
 221                                         a => $bib->$tcn_v,
 222                                         b => $bib->$tcn_s,
 223                                         c => $bib->id
 224                                 )
 225                         );
 226
 227
 228                         if ($holdings) {
 229                                 my $cn_list = $bib->call_numbers;
 230                                 if ($cn_list && @$cn_list) {
 231
 232                                         my $cp_list = [ map { @{ $_->copies } } @$cn_list ];
 233                                         if ($cp_list && @$cp_list) {
 234
 235                                                 my %cn_map;
 236                                                 push @{$cn_map{$_->call_number}}, $_ for (@$cp_list);
 237
 238                                                 for my $cn ( @$cn_list ) {
 239                                                         my $cn_map_list = $cn_map{$cn->id};
 240
 241                                                         for my $cp ( @$cn_map_list ) {
 242
 243                                                                 $req->append_fields(
 244                                                                         MARC::Field->new(
 245                                                                                 852, '4', '',
 246                                                                                 a => $location,
 247                                                                                 b => $orgs{$cn->owning_lib}->shortname,
 248                                                                                 b => $orgs{$cp->circ_lib}->shortname,
 249                                                                                 c => $shelves{$cp->location}->name,
 250                                                                                 j => $cn->label,
 251                                                                                 ($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
 252                                                                                 p => $cp->barcode,
 253                                                                                 ($cp->price ? ( y => $cp->price ) : ()),
 254                                                                                 ($cp->copy_number ? ( t => $cp->copy_number ) : ()),
 255                                                                                 ($cp->ref eq 't' ? ( x => 'reference' ) : ( x => 'nonreference' )),
 256                                                                                 ($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ( x => 'holdable' )),
 257                                                                                 ($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ( x => 'circulating' )),
 258                                                                                 ($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ( x => 'visible' )),
 259                                                                                 z => $statuses{$cp->status}->name,
 260                                                                         )
 261                                                                 );
 262
 263                                                         }
 264                                                 }
 265                                         }
 266                                 }
 267                         }
 268
 269                         if (uc($format) eq 'XML') {
 270                                 my $x = $req->as_xml_record;
 271                                 $x =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
 272                                 $r->print($x);
 273                         } elsif (uc($format) eq 'UNIMARC') {
 274                                 $r->print($req->as_unimarc);
 275                         } elsif (uc($format) eq 'USMARC') {
 276                                 $r->print($req->as_usmarc);
 277                         }
 278
 279             $r->rflush();
 280
 281                 } otherwise {
 282                         my $e = shift;
 283                         warn "\n$e\n";
 284                 };
 285
 286         }
 287
 288         $r->print("</collection>\n") if ($format eq 'XML');
 289
 290         return Apache2::Const::OK;
 291
 292 }
 293
 294 sub verify_login {
 295         my $auth_token = shift;
 296         return undef unless $auth_token;
 297
 298         my $user = OpenSRF::AppSession
 299                 ->create("open-ils.auth")
 300                 ->request( "open-ils.auth.session.retrieve", $auth_token )
 301                 ->gather(1);
 302
 303         if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
 304                 return undef;
 305         }
 306
 307         return $user if ref($user);
 308         return undef;
 309 }
 310
 311 sub show_template {
 312         my $r = shift;
 313
 314         $r->content_type('text/html');
 315         $r->print(<<HTML);
 316
 317 <html>
 318         <head>
 319                 <title>Record Export</title>
 320         </head>
 321         <body>
 322                 <form method="POST" enctype="multipart/form-data">
 323                         Use field number <input type="text" size="2" maxlength="2" name="idcolumn" value="0"/> (starting from 0)
 324                         from CSV file <input type="file" name="idfile"/>
 325                         <br/><br/> <b>or</b> <br/><br/>
 326                         Record ID <input type="text" size="12" maxlength="12" name="id"/>
 327                         <br/><br/> Record Type:
 328                         <select name="rectype">
 329                                 <option value="biblio">Bibliographic Records</option>
 330                                 <option value="authority">Authority Records</option>
 331                         </select>
 332                         <br/> Record Format:
 333                         <select name="format">
 334                                 <option value="USMARC">MARC21</option>
 335                                 <option value="UNIMARC">UNIMARC</option>
 336                                 <option value="XML">MARC XML</option>
 337                                 <option value="BRE">Evergreen BRE</option>
 338                         </select>
 339                         <br/> Record Encoding:
 340                         <select name="encoding">
 341                                 <option value="UTF-8">UTF-8</option>
 342                                 <option value="MARC8">MARC8</option>
 343                         </select>
 344                         <br/> Include holdings in Bibliographic Records:
 345                         <input type="checkbox" name="holdings" value="1">
 346                         <br/><br/><input type="submit" value="Retrieve Records"/>
 347                 </form>
 348         </body>
 349 </html>
 350
 351 HTML
 352
 353         return Apache2::Const::OK;
 354 }
 355
 356 1;