[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.191 and 1.195

version 1.191, 2001/12/18 20:59:38 version 1.195, 2001/12/28 19:48:42
Line 64 Line 64
 # 12/5 Guy Albertelli  # 12/5 Guy Albertelli
 # 12/6,12/7,12/12 Gerd Kortemeyer  # 12/6,12/7,12/12 Gerd Kortemeyer
 # 12/18 Scott Harrison  # 12/18 Scott Harrison
   # 12/21,12/22,12/27,12/28 Gerd Kortemeyer
 #  #
 ###  ###
   
Line 75  use LWP::UserAgent(); Line 76  use LWP::UserAgent();
 use HTTP::Headers;  use HTTP::Headers;
 use vars   use vars 
 qw(%perlvar %hostname %homecache %hostip %spareid %hostdom   qw(%perlvar %hostname %homecache %hostip %spareid %hostdom 
    %libserv %pr %prp %fe %fd %metacache %packagetab      %libserv %pr %prp %metacache %packagetab 
    %courselogs %accesshash $processmarker $dumpcount      %courselogs %accesshash $processmarker $dumpcount 
    %coursedombuf %coursehombuf);     %coursedombuf %coursehombuf);
 use IO::Socket;  use IO::Socket;
Line 83  use GDBM_File; Line 84  use GDBM_File;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use HTML::TokeParser;  use HTML::TokeParser;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
   my $readit;
   
 # --------------------------------------------------------------------- Logging  # --------------------------------------------------------------------- Logging
   
Line 708  sub courseacclog { Line 710  sub courseacclog {
     my $fnsymb=shift;      my $fnsymb=shift;
     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 ($fnsymb=~/(problem|exam|quiz|assess|survey|form)$/) {
         $what.=':POST';          $what.=':POST';
  foreach (keys %ENV) {   foreach (keys %ENV) {
             if ($_=~/^form\.(.*)/) {              if ($_=~/^form\.(.*)/) {
Line 1273  sub del { Line 1275  sub del {
 # -------------------------------------------------------------- dump interface  # -------------------------------------------------------------- dump interface
   
 sub dump {  sub dump {
    my ($namespace,$udomain,$uname)=@_;     my ($namespace,$udomain,$uname,$regexp)=@_;
    if (!$udomain) { $udomain=$ENV{'user.domain'}; }     if (!$udomain) { $udomain=$ENV{'user.domain'}; }
    if (!$uname) { $uname=$ENV{'user.name'}; }     if (!$uname) { $uname=$ENV{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);     my $uhome=&homeserver($uname,$udomain);
    my $rep=reply("dump:$udomain:$uname:$namespace",$uhome);     if ($regexp) {
          $regexp=&escape($regexp);
      } else {
          $regexp='.';
      }
      my $rep=reply("dump:$udomain:$uname:$namespace:$regexp",$uhome);
    my @pairs=split(/\&/,$rep);     my @pairs=split(/\&/,$rep);
    my %returnhash=();     my %returnhash=();
    foreach (@pairs) {     foreach (@pairs) {
Line 1548  sub allowed { Line 1555  sub allowed {
    if ($thisallowed=~/C/) {     if ($thisallowed=~/C/) {
        my $rolecode=(split(/\./,$ENV{'request.role'}))[0];         my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
        if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'}         if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'}
    =~/\,$rolecode\,/) {     =~/$rolecode/) {
            &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},             &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
                 'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.                  'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
                 $ENV{'request.course.id'});                  $ENV{'request.course.id'});
Line 2549  sub goodbye { Line 2556  sub goodbye {
   
 BEGIN {  BEGIN {
 # ------------------------------------------------------------ Read access.conf  # ------------------------------------------------------------ Read access.conf
       unless ($readit) {
 {  {
     my $config=Apache::File->new("/etc/httpd/conf/access.conf");      my $config=Apache::File->new("/etc/httpd/conf/access.conf");
   
Line 2627  BEGIN { Line 2635  BEGIN {
     }      }
 }  }
   
 # ------------------------------------------------------------- Read file types  
 {  
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");  
   
     while (my $configline=<$config>) {  
        next if ($configline =~ /^\#/);  
        chomp($configline);  
        my ($ending,$emb,@descr)=split(/\s+/,$configline);  
        if ($descr[0] ne '') {   
          $fe{$ending}=lc($emb);  
          $fd{$ending}=join(' ',@descr);  
        }  
     }  
 }  
   
 %metacache=();  %metacache=();
   
 $processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'};  $processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'};
Line 2649  $dumpcount=0; Line 2642  $dumpcount=0;
   
 &logtouch();  &logtouch();
 &logthis('<font color=yellow>INFO: Read configuration</font>');  &logthis('<font color=yellow>INFO: Read configuration</font>');
   $readit=1;
   }
 }  }
   
 1;  1;
Line 2869  namesp ($udomain and $uname are optional Line 2864  namesp ($udomain and $uname are optional
   
 =item *  =item *
   
 dump($namespace,$udomain,$uname) : dumps the complete namespace into a hash  dump($namespace,$udomain,$uname,$regexp) : 
 ($udomain and $uname are optional)  dumps the complete (or key matching regexp) namespace into a hash
   ($udomain, $uname and $regexp are optional)
   
 =item *  =item *
   
Removed from v.1.191  
changed lines
  Added in v.1.195

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