#!/usr/bin/perl # # The LearningOnline Network with CAPA # # Tests the MySQL layer of the metadata database. # # YEAR=2001 # 9/25,9/30 Scott Harrison # ############################################################################### ## ## ## ORGANIZATION OF THIS PERL CGI SCRIPT ## ## ## ## 1. Status of this code ## ## 2. Purpose and description of program ## ## 3. Modules used by this script ## ## 4. Print MIME Content-type and other initialization ## ## 5. Make sure database can be accessed and that this is a library server ## ## ## ############################################################################### # --------------------------------------------------------- Status of this code # # 1=horrible 2=poor 3=fair 4=good 5=excellent # Organization 5 # Functionality 4 # Has it been tested? 3 # # ------------------------------------------ Purpose and description of program # # This program tests the connection to the MySQL database. # ------------------------------------------------- Modules used by this script use strict; use DBI; # ---------------------------- Print MIME Content-type and other initialization $|=1; print 'Probing for SQL metadata database'."\n\n"; # --- Make sure that database can be accessed and that this is a library server # library server test my %perlvar; open (CONFIG,"/etc/httpd/conf/access.conf") || (print "Can't read access.conf\n" && exit); while (my $configline=) { if ($configline =~ /PerlSetVar/) { my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); chomp($varvalue); $perlvar{$varname}=$varvalue; } } close(CONFIG); unless ($perlvar{'lonRole'} eq 'library') { print "SQL testing can only be run on a library server. Skipping test..\n"; exit 0; } # database test my $dbh; { unless ( $dbh = DBI->connect("DBI:mysql:loncapa","www", $perlvar{'lonSqlAccess'}, { RaiseError =>0,PrintError=>0}) ) { print "Cannot connect to database!\n"; exit 1; } } %perlvar=(); # undefine it print "SQL metadata database is found and is accessible\n"; # --------------------------------------------------- Close database connection $dbh->disconnect();