[BACK]Return to lonsql CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lonsql between versions 1.33 and 1.40

version 1.33, 2001/04/16 18:36:22 version 1.40, 2001/11/29 14:59:52
Line 1 Line 1
 #!/usr/bin/perl  #!/usr/bin/perl
   
   # The LearningOnline Network
   # lonsql - LON TCP-MySQL-Server Daemon for handling database requests.
   #
   # YEAR=2000
 # lonsql-based on the preforker:harsha jagasia:date:5/10/00  # lonsql-based on the preforker:harsha jagasia:date:5/10/00
 # 7/25 Gerd Kortemeyer  # 7/25 Gerd Kortemeyer
 # many different dates Scott Harrison  # many different dates Scott Harrison
   # YEAR=2001
   # many different dates Scott Harrison
 # 03/22/2001 Scott Harrison  # 03/22/2001 Scott Harrison
   # 8/30 Gerd Kortemeyer
   # 10/17,11/28,11/29 Scott Harrison
   #
   # $Id$
   ###
   
   ###############################################################################
   ##                                                                           ##
   ## ORGANIZATION OF THIS PERL SCRIPT                                          ##
   ## 1. Modules used                                                           ##
   ## 2. Enable find subroutine                                                 ##
   ## 3. Read httpd access.conf and get variables                               ##
   ## 4. Make sure that database can be accessed                                ##
   ## 5. Make sure this process is running from user=www                        ##
   ## 6. Check if other instance is running                                     ##
   ## 7. POD (plain old documentation, CPAN style)                              ##
   ##                                                                           ##
   ###############################################################################
   
 use IO::Socket;  use IO::Socket;
 use Symbol;  use Symbol;
 use POSIX;  use POSIX;
Line 19  require "find.pl"; Line 45  require "find.pl";
 sub wanted {  sub wanted {
     (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&      (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
     -f _ &&      -f _ &&
     /^.*\.meta$/ &&      /^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ &&
     push(@metalist,"$dir/$_");      push(@metalist,"$dir/$_");
 }  }
   
Line 45  close(CONFIG); Line 71  close(CONFIG);
     $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})      $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})
     ) {       ) { 
  print "Cannot connect to database!\n";   print "Cannot connect to database!\n";
  exit;   $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
    $subj="LON: $perlvar{'lonHostID'} Cannot connect to database!";
    system("echo 'Cannot connect to MySQL database!' |\
    mailto $emailto -s '$subj' > /dev/null");
    exit 1;
     }      }
     else {      else {
  $dbh->disconnect;   $dbh->disconnect;
Line 79  while ($configline=<CONFIG>) { Line 109  while ($configline=<CONFIG>) {
 }  }
 close(CONFIG);  close(CONFIG);
   
   $PREFORK=int($PREFORK/4);
   
 $unixsock = "mysqlsock";  $unixsock = "mysqlsock";
 my $localfile="$perlvar{'lonSockDir'}/$unixsock";  my $localfile="$perlvar{'lonSockDir'}/$unixsock";
 my $server;  my $server;
Line 269  sub make_new_child { Line 301  sub make_new_child {
  }   }
  else {   else {
     @metalist=(); pop @metalist;      @metalist=(); pop @metalist;
     &find("$perlvar{'lonDocRoot'}/res");      opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}");
       my @homeusers=grep
             {&ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")}
             grep {!/^\.\.?$/} readdir(RESOURCES);
       closedir RESOURCES;
       foreach my $user (@homeusers) {
    &find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");
       }
  }   }
 # &logthis("FILELIST:" . join(":::",@metalist));  # &logthis("FILELIST:" . join(":::",@metalist));
  # if file is indicated in sql database and   # if file is indicated in sql database and
Line 288  sub make_new_child { Line 327  sub make_new_child {
        'creationdate','keywords','language',         'creationdate','keywords','language',
        'lastrevisiondate','mime','notes',         'lastrevisiondate','mime','notes',
        'owner','subject','title') {         'owner','subject','title') {
     $stuff=~s/\n?\<$f[^\>]*\>.*?<\/$f[^\>]*\>\n?//;      $stuff=~s/\n?\<$f[^\>]*\>.*?<\/$f[^\>]*\>\n?//s;
  }   }
  my $m2=$m; my $docroot=$perlvar{'lonDocRoot'};   my $m2=$m; my $docroot=$perlvar{'lonDocRoot'};
  $m2=~s/^$docroot//;   $m2=~s/^$docroot//;
  $m2=~s/\.meta$//;   $m2=~s/\.meta$//;
  unless ($query) {   unless ($query) {
     my $q2="select * from metadata where url like '$m2'";      my $q2="select * from metadata where url like binary '$m2'";
     my $sth = $dbh->prepare($q2);      my $sth = $dbh->prepare($q2);
     $sth->execute();      $sth->execute();
     my $r1=$sth->fetchall_arrayref;      my $r1=$sth->fetchall_arrayref;
Line 383  sub unescape { Line 422  sub unescape {
     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;      $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
     return $str;      return $str;
 }  }
   
   # --------------------------------------- Is this the home server of an author?
   # (copied from lond, modification of the return value)
   sub ishome {
       my $author=shift;
       $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
       my ($udom,$uname)=split(/\//,$author);
       my $proname=propath($udom,$uname);
       if (-e $proname) {
    return 1;
       } else {
           return 0;
       }
   }
   
   # -------------------------------------------- Return path to profile directory
   # (copied from lond)
   sub propath {
       my ($udom,$uname)=@_;
       $udom=~s/\W//g;
       $uname=~s/\W//g;
       my $subdir=$uname.'__';
       $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
       my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
       return $proname;
   } 
   
   # ----------------------------------- POD (plain old documentation, CPAN style)
   
   =head1 NAME
   
   lonsql - LON TCP-MySQL-Server Daemon for handling database requests.
   
   =head1 SYNOPSIS
   
   This script should be run as user=www.  The following is an example invocation
   from the loncron script.  Note that a lonsql.pid file contains the pid of
   the parent process.
   
       if (-e $lonsqlfile) {
    my $lfh=IO::File->new("$lonsqlfile");
    my $lonsqlpid=<$lfh>;
    chomp($lonsqlpid);
    if (kill 0 => $lonsqlpid) {
       print $fh "<h3>lonsql at pid $lonsqlpid responding</h3>";
       $restartflag=0;
    } else {
       $errors++; $errors++;
       print $fh "<h3>lonsql at pid $lonsqlpid not responding</h3>";
    $restartflag=1;
    print $fh 
       "<h3>Decided to clean up stale .pid file and restart lonsql</h3>";
    }
       }
       if ($restartflag==1) {
    $errors++;
            print $fh '<br><font color="red">Killall lonsql: '.
                       system('killall lonsql').' - ';
                       sleep 60;
                       print $fh unlink($lonsqlfile).' - '.
                                 system('killall -9 lonsql').
                       '</font><br>';
    print $fh "<h3>lonsql not running, trying to start</h3>";
    system(
    "$perlvar{'lonDaemons'}/lonsql 2>>$perlvar{'lonDaemons'}/logs/lonsql_errors");
    sleep 10;
   
   =head1 DESCRIPTION
   
   LON TCP-MySQL-Server Daemon for handling database requests.
   
   =head1 README
   
   LON TCP-MySQL-Server Daemon for handling database requests.
   
   =head1 PREREQUISITES
   
   IO::Socket
   Symbol
   POSIX
   IO::Select
   IO::File
   Socket
   Fcntl
   Tie::RefHash
   DBI
   
   =head1 COREQUISITES
   
   =head1 OSNAMES
   
   linux
   
   =head1 SCRIPT CATEGORIES
   
   Server/Process
   
   =cut
Removed from v.1.33  
changed lines
  Added in v.1.40

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>