5 eval "use OpenSRF::Utils::Config;";
6 die "Please ensure that /openils/lib/perl5 is in your PERL5LIB environment variable.
7 You must run this script as the 'opensrf' user.\n" if ($@);
8 eval "use Error qw/:try/;";
9 die "Please install Error.pm.\n" if ($@);
10 eval "use UNIVERSAL::require;";
11 die "Please install the UNIVERSAL::Require perl module.\n" if ($@);
12 eval "use Getopt::Long;";
13 die "Please install the Getopt::Long perl module.\n" if ($@);
14 eval "use Net::Domain;";
15 die "Please install the Net::Domain perl module.\n" if ($@);
21 my ($gather, $hostname, $core_config, $tmpdir) =
22 (0, Net::Domain::hostfqdn(), '/openils/conf/opensrf_core.xml', '/tmp/');
26 'hostname=s' => \$hostname,
27 'config_file=s' => \$core_config,
28 'tempdir=s' => \$tmpdir,
31 while (my $mod = <DATA>) {
33 warn "Please install $mod\n" unless ($mod->use);
34 $perloutput .= "Please install the $mod Perl module.\n";
35 print "$mod version ".${$mod."::VERSION"}."\n" unless ($@);
38 use OpenSRF::Transport::SlimJabber::Client;
39 use OpenSRF::Utils::SettingsParser;
40 use OpenSRF::Utils::SettingsClient;
44 (my $conf_dir = $core_config) =~ s#(.*)/.*#$1#;
47 OpenSRF::Utils::Config->load(config_file => $core_config);
48 my $conf = OpenSRF::Utils::Config->current;
49 my $j_username = $conf->bootstrap->username;
50 my $j_password = $conf->bootstrap->passwd;
51 my $j_port = $conf->bootstrap->port;
52 my $j_domain = $conf->bootstrap->domains->[0];
53 my $settings_config = $conf->bootstrap->settings_config;
54 my $logfile = $conf->bootstrap->logfile;
55 (my $log_dir = $logfile) =~ s#(.*)/.*#$1#;
58 print "\nChecking Jabber connection\n";
60 my $client = OpenSRF::Transport::SlimJabber::Client->new(
62 username => $j_username,
63 password => $j_password,
71 unless($client->initialize()) {
72 $je = "* Unable to connect to jabber server $j_domain\n";
73 warn "* Unable to connect to jabber server $j_domain\n";
76 $je = "* Error connecting to jabber:\n" . shift() . "\n";
77 warn "* Error connecting to jabber:\n" . shift() . "\n";
80 print "* Jabber successfully connected\n" unless ($je);
81 $output .= ($je) ? $je : "* Jabber successfully connected\n";
83 my $xmlparser = XML::LibXML->new();
84 my $osrfxml = $xmlparser->parse_file($settings_config);
85 my $xpc = XML::LibXML::XPathContext->new($osrfxml);
87 print "\nChecking database connections\n";
88 # Check database connections
89 my @databases = $xpc->findnodes('//database');
90 foreach my $database (@databases) {
91 my $db_name = $xpc->findvalue("./db", $database);
92 my $db_host = $xpc->findvalue("./host", $database);
93 my $db_port = $xpc->findvalue("./port", $database);
94 my $db_user = $xpc->findvalue("./user", $database);
95 my $db_pw = $xpc->findvalue("./pw", $database);
97 foreach my $node ($xpc->findnodes("ancestor::node()", $database)) {
98 $osrf_xpath .= "/" . $node->nodeName unless $node->nodeName eq '#document';
100 $output .= test_db_connect($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath);
103 print "\nChecking database drivers to ensure <driver> matches <language>\n";
104 # Check database drivers
105 # if language eq 'C', driver eq 'pgsql'
106 # if language eq 'perl', driver eq 'Pg'
107 my @drivers = $xpc->findnodes('//driver');
108 foreach my $driver_node (@drivers) {
111 my @driver_xpath_nodes;
112 foreach my $node ($xpc->findnodes("ancestor::node()", $driver_node)) {
113 next if $node->nodeName eq "#document";
114 $driver_xpath .= "/" . $node->nodeName;
115 push @driver_xpath_nodes, $node->nodeName;
118 my $driver = $xpc->findvalue("child::text()", $driver_node);
119 while (pop(@driver_xpath_nodes) && scalar(@driver_xpath_nodes) > 0 && !$language) {
120 $lang_xpath = "/" . join('/', @driver_xpath_nodes) . "/language";
121 my @lang_nodes = $xpc->findnodes($lang_xpath);
122 next unless scalar(@lang_nodes > 0);
123 $language = $xpc->findvalue("child::text()", $lang_nodes[0]);
126 if ($driver eq "pgsql") {
127 if ($language eq "C") {
128 $result = "* OK: $driver language is $language in $lang_xpath\n";
130 $result = "* ERROR: $driver language is $language in $lang_xpath\n";
133 } elsif ($driver eq "Pg") {
134 if ($language eq "perl") {
135 $result = "* OK: $driver language is $language in $lang_xpath\n";
136 } elsif ($driver_xpath =~ /reporter/) {
137 $result = "* OK: $driver language is allowed to be undefined for reporter application\n";
139 $result = "* ERROR: $driver language is $language in $lang_xpath\n";
143 $result = "* ERROR: Unknown driver $driver in $driver_xpath\n";
151 $output .= check_libdbd();
154 get_debug_info( $tmpdir, $log_dir, $conf_dir, $perloutput, $output );
157 sub test_db_connect {
158 my ($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath) = @_;
160 my $dsn = "dbi:Pg:dbname=$db_name;host=$db_host;port=$db_port";
163 unless( DBI->connect($dsn, $db_user, $db_pw) ) {
164 $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
165 warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
168 $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
169 warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
171 print "* $osrf_xpath :: Successfully connected to database $dsn\n" unless ($de);
172 return ($de) ? $de : "* $osrf_xpath :: Successfully connected to database $dsn\n";
178 my @location = `locate libdbdpgsql.so`;
179 if (scalar(@location) > 1) {
181 my $res = "Found more than one location for libdbdpgsql.so.
182 We have found that system packages don't link against libdbi.so;
183 therefore, we strongly recommend compiling libdbi and libdbi-drivers from source.\n";
187 foreach my $loc (@location) {
188 my @linkage = `ldd $loc`;
189 if (!grep(/libdbi/, @linkage)) {
190 my $res = "libdbi.so was not linked against $loc - you probably need to compile from source.\n";
199 my $temp_dir = shift; # place we can write files
200 my $log = shift; # location of the log directory
201 my $config = shift; # location of the config files
202 my $perl_test = shift; # output from the Perl prereq testing
203 my $config_test = shift; # output from the config file testing
205 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
206 my $oils_time = sprintf("%04d-%02d-%02d_%02dh-%02d-%02d", $year+1900, $mon, $mday, $hour, $min, $sec);
208 # evil approach that requires no other Perl dependencies
210 my $oils_debug_dir = "$temp_dir/oils_$oils_time";
212 # Replace with something Perlish
213 mkdir($oils_debug_dir) or die $!;
215 # Replace with File::Copy
216 system("cp $log/*log $oils_debug_dir");
218 # Passwords will go through in the clear for now
219 system("cp $config/*xml $oils_debug_dir");
222 open(FH, ">", "$oils_debug_dir/perl_test.out") or die $!;
227 open(FH, ">", "$oils_debug_dir/xml_test.out") or die $!;
228 print FH $config_test;
231 # Tar this up - does any system not have tar?
232 system("tar czf oils_$oils_time.tar.gz oils_$oils_time");
234 # Clean up after ourselves, somewhat dangerously
235 system("rm -fr $oils_debug_dir");
237 print "Wrote your debug information to oils_$oils_time.tar.gz.\n";
247 Class::DBI::AbstractSearch
258 DateTime::Format::ISO8601
261 JavaScript::SpiderMonkey