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
  17 use OpenSRF::EX qw(:try);
  18 use OpenSRF::Utils qw/:datetime/;
  19 use OpenSRF::Utils::Cache;
  20 use OpenSRF::System;
  21 use OpenSRF::AppSession;
  22 use XML::LibXML;
  23 use XML::LibXSLT;
  24
  25 use Encode;
  26 use Unicode::Normalize;
  27 use OpenILS::Utils::Fieldmapper;
  28 use OpenSRF::Utils::Logger qw/$logger/;
  29
  30 use MARC::Record;
  31 use MARC::File::XML;
  32
  33 use UNIVERSAL::require;
  34
  35 our @formats = qw/USMARC UNIMARC XML BRE/;
  36
  37 # set the bootstrap config and template include directory when
  38 # this module is loaded
  39 my $bootstrap;
  40
  41 sub import {
  42         my $self = shift;
  43         $bootstrap = shift;
  44 }
  45
  46
  47 sub child_init {
  48         OpenSRF::System->bootstrap_client( config_file => $bootstrap );
  49 }
  50
  51 sub handler {
  52         my $r = shift;
  53         my $cgi = new CGI;
  54
  55         my @records = $cgi->param('id');
  56         my $path_rec = $cgi->path_info();
  57
  58         if (!@records && $path_rec) {
  59                 @records = map { $_ ? ($_) : () } split '/', $path_rec;
  60         }
  61
  62         return 200 unless (@records);
  63
  64         my $type = $cgi->param('rectype') || 'biblio';
  65         if ($type ne 'biblio' && $type ne 'authority') {
  66                 die "Bad record type: $type";
  67         }
  68
  69         my $tcn_v = 'tcn_value';
  70         my $tcn_s = 'tcn_source';
  71
  72         if ($type eq 'authority') {
  73                 $tcn_v = 'arn_value';
  74                 $tcn_s = 'arn_source';
  75         }
  76
  77         my $holdings = $cgi->param('holdings') if ($type eq 'biblio');
  78         my $location = $cgi->param('location') || 'gaaagpl'; # just because...
  79
  80         my $format = $cgi->param('format') || 'USMARC';
  81         $format = uc($format);
  82
  83         my $encoding = $cgi->param('encoding') || 'UTF-8';
  84         $encoding = uc($encoding);
  85
  86         my $filename = $cgi->param('filename') || "export.$type.$encoding.$format";
  87
  88         binmode(STDOUT, ':raw') if ($encoding ne 'UTF-8');
  89         binmode(STDOUT, ':utf8') if ($encoding eq 'UTF-8');
  90
  91         if (!grep { uc($format) eq $_ } @formats) {
  92                 die     "Please select a supported format.  ".
  93                         "Right now that means one of [".
  94                         join('|',@formats). "]\n";
  95         }
  96
  97         if ($format ne 'XML') {
  98                 my $ftype = 'MARC::File::' . $format;
  99                 $ftype->require;
 100         }
 101
 102         my $ses = OpenSRF::AppSession->create('open-ils.cstore');
 103
 104         $r->headers_out->set("Content-Disposition" => "inline; filename=$filename");
 105
 106         if (uc($format) eq 'XML') {
 107                 $r->content_type('application/xml');
 108         } else {
 109                 $r->content_type('application/octet-stream');
 110         }
 111
 112         $r->print( <<"  HEADER" ) if (uc($format) eq 'XML');
 113 <?xml version="1.0" encoding="$encoding"?>
 114 <collection xmlns='http://www.loc.gov/MARC21/slim'>
 115         HEADER
 116
 117         my %orgs;
 118         my %shelves;
 119
 120         my $flesh = {};
 121         if ($holdings) {
 122
 123                 my $req = $ses->request( 'open-ils.cstore.direct.actor.org_unit.search', { id => { '!=' => undef } } );
 124
 125                 while (my $o = $req->recv) {
 126                         die $req->failed->stringify if ($req->failed);
 127                         $o = $o->content;
 128                         last unless ($o);
 129                         $orgs{$o->id} = $o;
 130                 }
 131                 $req->finish;
 132
 133                 $req = $ses->request( 'open-ils.cstore.direct.asset.copy_location.search', { id => { '!=' => undef } } );
 134
 135                 while (my $s = $req->recv) {
 136                         die $req->failed->stringify if ($req->failed);
 137                         $s = $s->content;
 138                         last unless ($s);
 139                         $shelves{$s->id} = $s;
 140                 }
 141                 $req->finish;
 142
 143                 $flesh = { flesh => 2, flesh_fields => { bre => [ 'call_numbers' ], acn => [ 'copies' ] } };
 144         }
 145
 146         for my $i ( @records ) {
 147                 my $bib;
 148                 try {
 149                         local $SIG{ALRM} = sub { die "TIMEOUT\n" };
 150                         alarm(1);
 151                         $bib = $ses->request( "open-ils.cstore.direct.$type.record_entry.retrieve", $i, $flesh )->gather(1);
 152                         alarm(0);
 153                 } otherwise {
 154                         warn "\n!!!!!! Timed out trying to read record $i\n";
 155                 };
 156                 alarm(0);
 157
 158                 next unless $bib;
 159
 160                 if (uc($format) eq 'BRE') {
 161                         $r->print( OpenSRF::Utils::JSON->perl2JSON($bib) );
 162                         next;
 163                 }
 164
 165                 try {
 166
 167                         my $req = MARC::Record->new_from_xml( $bib->marc, $encoding, $format );
 168                         $req->delete_field( $_ ) for ($req->field(901));
 169
 170                         $req->append_fields(
 171                                 MARC::Field->new(
 172                                         901, '', '',
 173                                         a => $bib->$tcn_v,
 174                                         b => $bib->$tcn_s,
 175                                         c => $bib->id
 176                                 )
 177                         );
 178
 179
 180                         if ($holdings) {
 181                                 my $cn_list = $bib->call_numbers;
 182                                 if ($cn_list && @$cn_list) {
 183
 184                                         my $cp_list = [ map { @{ $_->copies } } @$cn_list ];
 185                                         if ($cp_list && @$cp_list) {
 186
 187                                                 my %cn_map;
 188                                                 push @{$cn_map{$_->call_number}}, $_ for (@$cp_list);
 189
 190                                                 for my $cn ( @$cn_list ) {
 191                                                         my $cn_map_list = $cn_map{$cn->id};
 192
 193                                                         for my $cp ( @$cn_map_list ) {
 194
 195                                                                 $req->append_fields(
 196                                                                         MARC::Field->new(
 197                                                                                 852, '4', '',
 198                                                                                 a => $location,
 199                                                                                 b => $orgs{$cn->owning_lib}->shortname,
 200                                                                                 b => $orgs{$cp->circ_lib}->shortname,
 201                                                                                 c => $shelves{$cp->location}->name,
 202                                                                                 j => $cn->label,
 203                                                                                 ($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
 204                                                                                 p => $cp->barcode,
 205                                                                                 ($cp->price ? ( y => $cp->price ) : ()),
 206                                                                                 ($cp->copy_number ? ( t => $cp->copy_number ) : ()),
 207                                                                                 ($cp->ref eq 't' ? ( x => 'reference' ) : ()),
 208                                                                                 ($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ()),
 209                                                                                 ($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ()),
 210                                                                                 ($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ()),
 211                                                                         )
 212                                                                 );
 213
 214                                                         }
 215                                                 }
 216                                         }
 217                                 }
 218                         }
 219
 220                         if (uc($format) eq 'XML') {
 221                                 my $x = $req->as_xml_record;
 222                                 $x =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
 223                                 $r->print($x);
 224                         } elsif (uc($format) eq 'UNIMARC') {
 225                                 $r->print($req->as_unimarc);
 226                         } elsif (uc($format) eq 'USMARC') {
 227                                 $r->print($req->as_usmarc);
 228                         }
 229
 230                 } otherwise {
 231                         my $e = shift;
 232                         warn "\n$e\n";
 233                 };
 234
 235         }
 236
 237         $r->print("</collection>\n") if ($format eq 'XML');
 238
 239         return Apache2::Const::OK;
 240
 241 }
 242
 243 1;