4 eval "use Error qw/:try/;";
5 die "Please install Error.pm!\n" if ($@);
6 eval "use UNIVERSAL::require;";
7 die "Please install the UNIVERSAL::Require perl module!\n" if ($@);
8 eval "use Getopt::Long;";
9 die "Please install the Getopt::Long perl module!\n" if ($@);
10 eval "use Net::Domain;";
11 die "Please install the Net::Domain perl module!\n" if ($@);
17 my ($gather, $hostname, $core_config, $tmpdir) =
18 (0, Net::Domain::hostfqdn(), '/openils/conf/opensrf_core.xml', '/tmp/');
22 'hostname=s' => \$hostname,
23 'config_file=s' => \$core_config,
24 'tempdir=s' => \$tmpdir,
27 while (my $mod = <DATA>) {
29 warn "Please install $mod\n" unless ($mod->use);
30 $perloutput .= "Please install $mod\n";
31 print "$mod version ".${$mod."::VERSION"}."\n" unless ($@);
34 use OpenSRF::Transport::SlimJabber::Client;
35 use OpenSRF::Utils::SettingsParser;
36 use OpenSRF::Utils::SettingsClient;
37 use OpenSRF::Utils::Config;
41 (my $conf_dir = $core_config) =~ s#(.*)/.*#$1#;
44 OpenSRF::Utils::Config->load(config_file => $core_config);
45 my $conf = OpenSRF::Utils::Config->current;
46 my $j_username = $conf->bootstrap->username;
47 my $j_password = $conf->bootstrap->passwd;
48 my $j_port = $conf->bootstrap->port;
49 my $j_domain = $conf->bootstrap->domains->[0];
50 my $settings_config = $conf->bootstrap->settings_config;
51 my $logfile = $conf->bootstrap->logfile;
52 (my $log_dir = $logfile) =~ s#(.*)/.*#$1#;
56 my $client = OpenSRF::Transport::SlimJabber::Client->new(
58 username => $j_username,
59 password => $j_password,
67 unless($client->initialize()) {
68 $je = "* Unable to connect to jabber server $j_domain\n";
69 warn "* Unable to connect to jabber server $j_domain\n";
72 $je = "* Error connecting to jabber:\n" . shift() . "\n";
73 warn "* Error connecting to jabber:\n" . shift() . "\n";
76 print "* Jabber successfully connected\n" unless ($je);
77 $output .= ($je) ? $je : "* Jabber successfully connected\n";
79 # parse the opensrf.xml file
80 my $sparser = 'OpenSRF::Utils::SettingsParser';
81 my $res = $sparser->initialize($settings_config);
82 my $sconfig = $sparser->get_server_config($hostname);
83 my $db_config = $sconfig->{apps}->{'open-ils.storage'}->{app_settings}->{databases}->{database};
86 # grab the open-ils.storage database settings
87 my $db_host = $db_config->{host};
88 my $db_user = $db_config->{user};
89 my $db_port = $db_config->{port};
90 my $db_pw = $db_config->{pw};
91 my $db_db = $db_config->{db};
94 # connect to the database
95 my $dsn = "dbi:Pg:dbname=$db_db;host=$db_host;port=$db_port";
98 unless( DBI->connect($dsn, $db_user, $db_pw) ) {
99 $de = "* Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
100 warn "* Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
103 $de = "* Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
104 warn "* Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
106 print "* Successfully connected to database $dsn\n" unless ($de);
107 $output .= ($de) ? $de : "* Successfully connected to database $dsn\n";
111 get_debug_info( $tmpdir, $log_dir, $conf_dir, $perloutput, $output );
115 my $temp_dir = shift; # place we can write files
116 my $log = shift; # location of the log directory
117 my $config = shift; # location of the config files
118 my $perl_test = shift; # output from the Perl prereq testing
119 my $config_test = shift; # output from the config file testing
121 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
122 my $oils_time = sprintf("%04d-%02d-%02d_%02dh-%02d-%02d", $year+1900, $mon, $mday, $hour, $min, $sec);
124 # evil approach that requires no other Perl dependencies
126 my $oils_debug_dir = "$temp_dir/oils_$oils_time";
128 # Replace with something Perlish
129 mkdir($oils_debug_dir) or die $!;
131 # Replace with File::Copy
132 system("cp $log/*log $oils_debug_dir");
134 # Passwords will go through in the clear for now
135 system("cp $config/*xml $oils_debug_dir");
138 open(FH, ">", "$oils_debug_dir/perl_test.out") or die $!;
143 open(FH, ">", "$oils_debug_dir/xml_test.out") or die $!;
144 print FH $config_test;
147 # Tar this up - does any system not have tar?
148 system("tar czf oils_$oils_time.tar.gz oils_$oils_time");
150 # Clean up after ourselves, somewhat dangerously
151 system("rm -fr $oils_debug_dir");
153 print "Wrote your debug information to oils_$oils_time.tar.gz.\n";
163 Class::DBI::AbstractSearch
174 DateTime::Format::ISO8601
177 JavaScript::SpiderMonkey