--- loncom/lonnet/perl/lonnet.pm 2001/03/15 14:04:32 1.106 +++ loncom/lonnet/perl/lonnet.pm 2001/04/16 23:16:31 1.122 @@ -3,6 +3,9 @@ # # Functions for use by content handlers: # +# metadata_query(sql-query-string,custom-metadata-regex) : +# returns file handle of where sql and +# regex results will be stored for query # plaintext(short) : plain text explanation of short term # fileembstyle(ext) : embed style in page for file extension # filedescription(ext) : descriptor text for file extension @@ -25,9 +28,18 @@ # revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role # appenv(hash) : adds hash to session environment # delenv(varname) : deletes all environment entries starting with varname -# store(hash) : stores hash permanently for this url -# cstore(hash) : critical store -# restore : returns hash for this url +# store(hashref,symb,courseid,udom,uname,homeserver) +# : stores hash permanently for this url +# hashref needs to be given, and should be a \%hashname +# the remaining args aren't required and if they aren't +# passed or are '' they will be derived from the ENV +# cstore(hashref,symb,courseid,udom,uname,homeserver) +# : same as store but uses the critical interface to +# guarentee a store +# restore(symb,courseid,udom,uname,homeserver) +# : returns hash for this symb, all args are optional +# if they aren't given they will be derived from the current +# enviroment # eget(namesp,array) : returns hash with keys from array filled in from namesp # get(namesp,array) : returns hash with keys from array filled in from namesp # del(namesp,array) : deletes keys out of array from namesp @@ -49,7 +61,7 @@ # receipt() : returns a receipt to be given out to users # getfile(filename) : returns the contents of filename, or a -1 if it can't # be found, replicates and subscribes to the file -# filelocation(dir,file) : returns a farily clean absolute reference to file +# filelocation(dir,file) : returns a fairly clean absolute reference to file # from the directory dir # hreflocation(dir,file) : same as filelocation, but for hrefs # log(domain,user,home,msg) : write to permanent log for user @@ -88,7 +100,9 @@ # 09/01,10/01,11/01 Gerd Kortemeyer # 02/27/01 Scott Harrison # 3/2 Gerd Kortemeyer -# 3/15 Scott Harrison +# 3/15,3/19 Scott Harrison +# 3/19,3/20 Gerd Kortemeyer +# 3/22,3/27 Scott Harrison package Apache::lonnet; @@ -625,52 +639,108 @@ sub log { return critical("log:$dom:$nam:$what",$hom); } +# --------------------------------------------- Set Expire Date for Spreadsheet + +sub expirespread { + my ($uname,$udom,$stype,$usymb)=@_; + my $cid=$ENV{'request.course.id'}; + if ($cid) { + my $now=time; + my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; + return &reply('put:'.$ENV{'course.'.$cid.'.domain'}.':'. + $ENV{'course.'.$cid.'.num'}. + ':nohist_expirationdates:'. + &escape($key).'='.$now, + $ENV{'course.'.$cid.'.home'}) + } + return 'ok'; +} + +# ----------------------------------------------------- Devalidate Spreadsheets + +sub devalidate { + my $symb=shift; + my $cid=$ENV{'request.course.id'}; + if ($cid) { + my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':'; + my $status= + &reply('del:'.$ENV{'course.'.$cid.'.domain'}.':'. + $ENV{'course.'.$cid.'.num'}. + ':nohist_calculatedsheets:'. + &escape($key.'studentcalc:'), + $ENV{'course.'.$cid.'.home'}) + .' '. + &reply('del:'.$ENV{'user.domain'}.':'. + $ENV{'user.name'}. + ':nohist_calculatedsheets_'.$cid.':'. + &escape($key.'assesscalc:'.$symb), + $ENV{'user.home'}); + unless ($status eq 'ok ok') { + &logthis('Could not devalidate spreadsheet '. + $ENV{'user.name'}.' at '.$ENV{'user.domain'}.' for '. + $symb.': '.$status); + } + } +} + # ----------------------------------------------------------------------- Store sub store { - my %storehash=@_; - my $symb; - unless ($symb=escape(&symbread())) { return ''; } - my $namespace; - unless ($namespace=$ENV{'request.course.id'}) { return ''; } + my ($storehash,$symb,$namespace,$domain,$stuname,$home) = @_; + if (!$symb) { unless ($symb=&symbread()) { return ''; } } + + &devalidate($symb); + + $symb=escape($symb); + if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } } + if (!$domain) { $domain=$ENV{'user.domain'}; } + if (!$stuname) { $stuname=$ENV{'user.name'}; } + if (!$home) { $home=$ENV{'user.home'}; } my $namevalue=''; map { - $namevalue.=escape($_).'='.escape($storehash{$_}).'&'; - } keys %storehash; + $namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; + } keys %$storehash; $namevalue=~s/\&$//; - return reply( - "store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue", - "$ENV{'user.home'}"); + return critical("store:$domain:$stuname:$namespace:$symb:$namevalue","$home"); } # -------------------------------------------------------------- Critical Store sub cstore { - my %storehash=@_; - my $symb; - unless ($symb=escape(&symbread())) { return ''; } - my $namespace; - unless ($namespace=$ENV{'request.course.id'}) { return ''; } + my ($storehash,$symb,$namespace,$domain,$stuname,$home) = @_; + if (!$symb) { unless ($symb=&symbread()) { return ''; } } + + &devalidate($symb); + + $symb=escape($symb); + if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } } + if (!$domain) { $domain=$ENV{'user.domain'}; } + if (!$stuname) { $stuname=$ENV{'user.name'}; } + if (!$home) { $home=$ENV{'user.home'}; } + my $namevalue=''; map { - $namevalue.=escape($_).'='.escape($storehash{$_}).'&'; - } keys %storehash; + $namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; + } keys %$storehash; $namevalue=~s/\&$//; - return critical( - "store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue", - "$ENV{'user.home'}"); + return critical("store:$domain:$stuname:$namespace:$symb:$namevalue","$home"); } # --------------------------------------------------------------------- Restore sub restore { - my $symb; - unless ($symb=escape(&symbread())) { return ''; } - my $namespace; - unless ($namespace=$ENV{'request.course.id'}) { return ''; } - my $answer=reply( - "restore:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb", - "$ENV{'user.home'}"); + my ($symb,$namespace,$domain,$stuname,$home) = @_; + if (!$symb) { + unless ($symb=escape(&symbread())) { return ''; } + } else { + $symb=&escape($symb); + } + if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } } + if (!$domain) { $domain=$ENV{'user.domain'}; } + if (!$stuname) { $stuname=$ENV{'user.name'}; } + if (!$home) { $home=$ENV{'user.home'}; } + my $answer=&reply("restore:$domain:$stuname:$namespace:$symb","$home"); + my %returnhash=(); map { my ($name,$value)=split(/\=/,$_); @@ -1186,8 +1256,23 @@ sub definerole { # ---------------- Make a metadata query against the network of library servers sub metadata_query { - my ($query)=@_; - my $reply=&reply("querysend:$query",'msul3'); + my ($query,$custom,$customshow)=@_; + # need to put in a library server loop here and return a hash + my %rhash; +# for my $server (keys %libserv) { + for my $server ('msul3') { + unless ($custom or $customshow) { + my $reply=&reply("querysend:".&escape($query),$server); + $rhash{$server}=$reply; + } + else { + my $reply=&reply("querysend:".&escape($query).':'. + &escape($custom).':'.&escape($customshow), + $server); + $rhash{$server}=$reply; + } + } + return \%rhash; } # ------------------------------------------------------------------ Plain Text @@ -1563,7 +1648,7 @@ sub EXT { if ($realm eq 'user') { # --------------------------------------------------------------- user.resource if ($space eq 'resource') { - my %restored=&restore; + my %restored=&restore(); return $restored{$qualifierrest}; # ----------------------------------------------------------------- user.access } elsif ($space eq 'access') {