Merge branch 'master' of git+ssh://git.sitka.bclibraries.ca/sitka/sitka-tools

diff --git a/backstage/backstage-merge.pl b/backstage/backstage-merge.pl
new file mode 100644 (file)
index 0000000..bd39346
--- /dev/null
+++ b/backstage/backstage-merge.pl
@@ -0,0 +1,184 @@
+#!/bin/perl
+
+use MARC::Record;
+use MARC::Batch;
+use MARC::File::XML ( BinaryEncoding => 'utf-8' );
+use MARC::Charset;
+
+use Data::Dumper;
+use Unicode::Normalize;
+use Encode;
+use Digest::MD5 qw(md5_hex);
+
+use OpenSRF::System;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::MultiSession;
+use OpenSRF::Utils::JSON;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Application::AppUtils;
+
+use Getopt::Long;
+
+my $apputils = "OpenILS::Application::AppUtils";
+my $username = 'admin';
+my $password = 'open-ils';
+my $configfile = '/srv/openils/conf/opensrf_core.xml';
+my $cap = 5;
+my $verbose;
+my $quiet;
+my $help;
+
+
+GetOptions(
+        'help'       => \$help,
+        'username=s'      => \$username,
+        'password=s'       => \$password,
+        'cap=i'        => \$cap,
+       'configfile=s'  => \$configfile,
+       'quiet' => \$quiet,
+       'verbose'       => \$verbose
+);
+if ($help) {
+print <<"HELP";
+       --help : get help
+       --username : username for EG [admin]
+       --password : password for EG [open-ils]
+       --verbose : more stuff to STDERR
+       --quiet : less stuff to STDOUT
+       --overlaycap : MultiSession cap for open-ils.cat overlay calls
+       --mergecap : MultiSession cap for open-ils.cat merge calls
+       --configfile : path to opensrf_core.xml [/srv/openils/conf/opensrf_core.xml]
+HELP
+       exit 0;
+}
+
+OpenSRF::System->bootstrap_client( config_file => $configfile);
+Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
+
+my $starttime = time;
+print STDERR "login..." if $verbose;
+my $auth = oils_login($username,$password);
+print STDERR "ok\n" if $verbose;
+
+print STDERR "opening batch..." if $verbose;
+my $fh = \*STDIN;
+my $batch = MARC::Batch->new( 'USMARC', $fh );
+print STDERR "ok\n" if $verbose;
+
+print STDERR "initialize osrf:ms..." if $verbose;
+my $cat = OpenSRF::MultiSession->new(
+    app => 'open-ils.cat',
+    cap => $cap,
+    success_handler => sub {
+        my $ses = shift;
+        my $req = shift;
+        print STDERR $req->{meth} . " record: " . $req->{params}->[1] . " ok\n" if $verbose;
+    },
+    failure_handler => sub {
+        my $ses = shift;
+        my $req = shift;
+        warn "record $req->{params}->[0] failed: " . OpenSRF::Utils::JSON->perl2JSON($req->{response});
+    },
+    session_hash_function => sub {
+        my $ses = shift;
+        my $req = shift;
+        return $_[1]; # last parameter is the ID of the metarecord associated with the
+                       # request's target; using this as the hash function value ensures
+                       # that parallel targeters won't try to simultaneously handle two
+                       # hold requests that have overlapping pools of copies that could
+                       # fill those requests
+    }
+);
+
+print STDERR "ok\n" if $verbose;
+
+print STDERR "connecting to open-ils.cat..." if $verbose;
+$cat->connect;
+print STDERR "ok\n" if $verbose;
+
+print STDERR "begin MARC loop\n" if $verbose;
+
+my $count = 0;
+while(my $rec = $batch->next()){
+    $count++;
+    my @mergerecs = $rec->field("901");
+    my $main901 = shift @mergerecs;
+    my $recid = $main901->subfield('c');
+       
+    print "processing rec . $recid\n" if $verbose;
+
+    my @mergeids = map($_->subfield('c'), @mergerecs);
+    foreach(@mergerecs){
+       $rec->delete_fields( $_ );      
+    }
+
+    my $xml = $rec->as_xml;
+
+    #overlay
+    $cat->request("open-ils.cat.biblio.record.marc.replace.override", $auth, $recid, eg_clean_xml($xml));
+
+    if(@mergerecs > 0){
+        $cat->request( "open-ils.cat.biblio.records.merge", $auth, $recid, \@mergeids);
+    }
+    if (!$quiet && !($count % 50)) {
+       my $timediff = ( time - $starttime);
+       $timediff = 1 if $timediff < 1;
+        print STDERR "\r$count processed\t". $count / $timediff . " recs per sec ";
+    }
+}
+
+print STDERR "disconnecting catoverlay..." if $verbose;
+$cat->session_wait(1);
+$cat->disconnect;
+print STDERR "ok\n" if $verbose;
+
+oils_logout();
+print STDERR "done\n\n" if $verbose;
+
+
+sub eg_clean_xml {
+    my $xml = shift;
+    $xml =~ s/\n//sog;
+    $xml =~ s/^<\?xml.+\?\s*>//go;
+    $xml =~ s/>\s+</></go;
+    $xml =~ s/\p{Cc}//go;
+    $xml = NFC($xml);
+    $xml =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
+    $xml =~ s/[\x00-\x1f]//go;
+    return $xml;
+}
+#----------------------------------------------------------------
+sub oils_login {
+    my( $username, $password, $type ) = @_;
+
+    $type |= "staff";
+
+    my $seed = $apputils->simplereq( 'open-ils.auth',
+        'open-ils.auth.authenticate.init', $username );
+    err("No auth seed") unless $seed;
+
+    my $response = $apputils->simplereq( 'open-ils.auth',
+        'open-ils.auth.authenticate.complete',
+        {   username => $username,
+            password => md5_hex($seed . md5_hex($password)),
+            type => $type });
+
+    err("No auth response returned on login") unless $response;
+
+    #    die Dumper($response);
+
+    $authtime  = $response->{payload}->{authtime};
+    $authtoken = $response->{payload}->{authtoken};
+    return $authtoken;
+}
+    
+
+#----------------------------------------------------------------
+# Destroys the login session on the server 
+#----------------------------------------------------------------
+sub oils_logout {
+    $apputils->simplereq(
+        'open-ils.auth',
+        'open-ils.auth.session.delete', (@_ ? shift : $authtoken) );
+}
+