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 my @list = split / /, $mod;
38 print "$m version ".${$m."::VERSION"}."\n" unless ($@);
43 warn "Please install $mod\n";
44 $perloutput .= "Please install the $mod Perl module.\n";
46 warn "Please install one of the following modules: $mod\n";
47 $perloutput .= "Please install one of the following modules: $mod\n";
53 use OpenSRF::Transport::SlimJabber::Client;
54 use OpenSRF::Utils::SettingsParser;
55 use OpenSRF::Utils::SettingsClient;
59 (my $conf_dir = $core_config) =~ s#(.*)/.*#$1#;
62 OpenSRF::Utils::Config->load(config_file => $core_config);
63 my $conf = OpenSRF::Utils::Config->current;
64 my $j_username = $conf->bootstrap->username;
65 my $j_password = $conf->bootstrap->passwd;
66 my $j_port = $conf->bootstrap->port;
67 my $j_domain = $conf->bootstrap->domains->[0];
68 my $settings_config = $conf->bootstrap->settings_config;
69 my $logfile = $conf->bootstrap->logfile;
70 (my $log_dir = $logfile) =~ s#(.*)/.*#$1#;
73 print "\nChecking Jabber connection\n";
75 my $client = OpenSRF::Transport::SlimJabber::Client->new(
77 username => $j_username,
78 password => $j_password,
86 unless($client->initialize()) {
87 $je = "* Unable to connect to jabber server $j_domain\n";
88 warn "* Unable to connect to jabber server $j_domain\n";
91 $je = "* Error connecting to jabber:\n" . shift() . "\n";
92 warn "* Error connecting to jabber:\n" . shift() . "\n";
95 print "* Jabber successfully connected\n" unless ($je);
96 $output .= ($je) ? $je : "* Jabber successfully connected\n";
98 my $xmlparser = XML::LibXML->new();
99 my $osrfxml = $xmlparser->parse_file($settings_config);
101 print "\nChecking database connections\n";
102 # Check database connections
103 my @databases = $osrfxml->findnodes('//database');
104 foreach my $database (@databases) {
105 my $db_name = $database->findvalue("./db");
107 $db_name = $database->findvalue("./name");
109 my $db_host = $database->findvalue("./host");
110 my $db_port = $database->findvalue("./port");
111 my $db_user = $database->findvalue("./user");
112 my $db_pw = $database->findvalue("./pw");
113 if (!$db_pw && $database->findvalue('../../local-name()') eq 'reporter') {
114 $db_pw = $database->findvalue("./password");
115 warn "* Deprecated <password> elemnt used for the <reporter>. ".
116 "Please use <pw> instead.\n" if ($db_pw);
120 foreach my $node ($database->findnodes("ancestor::node()")) {
121 next unless $node->nodeType == XML::LibXML::XML_ELEMENT_NODE;
122 $osrf_xpath .= "/" . $node->nodeName;
124 $output .= test_db_connect($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath);
127 print "\nChecking database drivers to ensure <driver> matches <language>\n";
128 # Check database drivers
129 # if language eq 'C', driver eq 'pgsql'
130 # if language eq 'perl', driver eq 'Pg'
131 my @drivers = $osrfxml->findnodes('//driver');
132 foreach my $driver_node (@drivers) {
135 my @driver_xpath_nodes;
136 foreach my $node ($driver_node->findnodes("ancestor::node()")) {
137 next unless $node->nodeType == XML::LibXML::XML_ELEMENT_NODE;
138 $driver_xpath .= "/" . $node->nodeName;
139 push @driver_xpath_nodes, $node->nodeName;
142 my $driver = $driver_node->findvalue("child::text()");
143 while (pop(@driver_xpath_nodes) && scalar(@driver_xpath_nodes) > 0 && !$language) {
144 $lang_xpath = "/" . join('/', @driver_xpath_nodes) . "/language";
145 my @lang_nodes = $osrfxml->findnodes($lang_xpath);
146 next unless scalar(@lang_nodes > 0);
147 $language = $lang_nodes[0]->findvalue("child::text()");
150 if ($driver eq "pgsql") {
151 if ($language eq "C") {
152 $result = "* OK: $driver language is $language in $lang_xpath\n";
154 $result = "* ERROR: $driver language is $language in $lang_xpath\n";
157 } elsif ($driver eq "Pg") {
158 if ($language eq "perl") {
159 $result = "* OK: $driver language is $language in $lang_xpath\n";
160 } elsif ($driver_xpath =~ /reporter/) {
161 $result = "* OK: $driver language is undefined for reporter base configuration\n";
163 $result = "* ERROR: $driver language is $language in $lang_xpath\n";
167 $result = "* ERROR: Unknown driver $driver in $driver_xpath\n";
174 print "\nChecking libdbi and libdbi-drivers\n";
175 $output .= check_libdbd();
177 print "\nChecking hostname\n";
178 my @hosts = $osrfxml->findnodes('/opensrf/hosts/*');
179 foreach my $host (@hosts) {
180 next unless $host->nodeType == XML::LibXML::XML_ELEMENT_NODE;
181 my $osrfhost = $host->nodeName;
183 if ($osrfhost ne $hostname && $osrfhost ne "localhost") {
184 $result = " * ERROR: expected hostname '$hostname', found '$osrfhost' in <hosts> section of opensrf.xml\n";
187 } elsif ($osrfhost eq "localhost") {
188 $result = " * OK: found hostname 'localhost' in <hosts> section of opensrf.xml\n";
190 $result = " * OK: found hostname '$hostname' in <hosts> section of opensrf.xml\n";
192 print $result unless $he;
198 get_debug_info( $tmpdir, $log_dir, $conf_dir, $perloutput, $output );
201 sub test_db_connect {
202 my ($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath) = @_;
204 my $dsn = "dbi:Pg:dbname=$db_name;host=$db_host;port=$db_port";
208 $dbh = DBI->connect($dsn, $db_user, $db_pw);
210 $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
211 warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
213 my $sth = $dbh->prepare("show server_encoding");
215 $sth->bind_col(1, \$encoding);
220 $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
221 warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
223 print "* $osrf_xpath :: Successfully connected to database $dsn\n" unless ($de);
224 if ($encoding !~ m/(utf-?8|unicode)/i) {
225 $de .= "* ERROR: $osrf_xpath :: Database $dsn has encoding $encoding instead of UTF8 or UNICODE.\n";
226 warn "* ERROR: $osrf_xpath :: Database $dsn has encoding $encoding instead of UTF8 or UNICODE.\n";
228 print " * Database has the expected server encoding $encoding.\n";
230 return ($de) ? $de : "* $osrf_xpath :: Successfully connected to database $dsn with encoding $encoding\n";
237 my @location = `locate libdbdpgsql.so |grep -v home`; # simple(ton) attempt to filter out build versions
238 if (scalar(@location) > 1) {
240 my $res = "Found more than one location for libdbdpgsql.so.
241 We have found that system packages don't link against libdbi.so;
242 therefore, we strongly recommend compiling libdbi and libdbi-drivers from source.\n";
246 foreach my $loc (@location) {
247 my @linkage = `ldd $loc`;
248 if (!grep(/libdbi/, @linkage)) {
249 my $res = "$loc was not linked against libdbi - you probably need to compile libdbi-drivers from source with the --enable-libdbi configure switch.\n";
258 my $temp_dir = shift; # place we can write files
259 my $log = shift; # location of the log directory
260 my $config = shift; # location of the config files
261 my $perl_test = shift; # output from the Perl prereq testing
262 my $config_test = shift; # output from the config file testing
264 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
265 my $oils_time = sprintf("%04d-%02d-%02d_%02dh-%02d-%02d", $year+1900, $mon, $mday, $hour, $min, $sec);
267 # evil approach that requires no other Perl dependencies
269 my $oils_debug_dir = "$temp_dir/oils_$oils_time";
271 # Replace with something Perlish
272 mkdir($oils_debug_dir) or die $!;
274 # Replace with File::Copy
275 system("cp $log/*log $oils_debug_dir");
277 # Passwords will go through in the clear for now
278 system("cp $config/*xml $oils_debug_dir");
281 open(FH, ">", "$oils_debug_dir/perl_test.out") or die $!;
286 open(FH, ">", "$oils_debug_dir/xml_test.out") or die $!;
287 print FH $config_test;
290 # Tar this up - does any system not have tar?
291 system("tar czf oils_$oils_time.tar.gz oils_$oils_time");
293 # Clean up after ourselves, somewhat dangerously
294 system("rm -fr $oils_debug_dir");
296 print "Wrote your debug information to $temp_dir/oils_$oils_time.tar.gz.\n";
306 Class::DBI::AbstractSearch
309 Net::Z3950 Net::Z3950::ZOOM
317 DateTime::Format::ISO8601
320 JavaScript::SpiderMonkey
325 Spreadsheet::WriteExcel::Big