Return to sqltest.pl CVS log

Up to [LON-CAPA] / loncom / build / system_dependencies

system dependency testing

    1: #!/usr/bin/perl
    2: #
    3: # The LearningOnline Network with CAPA
    4: #
    5: # Tests the MySQL layer of the metadata database.
    6: #
    7: # YEAR=2001
    8: # 9/25,9/30 Scott Harrison
    9: #
   10: 
   11: ###############################################################################
   12: ##                                                                           ##
   13: ## ORGANIZATION OF THIS PERL CGI SCRIPT                                      ##
   14: ##                                                                           ##
   15: ## 1. Status of this code                                                    ##
   16: ## 2. Purpose and description of program                                     ##
   17: ## 3. Modules used by this script                                            ##
   18: ## 4. Print MIME Content-type and other initialization                       ##
   19: ## 5. Make sure database can be accessed and that this is a library server   ##
   20: ##                                                                           ##
   21: ###############################################################################
   22: 
   23: # --------------------------------------------------------- Status of this code
   24: #
   25: # 1=horrible 2=poor 3=fair 4=good 5=excellent
   26: # Organization 5
   27: # Functionality 4
   28: # Has it been tested? 3
   29: #
   30: 
   31: # ------------------------------------------ Purpose and description of program
   32: #
   33: # This program tests the connection to the MySQL database.
   34: 
   35: # ------------------------------------------------- Modules used by this script
   36: use strict;
   37: use DBI;
   38: 
   39: # ---------------------------- Print MIME Content-type and other initialization
   40: $|=1;
   41: print 'Content-type: text/plain'."\n\n";
   42: 
   43: # --- Make sure that database can be accessed and that this is a library server
   44: # library server test
   45: my %perlvar;
   46: open (CONFIG,"/etc/httpd/conf/access.conf") || 
   47:     (print "Can't read access.conf\n" && exit);
   48: while (my $configline=<CONFIG>) {
   49:     if ($configline =~ /PerlSetVar/) {
   50: 	my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
   51:         chomp($varvalue);
   52:         $perlvar{$varname}=$varvalue;
   53:     }
   54: }
   55: close(CONFIG);
   56: unless ($perlvar{'lonRole'} eq 'library') {
   57:     print "SQL testing can only be run on a library server. Skipping test..\n";
   58:     exit 0;
   59: }
   60: # database test
   61: my $dbh;
   62: {
   63:     unless (
   64: 	    $dbh = DBI->connect("DBI:mysql:loncapa","www",
   65: 				$perlvar{'lonSqlAccess'},
   66: 				{ RaiseError =>0,PrintError=>0})
   67: 	    ) { 
   68: 	print "Cannot connect to database!\n";
   69: 	exit 1;
   70:     }
   71: }
   72: %perlvar=(); # undefine it
   73: 
   74: # --------------------------------------------------- Close database connection
   75: $dbh->disconnect();