install-osrf.sh: set ejabberd host correctly during registration on prod
[sitka/sitka-tools.git] / 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