[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.178 and 1.190

version 1.178, 2001/11/29 18:54:16 version 1.190, 2001/12/12 23:34:14
Line 59 Line 59
 # 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26,  # 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26,
 # 10/2 Gerd Kortemeyer  # 10/2 Gerd Kortemeyer
 # 10/5,10/10,11/13,11/15 Scott Harrison  # 10/5,10/10,11/13,11/15 Scott Harrison
 # 11/17,11/20,11/22 Gerd Kortemeyer  # 11/17,11/20,11/22,11/29 Gerd Kortemeyer
 #  # 12/5 Matthew Hall
 # $Id$  # 12/5 Guy Albertelli
   # 12/6,12/7,12/12 Gerd Kortemeyer
 #  #
 ###  ###
   
Line 169  use Apache::File; Line 170  use Apache::File;
 use LWP::UserAgent();  use LWP::UserAgent();
 use HTTP::Headers;  use HTTP::Headers;
 use vars   use vars 
 qw(%perlvar %hostname %homecache %hostip %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache %packagetab %courselogs);  qw(%perlvar %hostname %homecache %hostip %spareid %hostdom 
      %libserv %pr %prp %fe %fd %metacache %packagetab 
      %courselogs %accesshash $processmarker $dumpcount 
      %coursedombuf %coursehombuf);
 use IO::Socket;  use IO::Socket;
 use GDBM_File;  use GDBM_File;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
Line 752  sub flushcourselogs { Line 756  sub flushcourselogs {
     &logthis('Flushing course log buffers');      &logthis('Flushing course log buffers');
     map {      map {
         my $crsid=$_;          my $crsid=$_;
         if (&reply('log:'.$ENV{'course.'.$crsid.'.domain'}.':'.          if (&reply('log:'.$coursedombuf{$crsid}.':'.
           $ENV{'course.'.$crsid.'.num'}.':'.            &escape($courselogs{$crsid}),
            &escape($courselogs{$crsid}),            $coursehombuf{$crsid}) eq 'ok') {
           $ENV{'course.'.$crsid.'.home'}) eq 'ok') {  
     delete $courselogs{$crsid};      delete $courselogs{$crsid};
         } else {          } else {
             &logthis('Failed to flush log buffer for '.$crsid);              &logthis('Failed to flush log buffer for '.$crsid);
Line 766  sub flushcourselogs { Line 769  sub flushcourselogs {
             }              }
         }                  }        
     } keys %courselogs;      } keys %courselogs;
       &logthis('Flushing access logs');
       map {
           my $entry=$_;
           $entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/;
           my %temphash=($entry => $accesshash{$entry});
           if (&Apache::lonnet::put('resevaldata',\%temphash,$1,$2) eq 'ok') {
       delete $accesshash{$entry};
           }
       } keys %accesshash;
       $dumpcount++;
 }  }
   
 sub courselog {  sub courselog {
     my $what=shift;      my $what=shift;
     $what=time.':'.$what;      $what=time.':'.$what;
     unless ($ENV{'request.course.id'}) { return ''; }      unless ($ENV{'request.course.id'}) { return ''; }
       $coursedombuf{$ENV{'request.course.id'}}=
          $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
          $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
       $coursehombuf{$ENV{'request.course.id'}}=
          $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
     if (defined $courselogs{$ENV{'request.course.id'}}) {      if (defined $courselogs{$ENV{'request.course.id'}}) {
  $courselogs{$ENV{'request.course.id'}}.='&'.$what;   $courselogs{$ENV{'request.course.id'}}.='&'.$what;
     } else {      } else {
Line 787  sub courseacclog { Line 805  sub courseacclog {
     unless ($ENV{'request.course.id'}) { return ''; }      unless ($ENV{'request.course.id'}) { return ''; }
     my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'};      my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'};
     if ($what=~/(problem|exam|quiz|assess|survey|form)$/) {      if ($what=~/(problem|exam|quiz|assess|survey|form)$/) {
           $what.=':POST';
  map {   map {
             if ($_=~/^form\.(.*)/) {              if ($_=~/^form\.(.*)/) {
  $what.=':'.$1.'='.$ENV{$_};   $what.=':'.$1.'='.$ENV{$_};
Line 796  sub courseacclog { Line 815  sub courseacclog {
     &courselog($what);      &courselog($what);
 }  }
   
   sub countacc {
       my $url=&declutter(shift);
       unless ($ENV{'request.course.id'}) { return ''; }
       $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1;
       my $key=$processmarker.'_'.$dumpcount.'___'.$url.'___count';
       if (defined($accesshash{$key})) {
    $accesshash{$key}++;
       } else {
           $accesshash{$key}=1;
       }
   }
       
 # ----------------------------------------------------------- Check out an item  # ----------------------------------------------------------- Check out an item
   
 sub checkout {  sub checkout {
Line 963  sub tmpreset { Line 994  sub tmpreset {
   $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',    $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
   &GDBM_WRCREAT,0640)) {    &GDBM_WRCREAT,0640)) {
     foreach my $key (keys %hash) {      foreach my $key (keys %hash) {
       if ($key=~ /:$symb:/) {        if ($key=~ /:$symb/) {
  delete($hash{$key});   delete($hash{$key});
       }        }
     }      }
Line 1077  sub store { Line 1108  sub store {
     &devalidate($symb);      &devalidate($symb);
   
     $symb=escape($symb);      $symb=escape($symb);
     if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }      if (!$namespace) { 
          unless ($namespace=$ENV{'request.course.id'}) { 
             return ''; 
          } 
       }
     if (!$domain) { $domain=$ENV{'user.domain'}; }      if (!$domain) { $domain=$ENV{'user.domain'}; }
     if (!$stuname) { $stuname=$ENV{'user.name'}; }      if (!$stuname) { $stuname=$ENV{'user.name'}; }
     if (!$home) { $home=$ENV{'user.home'}; }      if (!$home) { $home=$ENV{'user.home'}; }
Line 1086  sub store { Line 1121  sub store {
         $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';          $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
     } keys %$storehash;      } keys %$storehash;
     $namevalue=~s/\&$//;      $namevalue=~s/\&$//;
       &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue);
     return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");      return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
 }  }
   
Line 1102  sub cstore { Line 1138  sub cstore {
     &devalidate($symb);      &devalidate($symb);
   
     $symb=escape($symb);      $symb=escape($symb);
     if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }      if (!$namespace) { 
          unless ($namespace=$ENV{'request.course.id'}) { 
             return ''; 
          } 
       }
     if (!$domain) { $domain=$ENV{'user.domain'}; }      if (!$domain) { $domain=$ENV{'user.domain'}; }
     if (!$stuname) { $stuname=$ENV{'user.name'}; }      if (!$stuname) { $stuname=$ENV{'user.name'}; }
     if (!$home) { $home=$ENV{'user.home'}; }      if (!$home) { $home=$ENV{'user.home'}; }
Line 1112  sub cstore { Line 1152  sub cstore {
         $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';          $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
     } keys %$storehash;      } keys %$storehash;
     $namevalue=~s/\&$//;      $namevalue=~s/\&$//;
     return critical("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");      &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);
       return critical
                   ("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
 }  }
   
 # --------------------------------------------------------------------- Restore  # --------------------------------------------------------------------- Restore
Line 1128  sub restore { Line 1170  sub restore {
     } else {      } else {
       $symb=&escape($symb);        $symb=&escape($symb);
     }      }
     if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }      if (!$namespace) { 
          unless ($namespace=$ENV{'request.course.id'}) { 
             return ''; 
          } 
       }
     if (!$domain) { $domain=$ENV{'user.domain'}; }      if (!$domain) { $domain=$ENV{'user.domain'}; }
     if (!$stuname) { $stuname=$ENV{'user.name'}; }      if (!$stuname) { $stuname=$ENV{'user.name'}; }
     if (!$home) { $home=$ENV{'user.home'}; }      if (!$home) { $home=$ENV{'user.home'}; }
Line 1709  sub plaintext { Line 1755  sub plaintext {
     return $prp{$short};      return $prp{$short};
 }  }
   
 # ------------------------------------------------------------------ Plain Text  # ------------------------------------------------------------- Embedding Style
   
 sub fileembstyle {  sub fileembstyle {
     my $ending=shift;      my $ending=lc(shift);
     return $fe{$ending};      return $fe{$ending};
 }  }
   
 # ------------------------------------------------------------ Description Text  # ------------------------------------------------------------ Description Text
   
 sub filedescription {  sub filedescription {
     my $ending=shift;      my $ending=lc(shift);
     return $fd{$ending};      return $fd{$ending};
 }  }
   
Line 2409  sub symblist { Line 2455  sub symblist {
 sub symbread {  sub symbread {
     my $thisfn=shift;      my $thisfn=shift;
     unless ($thisfn) {      unless ($thisfn) {
           if ($ENV{'request.symb'}) { return $ENV{'request.symb'}; }
  $thisfn=$ENV{'request.filename'};   $thisfn=$ENV{'request.filename'};
     }      }
     $thisfn=declutter($thisfn);      $thisfn=declutter($thisfn);
Line 2605  sub unescape { Line 2652  sub unescape {
   
 # ================================================================ Main Program  # ================================================================ Main Program
   
 sub BEGIN {  sub goodbye {
 unless ($readit) {     &flushcourselogs();
      &logthis("Shutting down");
   }
   
   BEGIN {
 # ------------------------------------------------------------ Read access.conf  # ------------------------------------------------------------ Read access.conf
 {  {
     my $config=Apache::File->new("/etc/httpd/conf/access.conf");      my $config=Apache::File->new("/etc/httpd/conf/access.conf");
Line 2691  unless ($readit) { Line 2742  unless ($readit) {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");      my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
          next if ($configline =~ /^\#/);
        chomp($configline);         chomp($configline);
        my ($ending,$emb,@descr)=split(/\s+/,$configline);         my ($ending,$emb,@descr)=split(/\s+/,$configline);
        if ($descr[0] ne '') {          if ($descr[0] ne '') { 
          $fe{$ending}=$emb;           $fe{$ending}=lc($emb);
          $fd{$ending}=join(' ',@descr);           $fd{$ending}=join(' ',@descr);
        }         }
     }      }
Line 2702  unless ($readit) { Line 2754  unless ($readit) {
   
 %metacache=();  %metacache=();
   
 $readit='done';  $processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'};
   $dumpcount=0;
   
 &logtouch();  &logtouch();
 &logthis('<font color=yellow>INFO: Read configuration</font>');  &logthis('<font color=yellow>INFO: Read configuration</font>');
 }  }
 }  
 1;  1;
Removed from v.1.178  
changed lines
  Added in v.1.190

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