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