[RT17143] Editing of date1 complete
[sitka/sitka-tools.git] / data_cleanup / date1 / date1_cleanup.pl
1 #!/usr/bin/perl
2 # vim:et:ts=4:sw=4:
3 use strict;
4 use warnings;
5
6 use DBI;
7 use OpenSRF::Utils::Config;
8 use Getopt::Long;
9 use Net::Domain;
10 use XML::LibXML;
11 use XML::LibXML::XPathContext;
12 use OpenSRF::AppSession;
13 use MARC::Record;
14 use MARC::File::XML (BinaryEncoding => 'UTF-8');
15
16 require '/srv/openils/bin/oils_header.pl';
17 use vars qw/$apputils/;
18
19 my $output = '';
20
21 my ($gather, $hostname, $core_config, $tmpdir) =
22     (0, Net::Domain::hostfqdn(), '/srv/openils/conf/opensrf_core.xml', '/tmp/');
23
24 my ($staff_username, $staff_password) = '';
25
26 GetOptions(
27     'gather' => \$gather,
28     'hostname=s' => \$hostname,
29     'config_file=s' => \$core_config,
30     'tempdir=s' => \$tmpdir,
31     'staff_username=s' => \$staff_username,
32     'staff_password=s' => \$staff_password,
33 );
34
35 (my $conf_dir = $core_config) =~ s#(.*)/.*#$1#;
36 OpenSRF::Utils::Config->load(config_file => $core_config);
37 my $conf = OpenSRF::Utils::Config->current;
38 my $settings_config = $conf->bootstrap->settings_config;
39
40 my $xmlparser = XML::LibXML->new();
41 my $confxml = $xmlparser->parse_file($core_config);
42 my $confxpc = XML::LibXML::XPathContext->new($confxml);
43 my $osrfxml = $xmlparser->parse_file($settings_config);
44
45 my $dbh = init_database_connections();
46
47 osrf_connect($core_config);
48
49 clean_date1_records($dbh);
50
51 $dbh->disconnect;
52
53 sub clean_date1_records {
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
70     my $authtoken = new_auth_token();
71
72     my $marc = '';
73     my $record_id = '';
74     for (@$records) {
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;
107     }
108 }
109
110 sub init_database_connections {
111     print "\nInitializing database connection\n";
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) {
129         unless ($database->parentNode->parentNode->localname eq 'open-ils.cstore') {
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         }
147
148         my $dbh = db_connect($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath);
149
150         return $dbh;
151     }
152 }
153
154 sub db_connect {
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";
158     my $dbh;
159
160     $dbh = DBI->connect($dsn, $db_user, $db_pw);
161
162     # Short-circuit if we didn't connect successfully
163     unless($dbh) {
164         warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
165         return -1;
166     }
167
168     return $dbh;
169 }
170
171 sub 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
181 sub clear_auth_token {
182     my ($authtoken) = @_;
183     $apputils->simplereq(
184         'open-ils.auth',
185         'open-ils.auth.session.delete',
186         $authtoken
187     );
188 }
189
190 sub 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
204 sub 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 }