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

Diff for /loncom/lond between versions 1.6 and 1.7

version 1.6, 1999/12/15 22:01:14 version 1.7, 2000/01/12 19:30:43
Line 4 Line 4
 # 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30,  # 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30,
 # 7/8,7/9,7/10,7/12,7/17,7/19,9/21,  # 7/8,7/9,7/10,7/12,7/17,7/19,9/21,
 # 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16,  # 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16,
 # 12/7,12/15 Gerd Kortemeyer  # 12/7,12/15,01/06,01/11,01/12 Gerd Kortemeyer
 # based on "Perl Cookbook" ISBN 1-56592-243-3  # based on "Perl Cookbook" ISBN 1-56592-243-3
 # preforker - server who forks first  # preforker - server who forks first
 # runs as a daemon  # runs as a daemon
Line 28  open (CONFIG,"/etc/httpd/conf/access.con Line 28  open (CONFIG,"/etc/httpd/conf/access.con
 while ($configline=<CONFIG>) {  while ($configline=<CONFIG>) {
     if ($configline =~ /PerlSetVar/) {      if ($configline =~ /PerlSetVar/) {
  my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);   my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
           chomp($varvalue);
         $perlvar{$varname}=$varvalue;          $perlvar{$varname}=$varvalue;
     }      }
 }  }
Line 678  sub make_new_child { Line 679  sub make_new_child {
                            }                             }
    if (untie(%hash)) {     if (untie(%hash)) {
               $qresult=~s/\&$//;                $qresult=~s/\&$//;
                                 print $client "$qresult\n";
                              } else {
                                 print $client "error:$!\n";
                              }
                          } else {
                              print $client "error:$!\n";
                          }
   # ----------------------------------------------------------------------- store
                      } elsif ($userinput =~ /^store/) {
                         my ($cmd,$udom,$uname,$namespace,$rid,$what)
                             =split(/:/,$userinput);
                         $namespace=~s/\W//g;
                         if ($namespace ne 'roles') {
                          chomp($what);
                          my $proname=propath($udom,$uname);
                          my $now=time;
                          {
      my $hfh;
      if (
                                $hfh=IO::File->new(">>$proname/$namespace.hist")
          ) { print $hfh "P:$now:$rid:$what\n"; }
          }
                          my @pairs=split(/\&/,$what);
                            
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
                              my @previouskeys=split(/&/,$hash{"keys:$rid"});
                              my $key;
                              $hash{"version:$rid"}++;
                              my $version=$hash{"version:$rid"};
                              my $allkeys=''; 
                              foreach $pair (@pairs) {
          ($key,$value)=split(/=/,$pair);
                                  $allkeys.=$key.':';
                                  $hash{"$version:$rid:$key"}=$value;
                              }
                              $allkeys=~s/:$//;
                              $hash{"$version:keys:$rid"}=$allkeys;
      if (untie(%hash)) {
                                 print $client "ok\n";
                              } else {
                                 print $client "error:$!\n";
                              }
                          } else {
                              print $client "error:$!\n";
                          }
         } else {
                             print $client "refused\n";
                         }
   # --------------------------------------------------------------------- restore
                      } elsif ($userinput =~ /^restore/) {
                          my ($cmd,$udom,$uname,$namespace,$rid)
                             =split(/:/,$userinput);
                          $namespace=~s/\W//g;
                          chomp($rid);
                          my $proname=propath($udom,$uname);
                          my $qresult='';
         if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
                     my $version=$hash{"version:$rid"};
                              $qresult.="version=$version&";
                              my $scope;
                              for ($scope=1;$scope<=$version;$scope++) {
         my $vkeys=$hash{"$scope:keys:$rid"};
                                 my @keys=split(/:/,$vkeys);
                                 my $key;
                                 $qresult.="$scope:keys=$vkeys&";
                                 foreach $key (@keys) {
        $qresult.="$version:$key=".$hash{"$scope:$rid:$key"}."&";
                                 }                                  
                              }
      if (untie(%hash)) {
                 $qresult=~s/\&$//;
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
                               print $client "error:$!\n";                                print $client "error:$!\n";
Removed from v.1.6  
changed lines
  Added in v.1.7

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