[RT17143] First go at date1 cleanup settings
[sitka/sitka-tools.git] / data_cleanup / date1 / date1_cleanup.pl
CommitLineData
69ed3052
LW
1#!/usr/bin/perl
2# vim:et:ts=4:
3use strict;
4use warnings;
5
6use DBI;
7use OpenSRF::Utils::Config;
8use Getopt::Long;
9use Net::Domain;
10use XML::LibXML
11use XML::LibXML::XPathContext
12
13my ($gather, $hostname, $core_config, $tmpdir) =
14 (0, Net::Domain::hostfqdn(), '/srv/openils/conf/opensrf_core.xml', '/tmp/');
15
16GetOptions(
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#;
24OpenSRF::Utils::Config->load(config_file => $core_config);
25my $conf = OpenSRF::Utils::Config->current;
26my $settings_config = $conf->bootstrap->settings_config;
27
28my $xmlparser = XML::LibXML->new();
29my $confxml = $xmlparser->parse_file($core_config);
30my $confxpc = XML::LibXML::XPathContext->new($confxml);
31my $osrfxml = $xmlparser->parse_file($settings_config);
32
33sub 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
74sub 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}