install-eg.sh: SSL setup
[sitka/sitka-tools.git] / backstage / backstage-merge.pl
CommitLineData
f3477167
JF
1#!/bin/perl
2
3use MARC::Record;
4use MARC::Batch;
5use MARC::File::XML ( BinaryEncoding => 'utf-8' );
6use MARC::Charset;
7
8use Data::Dumper;
9use Unicode::Normalize;
10use Encode;
11use Digest::MD5 qw(md5_hex);
12
13use OpenSRF::System;
14use OpenSRF::Utils::SettingsClient;
15use OpenSRF::MultiSession;
16use OpenSRF::Utils::JSON;
17use OpenILS::Utils::Fieldmapper;
18use OpenILS::Application::AppUtils;
19
20use Getopt::Long;
21
22my $apputils = "OpenILS::Application::AppUtils";
23my $username = 'admin';
24my $password = 'open-ils';
25my $configfile = '/srv/openils/conf/opensrf_core.xml';
26my $cap = 5;
27my $verbose;
28my $quiet;
29my $help;
30
31
32GetOptions(
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);
41if ($help) {
42print <<"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]
51HELP
52 exit 0;
53}
54
55OpenSRF::System->bootstrap_client( config_file => $configfile);
56Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
57
58my $starttime = time;
59print STDERR "login..." if $verbose;
60my $auth = oils_login($username,$password);
61print STDERR "ok\n" if $verbose;
62
63print STDERR "opening batch..." if $verbose;
64my $fh = \*STDIN;
65my $batch = MARC::Batch->new( 'USMARC', $fh );
66print STDERR "ok\n" if $verbose;
67
68print STDERR "initialize osrf:ms..." if $verbose;
69my $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
93print STDERR "ok\n" if $verbose;
94
95print STDERR "connecting to open-ils.cat..." if $verbose;
96$cat->connect;
97print STDERR "ok\n" if $verbose;
98
99print STDERR "begin MARC loop\n" if $verbose;
100
101my $count = 0;
102while(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
130print STDERR "disconnecting catoverlay..." if $verbose;
131$cat->session_wait(1);
132$cat->disconnect;
133print STDERR "ok\n" if $verbose;
134
135oils_logout();
136print STDERR "done\n\n" if $verbose;
137
138
139sub 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#----------------------------------------------------------------
151sub 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#----------------------------------------------------------------
179sub oils_logout {
180 $apputils->simplereq(
181 'open-ils.auth',
182 'open-ils.auth.session.delete', (@_ ? shift : $authtoken) );
183}
184