EG install scripts: force-change hostname from "non-prod" to "prod" when -p switch...

[sitka/sitka-tools.git] / backstage / backstage-merge.pl

#!/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) );
}