[RT17143] Editing of date1 complete
[sitka/sitka-tools.git] / data_cleanup / date1 / date1_cleanup.pl
CommitLineData
69ed3052 1#!/usr/bin/perl
1908f92a 2# vim:et:ts=4:sw=4:
69ed3052
LW
3use strict;
4use warnings;
5
6use DBI;
7use OpenSRF::Utils::Config;
8use Getopt::Long;
9use Net::Domain;
0f46c84e
LW
10use XML::LibXML;
11use XML::LibXML::XPathContext;
33c7b8ef
LW
12use OpenSRF::AppSession;
13use MARC::Record;
14use MARC::File::XML (BinaryEncoding => 'UTF-8');
15
16require '/srv/openils/bin/oils_header.pl';
17use vars qw/$apputils/;
0f46c84e
LW
18
19my $output = '';
69ed3052
LW
20
21my ($gather, $hostname, $core_config, $tmpdir) =
22 (0, Net::Domain::hostfqdn(), '/srv/openils/conf/opensrf_core.xml', '/tmp/');
23
33c7b8ef
LW
24my ($staff_username, $staff_password) = '';
25
69ed3052
LW
26GetOptions(
27 'gather' => \$gather,
28 'hostname=s' => \$hostname,
29 'config_file=s' => \$core_config,
30 'tempdir=s' => \$tmpdir,
33c7b8ef
LW
31 'staff_username=s' => \$staff_username,
32 'staff_password=s' => \$staff_password,
69ed3052
LW
33);
34
35(my $conf_dir = $core_config) =~ s#(.*)/.*#$1#;
36OpenSRF::Utils::Config->load(config_file => $core_config);
37my $conf = OpenSRF::Utils::Config->current;
38my $settings_config = $conf->bootstrap->settings_config;
39
40my $xmlparser = XML::LibXML->new();
41my $confxml = $xmlparser->parse_file($core_config);
42my $confxpc = XML::LibXML::XPathContext->new($confxml);
43my $osrfxml = $xmlparser->parse_file($settings_config);
44
1908f92a 45my $dbh = init_database_connections();
0f46c84e 46
33c7b8ef
LW
47osrf_connect($core_config);
48
49clean_date1_records($dbh);
1908f92a
LW
50
51$dbh->disconnect;
52
33c7b8ef 53sub clean_date1_records {
1908f92a
LW
54 my ($dbh) = @_;
55
56 # Get list of server languages
57 my $sth = $dbh->prepare("SELECT DISTINCT mrfr.record
58 FROM metabib.real_full_rec mrfr INNER JOIN biblio.record_entry bre ON mrfr.record = bre.id
59 INNER JOIN asset.call_number acn ON bre.id = acn.record
60 INNER JOIN asset.copy ac ON acn.id = ac.call_number
61 INNER JOIN actor.org_unit aou ON ac.circ_lib = aou.id
62 WHERE mrfr.record IN (SELECT record
63 FROM metabib.real_full_rec
64 WHERE tag = '008' AND substring(value, 8, 4) ~ '(^\\s*\$|^\\d{1,3}\$|[^0-9\\su]|203[1-9])')
65 AND (tag = '260' OR tag = '264') AND subfield = 'c' AND value ~ '\\d{1,4}' AND bre.deleted = false AND aou.shortname NOT IN ('MWP', 'AB', 'LB', 'ITC', 'HBCA')");
66 $sth->execute;
67 my $records = $sth->fetchall_arrayref([0]);
68 $sth->finish;
69
33c7b8ef
LW
70 my $authtoken = new_auth_token();
71
72 my $marc = '';
73 my $record_id = '';
1908f92a 74 for (@$records) {
33c7b8ef
LW
75 print "Getting MARC for record: " . $_->[0] . "\n";
76 $record_id = $_->[0];
77 $marc = MARC::Record->new_from_xml(get_marc_by_id($authtoken, $record_id), 'UTF-8');
78
79 my $field_260 = $marc->field('260');
80 my $field_264 = $marc->field('264');
81 my $pubdate = '';
82
83 if ($field_264) {
84 $pubdate = $field_260->subfield('c');
85 }
86
87 if ($field_260 && !$pubdate) {
88 $pubdate = $field_260->subfield('c');
89 }
90
91 $pubdate =~ s/(\d{4}).*/$1/;
92
93 my $field_008 = $marc->field('008');
94
95 my $data_008 = $field_008->data();
96
97 my $data_008_00_to_06 = substr($data_008, 0, 7);
98 my $data_008_after_10 = substr($data_008, 11);
99
100 my $data_008_with_pubdate = "$data_008_00_to_06$pubdate$data_008_after_10";
101
102 $field_008->update($data_008_with_pubdate);
103
104 update_marc_by_id($authtoken, $record_id, $marc->as_xml());
105
106 exit;
1908f92a
LW
107 }
108}
109
110sub init_database_connections {
111 print "\nInitializing database connection\n";
69ed3052
LW
112 # Check database connections
113 my @databases = $osrfxml->findnodes('//database');
114
115 # If we have no database connections, this is probably the OpenSRF version
116 # of opensrf.xml
117 if (!@databases) {
118 my $de = "* WARNING: There are no database connections defined in " .
119 "opensrf.xml. These are defined in services such as " .
120 "open-ils.cstore and open-ils.reporter. Please ensure that " .
121 "your opensrf_core.xml and opensrf.xml configuration files " .
122 "are based on the examples shipped with Evergreen instead of " .
123 "OpenSRF.\n";
124 $output .= $de;
125 warn $de;
126 }
127
128 foreach my $database (@databases) {
0f46c84e 129 unless ($database->parentNode->parentNode->localname eq 'open-ils.cstore') {
69ed3052
LW
130 next;
131 }
132
133 my $db_name = $database->findvalue("./db");
134 if (!$db_name) {
135 $db_name = $database->findvalue("./name");
136 }
137 my $db_host = $database->findvalue("./host");
138 my $db_port = $database->findvalue("./port");
139 my $db_user = $database->findvalue("./user");
140 my $db_pw = $database->findvalue("./pw");
141
142 my $osrf_xpath;
143 foreach my $node ($database->findnodes("ancestor::node()")) {
144 next unless $node->nodeType == XML::LibXML::XML_ELEMENT_NODE;
145 $osrf_xpath .= "/" . $node->nodeName;
146 }
1908f92a
LW
147
148 my $dbh = db_connect($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath);
149
150 return $dbh;
69ed3052
LW
151 }
152}
153
1908f92a 154sub db_connect {
69ed3052
LW
155 my ($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath) = @_;
156
157 my $dsn = "dbi:Pg:dbname=$db_name;host=$db_host;port=$db_port";
1908f92a
LW
158 my $dbh;
159
69ed3052
LW
160 $dbh = DBI->connect($dsn, $db_user, $db_pw);
161
162 # Short-circuit if we didn't connect successfully
163 unless($dbh) {
69ed3052 164 warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
1908f92a 165 return -1;
69ed3052
LW
166 }
167
1908f92a 168 return $dbh;
69ed3052 169}
33c7b8ef
LW
170
171sub new_auth_token {
172 if ($staff_username eq '' || $staff_password eq '') {
173 print "staff_username and staff_password need to be set at the command line\n";
174 exit;
175 }
176 my $authtoken = oils_login($staff_username, $staff_password, 'staff')
177 or die "Unable to login to Evergreen as user $staff_username";
178 return $authtoken;
179}
180
181sub clear_auth_token {
182 my ($authtoken) = @_;
183 $apputils->simplereq(
184 'open-ils.auth',
185 'open-ils.auth.session.delete',
186 $authtoken
187 );
188}
189
190sub get_marc_by_id {
191 my ($authtoken, $record_id) = @_;
192 my $bre = $apputils->simplereq(
193 'open-ils.pcrud',
194 'open-ils.pcrud.search.bre',
195 $authtoken,
196 {
197 id => $record_id
198 }
199 );
200
201 return $bre->marc;
202}
203
204sub update_marc_by_id {
205 my ($authtoken, $record_id, $marc) = @_;
206
207 my $ret = $apputils->simplereq(
208 'open-ils.cat',
209 'open-ils.cat.biblio.record.marc.replace',
210 $authtoken,
211 $record_id,
212 $marc
213 );
214}