--- loncom/lonnet/perl/lonnet.pm 2002/02/04 15:31:22 1.199 +++ loncom/lonnet/perl/lonnet.pm 2002/02/07 13:56:06 1.200 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.199 2002/02/04 15:31:22 www Exp $ +# $Id: lonnet.pm,v 1.200 2002/02/07 13:56:06 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -66,7 +66,7 @@ # 12/18 Scott Harrison # 12/21,12/22,12/27,12/28 Gerd Kortemeyer # YEAR=2002 -# 1/4,2/4 Gerd Kortemeyer +# 1/4,2/4,2/7 Gerd Kortemeyer # ### @@ -80,7 +80,7 @@ use vars qw(%perlvar %hostname %homecache %hostip %spareid %hostdom %libserv %pr %prp %metacache %packagetab %courselogs %accesshash $processmarker $dumpcount - %coursedombuf %coursehombuf); + %coursedombuf %coursehombuf %courseresdatacache); use IO::Socket; use GDBM_File; use Apache::Constants qw(:common :http); @@ -2024,6 +2024,38 @@ sub condval { return $result; } +# --------------------------------------------------- Course Resourcedata Query + +sub courseresdata { + my ($coursenum,$coursedomain,@which)=@_; + my $coursehom=&homeserver($coursenum,$coursedomain); + my $hashid=$coursenum.':'.$coursedomain; + unless (defined($courseresdatacache{$hashid.'.time'})) { + unless (time-$courseresdatacache{$hashid.'.time'}<300) { + my $coursehom=&homeserver($coursenum,$coursedomain); + if ($coursehom) { + my $dumpreply=&reply('dump:'.$coursedomain.':'.$coursenum. + ':resourcedata:.',$coursehom); + unless ($dumpreply=~/^error\:/) { + $courseresdatacache{$hashid.'.time'}=time; + $courseresdatacache{$hashid}=$dumpreply; + } + } + } + } + my @pairs=split(/\&/,$courseresdatacache{$hashid}); + my %returnhash=(); + foreach (@pairs) { + my ($key,$value)=split(/=/,$_); + $returnhash{unescape($key)}=unescape($value); + } + my $item; + foreach $item (@which) { + if ($returnhash{$item}) { return $returnhash{$item}; } + } + return ''; +} + # --------------------------------------------------------- Value of a Variable sub EXT { @@ -2144,28 +2176,13 @@ sub EXT { # -------------------------------------------------------- second, check course - my $reply=&reply('get:'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}. - ':resourcedata:'. - &escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'. - &escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel), - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); - if ($reply!~/^error\:/) { - foreach (split(/\&/,$reply)) { - if ($_) { return &unescape($_); } - } - } - if (($reply=~/^con_lost/) || ($reply=~/^error\:/)) { - &logthis("WARNING:". - " Getting ".$reply." asking for ".$varname." for ". - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}. - ' at '. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}. - ' from '. - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}. - ""); - } + my $coursereply=&courseresdata( + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + ($seclevelr,$seclevelm,$seclevel, + $courselevelr,$courselevelm,$courselevel)); + if ($coursereply) { return $coursereply; } + # ------------------------------------------------------ third, check map parms my %parmhash=(); my $thisparm='';