From: Dan Scott Date: Fri, 14 Oct 2011 02:15:53 +0000 (-0400) Subject: Settings-tester.pl whitespace X-Git-Url: https://old-git.evergreen-ils.org/?a=commitdiff_plain;h=ada4a5ab37dbb7a5568b00e0096afbb26216e9f2;p=evergreen%2Fmasslnc.git Settings-tester.pl whitespace Might as well complete the conversion of the file into modernity. Signed-off-by: Dan Scott --- diff --git a/Open-ILS/src/support-scripts/settings-tester.pl b/Open-ILS/src/support-scripts/settings-tester.pl index 094010d4c1..31be6ae138 100755 --- a/Open-ILS/src/support-scripts/settings-tester.pl +++ b/Open-ILS/src/support-scripts/settings-tester.pl @@ -15,38 +15,38 @@ my $perloutput = ''; my $result; my ($gather, $hostname, $core_config, $tmpdir) = - (0, Net::Domain::hostfqdn(), '/openils/conf/opensrf_core.xml', '/tmp/'); + (0, Net::Domain::hostfqdn(), '/openils/conf/opensrf_core.xml', '/tmp/'); GetOptions( - 'gather' => \$gather, - 'hostname=s' => \$hostname, - 'config_file=s' => \$core_config, - 'tempdir=s' => \$tmpdir, + 'gather' => \$gather, + 'hostname=s' => \$hostname, + 'config_file=s' => \$core_config, + 'tempdir=s' => \$tmpdir, ); while (my $mod = ) { - chomp $mod; - my @list = split / /, $mod; - - my $ok = 0; - for my $m (@list) { - if ($m->use) { - $ok++; - my $version = $m->VERSION; - print "$m version $version\n" if ($version); - } - } - - unless ($ok) { - if (@list == 1) { - warn "Please install $mod\n"; - $perloutput .= "Please install the $mod Perl module.\n"; - } else { - warn "Please install one of the following modules: $mod\n"; - $perloutput .= "Please install one of the following modules: $mod\n"; - } - } - + chomp $mod; + my @list = split / /, $mod; + + my $ok = 0; + for my $m (@list) { + if ($m->use) { + $ok++; + my $version = $m->VERSION; + print "$m version $version\n" if ($version); + } + } + + unless ($ok) { + if (@list == 1) { + warn "Please install $mod\n"; + $perloutput .= "Please install the $mod Perl module.\n"; + } else { + warn "Please install one of the following modules: $mod\n"; + $perloutput .= "Please install one of the following modules: $mod\n"; + } + } + } use OpenSRF::Transport::SlimJabber::Client; @@ -81,7 +81,7 @@ $output .= check_libdbd(); check_hostname(); if ($gather) { - get_debug_info( $tmpdir, $log_dir, $conf_dir, $perloutput, $output ); + get_debug_info( $tmpdir, $log_dir, $conf_dir, $perloutput, $output ); } sub check_all_database_connections { @@ -135,51 +135,51 @@ sub check_all_database_connections { sub test_db_connect { - my ($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath) = @_; - - my $dsn = "dbi:Pg:dbname=$db_name;host=$db_host;port=$db_port"; - my $de = undef; - my ($dbh, $encoding, $langs); - $dbh = DBI->connect($dsn, $db_user, $db_pw); - - # Short-circuit if we didn't connect successfully - unless($dbh) { - $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n"; - warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n"; - return $de; - } - - # Get server encoding - my $sth = $dbh->prepare("SHOW server_encoding"); - $sth->execute; - $sth->bind_col(1, \$encoding); - $sth->fetch; - $sth->finish; - - # Get list of server languages - $sth = $dbh->prepare("SELECT lanname FROM pg_catalog.pg_language"); - $sth->execute; - $langs = $sth->fetchall_arrayref([0]); - $sth->finish; - - $dbh->disconnect; - print "* $osrf_xpath :: Successfully connected to database $dsn\n" unless ($de); - - # Check encoding - if ($encoding !~ m/(utf-?8|unicode)/i) { - $de .= "* ERROR: $osrf_xpath :: Database $dsn has encoding $encoding instead of UTF8 or UNICODE.\n"; - warn "* ERROR: $osrf_xpath :: Database $dsn has encoding $encoding instead of UTF8 or UNICODE.\n"; - } else { - print " * Database has the expected server encoding $encoding.\n"; - } - - my $result = check_db_langs($langs); - if ($result) { - $de .= $result; - warn $result; - } - - return ($de) ? $de : "* $osrf_xpath :: Successfully connected to database $dsn with encoding $encoding\n"; + my ($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath) = @_; + + my $dsn = "dbi:Pg:dbname=$db_name;host=$db_host;port=$db_port"; + my $de = undef; + my ($dbh, $encoding, $langs); + $dbh = DBI->connect($dsn, $db_user, $db_pw); + + # Short-circuit if we didn't connect successfully + unless($dbh) { + $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n"; + warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n"; + return $de; + } + + # Get server encoding + my $sth = $dbh->prepare("SHOW server_encoding"); + $sth->execute; + $sth->bind_col(1, \$encoding); + $sth->fetch; + $sth->finish; + + # Get list of server languages + $sth = $dbh->prepare("SELECT lanname FROM pg_catalog.pg_language"); + $sth->execute; + $langs = $sth->fetchall_arrayref([0]); + $sth->finish; + + $dbh->disconnect; + print "* $osrf_xpath :: Successfully connected to database $dsn\n" unless ($de); + + # Check encoding + if ($encoding !~ m/(utf-?8|unicode)/i) { + $de .= "* ERROR: $osrf_xpath :: Database $dsn has encoding $encoding instead of UTF8 or UNICODE.\n"; + warn "* ERROR: $osrf_xpath :: Database $dsn has encoding $encoding instead of UTF8 or UNICODE.\n"; + } else { + print " * Database has the expected server encoding $encoding.\n"; + } + + my $result = check_db_langs($langs); + if ($result) { + $de .= $result; + warn $result; + } + + return ($de) ? $de : "* $osrf_xpath :: Successfully connected to database $dsn with encoding $encoding\n"; } @@ -309,120 +309,120 @@ sub check_all_jabber { } sub check_jabber { - my ($j_username, $j_password, $j_domain, $j_port) = @_; - print "\nChecking Jabber connection for user $j_username, domain $j_domain\n"; - - # connect to jabber - my $client = OpenSRF::Transport::SlimJabber::Client->new( - port => $j_port, - username => $j_username, - password => $j_password, - host => $j_domain, - resource => 'test123' - ); - - - my $je = undef; - try { - unless($client->initialize()) { - $je = "* Unable to connect to jabber server $j_domain\n"; - warn "* Unable to connect to jabber server $j_domain\n"; - } - } catch Error with { - $je = "* Error connecting to jabber:\n" . shift() . "\n"; - warn "* Error connecting to jabber:\n" . shift() . "\n"; - }; - - print "* Jabber successfully connected\n" unless ($je); - $output .= ($je) ? $je : "* Jabber successfully connected\n"; + my ($j_username, $j_password, $j_domain, $j_port) = @_; + print "\nChecking Jabber connection for user $j_username, domain $j_domain\n"; + + # connect to jabber + my $client = OpenSRF::Transport::SlimJabber::Client->new( + port => $j_port, + username => $j_username, + password => $j_password, + host => $j_domain, + resource => 'test123' + ); + + + my $je = undef; + try { + unless($client->initialize()) { + $je = "* Unable to connect to jabber server $j_domain\n"; + warn "* Unable to connect to jabber server $j_domain\n"; + } + } catch Error with { + $je = "* Error connecting to jabber:\n" . shift() . "\n"; + warn "* Error connecting to jabber:\n" . shift() . "\n"; + }; + + print "* Jabber successfully connected\n" unless ($je); + $output .= ($je) ? $je : "* Jabber successfully connected\n"; } sub check_hostname { - print "\nChecking hostname\n"; - my @hosts = $osrfxml->findnodes('/opensrf/hosts/*'); - foreach my $host (@hosts) { - next unless $host->nodeType == XML::LibXML::XML_ELEMENT_NODE; - my $osrfhost = $host->nodeName; - my $he; - if ($osrfhost ne $hostname && $osrfhost ne "localhost") { - $result = " * ERROR: expected hostname '$hostname', found '$osrfhost' in section of opensrf.xml\n"; - warn $result; - $he = 1; - } elsif ($osrfhost eq "localhost") { - $result = " * OK: found hostname 'localhost' in section of opensrf.xml\n"; - } else { - $result = " * OK: found hostname '$hostname' in section of opensrf.xml\n"; - } - print $result unless $he; - $output .= $result; - } + print "\nChecking hostname\n"; + my @hosts = $osrfxml->findnodes('/opensrf/hosts/*'); + foreach my $host (@hosts) { + next unless $host->nodeType == XML::LibXML::XML_ELEMENT_NODE; + my $osrfhost = $host->nodeName; + my $he; + if ($osrfhost ne $hostname && $osrfhost ne "localhost") { + $result = " * ERROR: expected hostname '$hostname', found '$osrfhost' in section of opensrf.xml\n"; + warn $result; + $he = 1; + } elsif ($osrfhost eq "localhost") { + $result = " * OK: found hostname 'localhost' in section of opensrf.xml\n"; + } else { + $result = " * OK: found hostname '$hostname' in section of opensrf.xml\n"; + } + print $result unless $he; + $output .= $result; + } } sub check_libdbd { - my $results = ''; - my @location = `/sbin/ldconfig --print | grep libdbdpgsql`; # simple(ton) attempt to filter out build versions + my $results = ''; + my @location = `/sbin/ldconfig --print | grep libdbdpgsql`; # simple(ton) attempt to filter out build versions unless(@location) { - # This is pretty distro-specific, but let's worry about other distros and operating systems when we get there + # This is pretty distro-specific, but let's worry about other distros and operating systems when we get there my $res = "libdbi PostgreSQL driver not found in shared library path; you may need to edit /etc/ld.so.conf or add an entry to /etc/ld.so.conf.d/ and run 'ldconfig' as root\n"; print $res; return $res; } - if ($location[0] !~ m#/usr/local/lib/dbd/#) { - my $res = "libdbdpgsql.so was not found in /usr/local/libdbi/dbd/ + if ($location[0] !~ m#/usr/local/lib/dbd/#) { + my $res = "libdbdpgsql.so was not found in /usr/local/libdbi/dbd/ We have found that system packages don't link against libdbi.so; therefore, we strongly recommend compiling libdbi and libdbi-drivers from source.\n"; - $results .= $res; - print $res; - } - if ($results eq '') { - $results = " * OK - found locally installed libdbi.so and libdbdpgsql.so in shared library path\n"; - print $results; - } - return $results; + $results .= $res; + print $res; + } + if ($results eq '') { + $results = " * OK - found locally installed libdbi.so and libdbdpgsql.so in shared library path\n"; + print $results; + } + return $results; } sub get_debug_info { - my $temp_dir = shift; # place we can write files - my $log = shift; # location of the log directory - my $config = shift; # location of the config files - my $perl_test = shift; # output from the Perl prereq testing - my $config_test = shift; # output from the config file testing - - my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); - my $oils_time = sprintf("%04d-%02d-%02d_%02dh-%02d-%02d", $year+1900, $mon, $mday, $hour, $min, $sec); - - # evil approach that requires no other Perl dependencies - chdir($temp_dir); - my $oils_debug_dir = "$temp_dir/oils_$oils_time"; - - # Replace with something Perlish - mkdir($oils_debug_dir) or die $!; - - # Replace with File::Copy - system("cp $log/*log $oils_debug_dir"); - - # Passwords will go through in the clear for now - system("cp $config/*xml $oils_debug_dir"); - - # Get Perl output - open(FH, ">", "$oils_debug_dir/perl_test.out") or die $!; - print FH $perl_test; - close(FH); - - # Get XML output - open(FH, ">", "$oils_debug_dir/xml_test.out") or die $!; - print FH $config_test; - close(FH); - - # Tar this up - does any system not have tar? - system("tar czf oils_$oils_time.tar.gz oils_$oils_time"); - - # Clean up after ourselves, somewhat dangerously - system("rm -fr $oils_debug_dir"); - - print "Wrote your debug information to $temp_dir/oils_$oils_time.tar.gz.\n"; + my $temp_dir = shift; # place we can write files + my $log = shift; # location of the log directory + my $config = shift; # location of the config files + my $perl_test = shift; # output from the Perl prereq testing + my $config_test = shift; # output from the config file testing + + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); + my $oils_time = sprintf("%04d-%02d-%02d_%02dh-%02d-%02d", $year+1900, $mon, $mday, $hour, $min, $sec); + + # evil approach that requires no other Perl dependencies + chdir($temp_dir); + my $oils_debug_dir = "$temp_dir/oils_$oils_time"; + + # Replace with something Perlish + mkdir($oils_debug_dir) or die $!; + + # Replace with File::Copy + system("cp $log/*log $oils_debug_dir"); + + # Passwords will go through in the clear for now + system("cp $config/*xml $oils_debug_dir"); + + # Get Perl output + open(FH, ">", "$oils_debug_dir/perl_test.out") or die $!; + print FH $perl_test; + close(FH); + + # Get XML output + open(FH, ">", "$oils_debug_dir/xml_test.out") or die $!; + print FH $config_test; + close(FH); + + # Tar this up - does any system not have tar? + system("tar czf oils_$oils_time.tar.gz oils_$oils_time"); + + # Clean up after ourselves, somewhat dangerously + system("rm -fr $oils_debug_dir"); + + print "Wrote your debug information to $temp_dir/oils_$oils_time.tar.gz.\n"; } __DATA__