Annotation of loncom/build/system_dependencies/sqltest.pl, revision 1.2
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;
1.2 ! harris41 41: print 'Probing for SQL metadata database'."\n\n";
1.1 harris41 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
1.2 ! harris41 73:
! 74: print "SQL metadata database is found and is accessible\n";
1.1 harris41 75:
76: # --------------------------------------------------- Close database connection
77: $dbh->disconnect();
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>