[RT17143] Retrieving relevant record ids
[sitka/sitka-tools.git] / data_cleanup / date1 / date1_cleanup.pl
CommitLineData
69ed3052 1#!/usr/bin/perl
1908f92a 2# vim:et:ts=4:sw=4:
69ed3052
LW
3use strict;
4use warnings;
5
6use DBI;
7use OpenSRF::Utils::Config;
8use Getopt::Long;
9use Net::Domain;
0f46c84e
LW
10use XML::LibXML;
11use XML::LibXML::XPathContext;
12
13my $output = '';
69ed3052
LW
14
15my ($gather, $hostname, $core_config, $tmpdir) =
16 (0, Net::Domain::hostfqdn(), '/srv/openils/conf/opensrf_core.xml', '/tmp/');
17
18GetOptions(
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#;
26OpenSRF::Utils::Config->load(config_file => $core_config);
27my $conf = OpenSRF::Utils::Config->current;
28my $settings_config = $conf->bootstrap->settings_config;
29
30my $xmlparser = XML::LibXML->new();
31my $confxml = $xmlparser->parse_file($core_config);
32my $confxpc = XML::LibXML::XPathContext->new($confxml);
33my $osrfxml = $xmlparser->parse_file($settings_config);
34
1908f92a 35my $dbh = init_database_connections();
0f46c84e 36
1908f92a
LW
37get_date1_records($dbh);
38
39$dbh->disconnect;
40
41sub 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
63sub init_database_connections {
64 print "\nInitializing database connection\n";
69ed3052
LW
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) {
0f46c84e 82 unless ($database->parentNode->parentNode->localname eq 'open-ils.cstore') {
69ed3052
LW
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 }
1908f92a
LW
100
101 my $dbh = db_connect($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath);
102
103 return $dbh;
69ed3052
LW
104 }
105}
106
1908f92a 107sub db_connect {
69ed3052
LW
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";
1908f92a
LW
111 my $dbh;
112
69ed3052
LW
113 $dbh = DBI->connect($dsn, $db_user, $db_pw);
114
115 # Short-circuit if we didn't connect successfully
116 unless($dbh) {
69ed3052 117 warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
1908f92a 118 return -1;
69ed3052
LW
119 }
120
1908f92a 121 return $dbh;
69ed3052 122}