[RT17143] Retrieving relevant record ids
[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
13 my $output = '';
14
15 my ($gather, $hostname, $core_config, $tmpdir) =
16     (0, Net::Domain::hostfqdn(), '/srv/openils/conf/opensrf_core.xml', '/tmp/');
17
18 GetOptions(
19     'gather' => \$gather,
20     'hostname=s' => \$hostname,
21     'config_file=s' => \$core_config,
22     'tempdir=s' => \$tmpdir,
23 );
24
25 (my $conf_dir = $core_config) =~ s#(.*)/.*#$1#;
26 OpenSRF::Utils::Config->load(config_file => $core_config);
27 my $conf = OpenSRF::Utils::Config->current;
28 my $settings_config = $conf->bootstrap->settings_config;
29
30 my $xmlparser = XML::LibXML->new();
31 my $confxml = $xmlparser->parse_file($core_config);
32 my $confxpc = XML::LibXML::XPathContext->new($confxml);
33 my $osrfxml = $xmlparser->parse_file($settings_config);
34
35 my $dbh = init_database_connections();
36
37 get_date1_records($dbh);
38
39 $dbh->disconnect;
40
41 sub get_date1_records {
42     my ($dbh) = @_;
43
44     # Get list of server languages
45     my $sth = $dbh->prepare("SELECT DISTINCT mrfr.record
46         FROM metabib.real_full_rec mrfr INNER JOIN biblio.record_entry bre ON mrfr.record = bre.id
47         INNER JOIN asset.call_number acn ON bre.id = acn.record
48         INNER JOIN asset.copy ac ON acn.id = ac.call_number
49         INNER JOIN actor.org_unit aou ON ac.circ_lib = aou.id
50         WHERE mrfr.record IN (SELECT record
51             FROM metabib.real_full_rec
52             WHERE tag = '008' AND substring(value, 8, 4) ~ '(^\\s*\$|^\\d{1,3}\$|[^0-9\\su]|203[1-9])')
53         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')");
54     $sth->execute;
55     my $records = $sth->fetchall_arrayref([0]);
56     $sth->finish;
57
58     for (@$records) {
59         print $_->[0] . "\n";
60     }
61 }
62
63 sub init_database_connections {
64     print "\nInitializing database connection\n";
65     # Check database connections
66     my @databases = $osrfxml->findnodes('//database');
67
68     # If we have no database connections, this is probably the OpenSRF version
69     # of opensrf.xml
70     if (!@databases) {
71         my $de = "* WARNING: There are no database connections defined in " .
72             "opensrf.xml. These are defined in services such as " .
73             "open-ils.cstore and open-ils.reporter. Please ensure that " .
74             "your opensrf_core.xml and opensrf.xml configuration files " .
75             "are based on the examples shipped with Evergreen instead of " .
76             "OpenSRF.\n";
77         $output .= $de;
78         warn $de;
79     }
80
81     foreach my $database (@databases) {
82         unless ($database->parentNode->parentNode->localname eq 'open-ils.cstore') {
83             next;
84         }
85
86         my $db_name = $database->findvalue("./db");    
87         if (!$db_name) {
88             $db_name = $database->findvalue("./name");    
89         }
90         my $db_host = $database->findvalue("./host");    
91         my $db_port = $database->findvalue("./port");    
92         my $db_user = $database->findvalue("./user");    
93         my $db_pw = $database->findvalue("./pw");    
94
95         my $osrf_xpath;
96         foreach my $node ($database->findnodes("ancestor::node()")) {
97             next unless $node->nodeType == XML::LibXML::XML_ELEMENT_NODE;
98             $osrf_xpath .= "/" . $node->nodeName;
99         }
100
101         my $dbh = db_connect($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath);
102
103         return $dbh;
104     }
105 }
106
107 sub db_connect {
108     my ($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath) = @_;
109
110     my $dsn = "dbi:Pg:dbname=$db_name;host=$db_host;port=$db_port";
111     my $dbh;
112
113     $dbh = DBI->connect($dsn, $db_user, $db_pw);
114
115     # Short-circuit if we didn't connect successfully
116     unless($dbh) {
117         warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
118         return -1;
119     }
120
121     return $dbh;
122 }