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 }