[RT17143] Clean up of 0011 date1
[sitka/sitka-tools.git] / data_cleanup / date1 / date1_0011_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 a list of records with bad 008 date1 values.
57     my $sth = $dbh->prepare("SELECT DISTINCT mrfr.record
58         FROM metabib.real_full_rec 
59         WHERE tag = '008' AND substring(value, 8, 4) = '0011'");
60     $sth->execute;
61     my $records = $sth->fetchall_arrayref([0]);
62     $sth->finish;
63
64     my $authtoken = new_auth_token();
65
66     my $marc = '';
67     my $record_id = '';
68     for (@$records) {
69         print "Getting MARC for record: " . $_->[0] . "\n";
70         $record_id = $_->[0];
71         my ($xml, $create_date) = get_marc_by_id($authtoken, $record_id);    
72         $marc = MARC::Record->new_from_xml($xml, 'UTF-8');
73
74         my ($year, $month, $day) = $create_date =~ /\d\d(\d\d)-(\d\d)-(\d\d)/;
75
76         my $date_entered = "$year$month$day";
77
78         if (length($date_entered) < 6) {
79             #We will use this bogus date entered
80             #to allow us to easily identify
81             #bad 008/00-05 create by this update.
82             $date_entered = '000123';
83         }
84
85         my $field_260 = $marc->field('260');
86         my $field_264 = $marc->field('264');
87         my $pubdate = '';
88         my $four_digit_capture = qr/^\D*(\d{4}).*$/;
89         my $exactly_four_digits = qr/^\d{4}$/;
90
91         if ($field_264) {
92             $pubdate = $field_264->subfield('c');
93         }
94
95         $pubdate =~ s/$four_digit_capture/$1/;
96
97         #There is a chance we have a bogus 264 and
98         #a valid 260, so reset pubdate if 264 does 
99         #not contain exactly 4 digit characters
100         #There is still a chance that a 5 digita
101         #date is in 264 $c, but this will be an
102         #outlier.
103         if ($pubdate !~ /$exactly_four_digits/) {
104             $pubdate = '';
105         }
106
107         if ($field_260 && !$pubdate) {
108             $pubdate = $field_260->subfield('c');
109         }
110
111         print $pubdate . "\n";
112         exit;
113
114         $pubdate =~ s/$four_digit_capture/$1/;
115
116         #If there is not exactly four digits
117         #from 260 we reset pubdate to a bogus
118         #value that we can use to identify
119         #bad record data
120         if ($pubdate !~ /$exactly_four_digits/) {
121             $pubdate = '0011';
122         }
123
124         if (length($pubdate) != 4) {
125             #We will use this bogus pubdate
126             #To help us identify any records
127             #that had 260 or 264 $c values 
128             #less than 4 digits
129             $pubdate = '0011';
130         }
131
132         my $field_008 = $marc->field('008');
133
134         my $data_008 =  $field_008->data();
135
136         my $data_008_00_to_05 = substr($data_008, 0, 6);
137
138         my $data_008_06 = substr($data_008, 6, 1);
139
140         $data_008_00_to_05 =~ s/[^0-9]//g;
141
142         #If we have less than 6 characters at the start
143         #then we have bad data.  Replace it with the
144         #create_date from the BRE object.
145         if (length($data_008_00_to_05) < 6) {
146             $data_008_00_to_05 = $date_entered;
147         }
148
149         #If we have invalid 008/06 characters
150         #then we have bad data.  Use n as the 008/06 
151         #which indicates Dates unknown
152
153         if ($data_008_06 !~ /[bcdeikmnpqrstu|]/) {
154             $data_008_06 = 'n';
155         }
156
157         my $data_008_after_10 = substr($data_008, 11);
158
159         my $data_008_with_pubdate =  "$data_008_00_to_05$data_008_06$pubdate$data_008_after_10";
160
161         $field_008->update($data_008_with_pubdate);
162
163         update_marc_by_id($authtoken, $record_id, $marc->as_xml());
164
165     }
166
167     clear_auth_token($authtoken);
168 }
169
170 sub init_database_connections {
171     print "\nInitializing database connection\n";
172     # Check database connections
173     my @databases = $osrfxml->findnodes('//database');
174
175     # If we have no database connections, this is probably the OpenSRF version
176     # of opensrf.xml
177     if (!@databases) {
178         my $de = "* WARNING: There are no database connections defined in " .
179             "opensrf.xml. These are defined in services such as " .
180             "open-ils.cstore and open-ils.reporter. Please ensure that " .
181             "your opensrf_core.xml and opensrf.xml configuration files " .
182             "are based on the examples shipped with Evergreen instead of " .
183             "OpenSRF.\n";
184         $output .= $de;
185         warn $de;
186     }
187
188     foreach my $database (@databases) {
189         unless ($database->parentNode->parentNode->localname eq 'open-ils.cstore') {
190             next;
191         }
192
193         my $db_name = $database->findvalue("./db");    
194         if (!$db_name) {
195             $db_name = $database->findvalue("./name");    
196         }
197         my $db_host = $database->findvalue("./host");    
198         my $db_port = $database->findvalue("./port");    
199         my $db_user = $database->findvalue("./user");    
200         my $db_pw = $database->findvalue("./pw");    
201
202         my $osrf_xpath;
203         foreach my $node ($database->findnodes("ancestor::node()")) {
204             next unless $node->nodeType == XML::LibXML::XML_ELEMENT_NODE;
205             $osrf_xpath .= "/" . $node->nodeName;
206         }
207
208         my $dbh = db_connect($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath);
209
210         return $dbh;
211     }
212 }
213
214 sub db_connect {
215     my ($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath) = @_;
216
217     my $dsn = "dbi:Pg:dbname=$db_name;host=$db_host;port=$db_port";
218     my $dbh;
219
220     $dbh = DBI->connect($dsn, $db_user, $db_pw);
221
222     # Short-circuit if we didn't connect successfully
223     unless($dbh) {
224         warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
225         return -1;
226     }
227
228     return $dbh;
229 }
230
231 sub new_auth_token {
232     if ($staff_username eq '' || $staff_password eq '') {
233         print "staff_username and staff_password need to be set at the command line\n";
234         exit;
235     }
236     my $authtoken = oils_login($staff_username, $staff_password, 'staff') 
237         or die "Unable to login to Evergreen as user $staff_username";
238     return $authtoken;
239 }
240
241 sub clear_auth_token {
242     my ($authtoken) = @_;
243     $apputils->simplereq(
244         'open-ils.auth',
245         'open-ils.auth.session.delete',
246         $authtoken
247     );
248 }
249
250 sub get_marc_by_id {
251     my ($authtoken, $record_id) = @_;
252     my $bre = $apputils->simplereq(
253         'open-ils.pcrud',
254         'open-ils.pcrud.search.bre',
255         $authtoken,
256         {
257             id => $record_id
258         }
259     );
260
261     return ($bre->marc, $bre->create_date);
262 }
263
264 sub update_marc_by_id {
265     my ($authtoken, $record_id, $marc) = @_;
266
267     my $ret = $apputils->simplereq(
268         'open-ils.cat',
269         'open-ils.cat.biblio.record.marc.replace',
270         $authtoken,
271         $record_id,
272         $marc
273     );
274 }