--- loncom/lonnet/perl/lonnet.pm 2001/11/29 18:54:16 1.178 +++ loncom/lonnet/perl/lonnet.pm 2001/12/07 16:43:39 1.186 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.178 2001/11/29 18:54:16 www Exp $ +# $Id: lonnet.pm,v 1.186 2001/12/07 16:43:39 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -59,9 +59,12 @@ # 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/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 +# 12/5 Guy Albertelli +# 12/6 Gerd Kortemeyer # -# $Id: lonnet.pm,v 1.178 2001/11/29 18:54:16 www Exp $ +# $Id: lonnet.pm,v 1.186 2001/12/07 16:43:39 www Exp $ # ### @@ -169,7 +172,7 @@ use Apache::File; use LWP::UserAgent(); use HTTP::Headers; 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); use IO::Socket; use GDBM_File; use Apache::Constants qw(:common :http); @@ -766,6 +769,16 @@ sub flushcourselogs { } } } 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 { @@ -796,6 +809,18 @@ sub courseacclog { &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 sub checkout { @@ -963,7 +988,7 @@ sub tmpreset { $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db', &GDBM_WRCREAT,0640)) { foreach my $key (keys %hash) { - if ($key=~ /:$symb:/) { + if ($key=~ /:$symb/) { delete($hash{$key}); } } @@ -1712,14 +1737,14 @@ sub plaintext { # ------------------------------------------------------------------ Plain Text sub fileembstyle { - my $ending=shift; + my $ending=lc(shift); return $fe{$ending}; } # ------------------------------------------------------------ Description Text sub filedescription { - my $ending=shift; + my $ending=lc(shift); return $fd{$ending}; } @@ -2409,6 +2434,7 @@ sub symblist { sub symbread { my $thisfn=shift; unless ($thisfn) { + if ($ENV{'request.symb'}) { return $ENV{'request.symb'}; } $thisfn=$ENV{'request.filename'}; } $thisfn=declutter($thisfn); @@ -2605,8 +2631,12 @@ sub unescape { # ================================================================ Main Program -sub BEGIN { -unless ($readit) { +sub goodbye { + &flushcourselogs(); + &logthis("Shutting down"); +} + +BEGIN { # ------------------------------------------------------------ Read access.conf { my $config=Apache::File->new("/etc/httpd/conf/access.conf"); @@ -2691,10 +2721,11 @@ unless ($readit) { 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}=$emb; + $fe{$ending}=lc($emb); $fd{$ending}=join(' ',@descr); } } @@ -2702,9 +2733,11 @@ unless ($readit) { %metacache=(); -$readit='done'; +$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'}; +$dumpcount=0; + &logtouch(); &logthis('<font color=yellow>INFO: Read configuration</font>'); } -} + 1;