--- loncom/lonnet/perl/lonnet.pm 2006/04/06 19:14:50 1.726 +++ loncom/lonnet/perl/lonnet.pm 2006/04/26 15:47:38 1.732 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.726 2006/04/06 19:14:50 albertel Exp $ +# $Id: lonnet.pm,v 1.732 2006/04/26 15:47:38 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -45,7 +45,6 @@ qw(%perlvar %hostname %badServerCache %i use IO::Socket; use GDBM_File; -use Apache::Constants qw(:common :http); use HTML::LCParser; use HTML::Parser; use Fcntl qw(:flock); @@ -86,6 +85,29 @@ delayed. # --------------------------------------------------------------------- Logging +{ + my $logid; + sub instructor_log { + my ($hash_name,$storehash,$delflag,$uname,$udom)=@_; + $logid++; + my $id=time().'00000'.$$.'00000'.$logid; + return &Apache::lonnet::put('nohist_'.$hash_name, + { $id => { + 'exe_uname' => $env{'user.name'}, + 'exe_udom' => $env{'user.domain'}, + 'exe_time' => time(), + 'exe_ip' => $ENV{'REMOTE_ADDR'}, + 'delflag' => $delflag, + 'logentry' => $storehash, + 'uname' => $uname, + 'udom' => $udom, + } + }, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'} + ); + } +} sub logtouch { my $execdir=$perlvar{'lonDaemons'}; @@ -852,12 +874,9 @@ sub getsection { } sub save_cache { - my ($r)=@_; - if (! $r->is_initial_req()) { return DECLINED; } &purge_remembered(); #&Apache::loncommon::validate_page(); undef(%env); - return OK; } my $to_remember=-1; @@ -2581,7 +2600,7 @@ sub restore { # ---------------------------------------------------------- Course Description sub coursedescription { - my $courseid=shift; + my ($courseid,$args)=@_; $courseid=~s/^\///; $courseid=~s/\_/\//g; my ($cdomain,$cnum)=split(/\//,$courseid); @@ -2591,7 +2610,27 @@ sub coursedescription { # trying and trying and trying to get the course description. my %envhash=(); my %returnhash=(); - $envhash{'course.'.$normalid.'.last_cache'}=time; + + my $expiretime=600; + if ($env{'request.course.id'} eq $normalid) { + $expiretime=120; + } + + my $prefix='course.'.$cdomain.'_'.$cnum.'.'; + if (!$args->{'freshen_cache'} + && ((time-$env{$prefix.'last_cache'}) < $expiretime) ) { + foreach my $key (keys(%env)) { + next if ($key !~ /^\Q$prefix\E(.*)/); + my ($setting) = $1; + $returnhash{$setting} = $env{$key}; + } + return %returnhash; + } + + # get the data agin + if (!$args->{'one_time'}) { + $envhash{'course.'.$normalid.'.last_cache'}=time; + } if ($chome ne 'no_host') { %returnhash=&dump('environment',$cdomain,$cnum); if (!exists($returnhash{'con_lost'})) { @@ -2609,7 +2648,9 @@ sub coursedescription { $envhash{'course.'.$normalid.'.num'}=$cnum; } } - &appenv(%envhash); + if (!$args->{'one_time'}) { + &appenv(%envhash); + } return %returnhash; } @@ -3429,7 +3470,7 @@ sub allowed { my ($cdom,$cnum,$csec)=split(/\//,$courseid); my $prefix='course.'.$cdom.'_'.$cnum.'.'; if ((time-$env{$prefix.'last_cache'})>$expiretime) { - &coursedescription($courseid); + &coursedescription($courseid,{'freshen_cache' => 1}); } if (($env{$prefix.'res.'.$uri.'.lock.sections'}=~/\,\Q$csec\E\,/) || ($env{$prefix.'res.'.$uri.'.lock.sections'} eq 'all')) { @@ -3992,7 +4033,7 @@ sub get_users_groups { my $grouplist; foreach my $key (keys %roleshash) { if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) { - unless ($roleshash{$key} =~ /_1_1$/) { # deleted membership + unless ($roleshash{$key} =~ /_\d+_\-1$/) { # deleted membership $grouplist .= $1.':'; } } @@ -6525,7 +6566,6 @@ sub goodbye { &logthis(sprintf("%-20s is %s",'hits',$hits)); &flushcourselogs(); &logthis("Shutting down"); - return DONE; } BEGIN {