backstage/backstage-merge.pl

   1 #!/bin/perl
   2
   3 use MARC::Record;
   4 use MARC::Batch;
   5 use MARC::File::XML ( BinaryEncoding => 'utf-8' );
   6 use MARC::Charset;
   7
   8 use Data::Dumper;
   9 use Unicode::Normalize;
  10 use Encode;
  11 use Digest::MD5 qw(md5_hex);
  12
  13 use OpenSRF::System;
  14 use OpenSRF::Utils::SettingsClient;
  15 use OpenSRF::MultiSession;
  16 use OpenSRF::Utils::JSON;
  17 use OpenILS::Utils::Fieldmapper;
  18 use OpenILS::Application::AppUtils;
  19
  20 use Getopt::Long;
  21
  22 my $apputils = "OpenILS::Application::AppUtils";
  23 my $username = 'admin';
  24 my $password = 'open-ils';
  25 my $configfile = '/srv/openils/conf/opensrf_core.xml';
  26 my $cap = 5;
  27 my $verbose;
  28 my $quiet;
  29 my $help;
  30
  31
  32 GetOptions(
  33         'help'       => \$help,
  34         'username=s'      => \$username,
  35         'password=s'       => \$password,
  36         'cap=i' => \$cap,
  37         'configfile=s'  => \$configfile,
  38         'quiet' => \$quiet,
  39         'verbose'       => \$verbose
  40 );
  41 if ($help) {
  42 print <<"HELP";
  43         --help : get help
  44         --username : username for EG [admin]
  45         --password : password for EG [open-ils]
  46         --verbose : more stuff to STDERR
  47         --quiet : less stuff to STDOUT
  48         --overlaycap : MultiSession cap for open-ils.cat overlay calls
  49         --mergecap : MultiSession cap for open-ils.cat merge calls
  50         --configfile : path to opensrf_core.xml [/srv/openils/conf/opensrf_core.xml]
  51 HELP
  52         exit 0;
  53 }
  54
  55 OpenSRF::System->bootstrap_client( config_file => $configfile);
  56 Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
  57
  58 my $starttime = time;
  59 print STDERR "login..." if $verbose;
  60 my $auth = oils_login($username,$password);
  61 print STDERR "ok\n" if $verbose;
  62
  63 print STDERR "opening batch..." if $verbose;
  64 my $fh = \*STDIN;
  65 my $batch = MARC::Batch->new( 'USMARC', $fh );
  66 print STDERR "ok\n" if $verbose;
  67
  68 print STDERR "initialize osrf:ms..." if $verbose;
  69 my $cat = OpenSRF::MultiSession->new(
  70     app => 'open-ils.cat',
  71     cap => $cap,
  72     success_handler => sub {
  73         my $ses = shift;
  74         my $req = shift;
  75         print STDERR $req->{meth} . " record: " . $req->{params}->[1] . " ok\n" if $verbose;
  76     },
  77     failure_handler => sub {
  78         my $ses = shift;
  79         my $req = shift;
  80         warn "record $req->{params}->[0] failed: " . OpenSRF::Utils::JSON->perl2JSON($req->{response});
  81     },
  82     session_hash_function => sub {
  83         my $ses = shift;
  84         my $req = shift;
  85         return $_[1]; # last parameter is the ID of the metarecord associated with the
  86                        # request's target; using this as the hash function value ensures
  87                        # that parallel targeters won't try to simultaneously handle two
  88                        # hold requests that have overlapping pools of copies that could
  89                        # fill those requests
  90     }
  91 );
  92
  93 print STDERR "ok\n" if $verbose;
  94
  95 print STDERR "connecting to open-ils.cat..." if $verbose;
  96 $cat->connect;
  97 print STDERR "ok\n" if $verbose;
  98
  99 print STDERR "begin MARC loop\n" if $verbose;
 100
 101 my $count = 0;
 102 while(my $rec = $batch->next()){
 103     $count++;
 104     my @mergerecs = $rec->field("901");
 105     my $main901 = shift @mergerecs;
 106     my $recid = $main901->subfield('c');
 107
 108     print "processing rec . $recid\n" if $verbose;
 109
 110     my @mergeids = map($_->subfield('c'), @mergerecs);
 111     foreach(@mergerecs){
 112         $rec->delete_fields( $_ );
 113     }
 114
 115     my $xml = $rec->as_xml;
 116
 117     #overlay
 118     $cat->request("open-ils.cat.biblio.record.marc.replace.override", $auth, $recid, eg_clean_xml($xml));
 119
 120     if(@mergerecs > 0){
 121         $cat->request( "open-ils.cat.biblio.records.merge", $auth, $recid, \@mergeids);
 122     }
 123     if (!$quiet && !($count % 50)) {
 124         my $timediff = ( time - $starttime);
 125         $timediff = 1 if $timediff < 1;
 126         print STDERR "\r$count processed\t". $count / $timediff . " recs per sec ";
 127     }
 128 }
 129
 130 print STDERR "disconnecting catoverlay..." if $verbose;
 131 $cat->session_wait(1);
 132 $cat->disconnect;
 133 print STDERR "ok\n" if $verbose;
 134
 135 oils_logout();
 136 print STDERR "done\n\n" if $verbose;
 137
 138
 139 sub eg_clean_xml {
 140     my $xml = shift;
 141     $xml =~ s/\n//sog;
 142     $xml =~ s/^<\?xml.+\?\s*>//go;
 143     $xml =~ s/>\s+</></go;
 144     $xml =~ s/\p{Cc}//go;
 145     $xml = NFC($xml);
 146     $xml =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
 147     $xml =~ s/[\x00-\x1f]//go;
 148     return $xml;
 149 }
 150 #----------------------------------------------------------------
 151 sub oils_login {
 152     my( $username, $password, $type ) = @_;
 153
 154     $type |= "staff";
 155
 156     my $seed = $apputils->simplereq( 'open-ils.auth',
 157         'open-ils.auth.authenticate.init', $username );
 158     err("No auth seed") unless $seed;
 159
 160     my $response = $apputils->simplereq( 'open-ils.auth',
 161         'open-ils.auth.authenticate.complete',
 162         {   username => $username,
 163             password => md5_hex($seed . md5_hex($password)),
 164             type => $type });
 165
 166     err("No auth response returned on login") unless $response;
 167
 168     #    die Dumper($response);
 169
 170     $authtime  = $response->{payload}->{authtime};
 171     $authtoken = $response->{payload}->{authtoken};
 172     return $authtoken;
 173 }
 174
 175
 176 #----------------------------------------------------------------
 177 # Destroys the login session on the server
 178 #----------------------------------------------------------------
 179 sub oils_logout {
 180     $apputils->simplereq(
 181         'open-ils.auth',
 182         'open-ils.auth.session.delete', (@_ ? shift : $authtoken) );
 183 }
 184