[RT17143] First go at date1 cleanup settings
[sitka/sitka-tools.git] / data_cleanup / date1 / date1_cleanup.pl
1 #!/usr/bin/perl
2 # vim:et:ts=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 ($gather, $hostname, $core_config, $tmpdir) =
14     (0, Net::Domain::hostfqdn(), '/srv/openils/conf/opensrf_core.xml', '/tmp/');
15
16 GetOptions(
17     'gather' => \$gather,
18     'hostname=s' => \$hostname,
19     'config_file=s' => \$core_config,
20     'tempdir=s' => \$tmpdir,
21 );
22
23 (my $conf_dir = $core_config) =~ s#(.*)/.*#$1#;
24 OpenSRF::Utils::Config->load(config_file => $core_config);
25 my $conf = OpenSRF::Utils::Config->current;
26 my $settings_config = $conf->bootstrap->settings_config;
27
28 my $xmlparser = XML::LibXML->new();
29 my $confxml = $xmlparser->parse_file($core_config);
30 my $confxpc = XML::LibXML::XPathContext->new($confxml);
31 my $osrfxml = $xmlparser->parse_file($settings_config);
32
33 sub check_all_database_connections {
34     print "\nChecking database connections\n";
35     # Check database connections
36     my @databases = $osrfxml->findnodes('//database');
37
38     # If we have no database connections, this is probably the OpenSRF version
39     # of opensrf.xml
40     if (!@databases) {
41         my $de = "* WARNING: There are no database connections defined in " .
42             "opensrf.xml. These are defined in services such as " .
43             "open-ils.cstore and open-ils.reporter. Please ensure that " .
44             "your opensrf_core.xml and opensrf.xml configuration files " .
45             "are based on the examples shipped with Evergreen instead of " .
46             "OpenSRF.\n";
47         $output .= $de;
48         warn $de;
49     }
50
51     foreach my $database (@databases) {
52         unless ($database->parentNode->parentNode->localname eq 'open-ils.storage') {
53             next;
54         }
55
56         my $db_name = $database->findvalue("./db");    
57         if (!$db_name) {
58             $db_name = $database->findvalue("./name");    
59         }
60         my $db_host = $database->findvalue("./host");    
61         my $db_port = $database->findvalue("./port");    
62         my $db_user = $database->findvalue("./user");    
63         my $db_pw = $database->findvalue("./pw");    
64
65         my $osrf_xpath;
66         foreach my $node ($database->findnodes("ancestor::node()")) {
67             next unless $node->nodeType == XML::LibXML::XML_ELEMENT_NODE;
68             $osrf_xpath .= "/" . $node->nodeName;
69         }
70         $output .= test_db_connect($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath);
71     }
72 }
73
74 sub test_db_connect {
75     my ($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath) = @_;
76
77     my $dsn = "dbi:Pg:dbname=$db_name;host=$db_host;port=$db_port";
78     my $de = undef;
79     my ($dbh, $encoding, $langs);
80     $dbh = DBI->connect($dsn, $db_user, $db_pw);
81
82     # Short-circuit if we didn't connect successfully
83     unless($dbh) {
84         $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
85         warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
86         return $de;
87     }
88
89     $dbh->disconnect;
90     print "* $osrf_xpath :: Successfully connected to database $dsn\n" unless ($de);
91 }