--- loncom/lonnet/perl/lonnet.pm 2001/03/15 14:04:32 1.106
+++ loncom/lonnet/perl/lonnet.pm 2001/05/26 19:57:47 1.124
@@ -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)
+# : 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)
+# : same as store but uses the critical interface to
+# guarentee a store
+# restore(symb,courseid,udom,uname)
+# : 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,8 +100,11 @@
# 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,4/2,4/16,4/17 Scott Harrison
+# 5/26 Gerd Kortemeyer
+#
package Apache::lonnet;
use strict;
@@ -625,52 +640,126 @@ 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) = @_;
+ my $home='';
+
+ if ($stuname) {
+ $home=&homeserver($stuname,$domain);
+ }
+
+ 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 reply("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) = @_;
+ my $home='';
+
+ if ($stuname) {
+ $home=&homeserver($stuname,$domain);
+ }
+
+ 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) = @_;
+ my $home='';
+
+ if ($stuname) {
+ $home=&homeserver($stuname,$domain);
+ }
+
+ 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 +1275,22 @@ 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) {
+ 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 +1666,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') {