Return to sqltest.pl CVS log

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

Annotation of loncom/build/system_dependencies/sqltest.pl, revision 1.1

1.1     ! harris41    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();