--- loncom/lonnet/perl/lonnet.pm 2001/01/19 21:19:28 1.99
+++ loncom/lonnet/perl/lonnet.pm 2001/03/22 15:08:49 1.112
@@ -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
@@ -13,7 +16,7 @@
# 1: user needs to choose course
# 2: browse allowed
# definerole(rolename,sys,dom,cou) : define a custom role rolename
-# set priviledges in format of lonTabs/roles.tab for
+# set privileges in format of lonTabs/roles.tab for
# system, domain and course level,
# assignrole(udom,uname,url,role,end,start) : give a role to a user for the
# level given by url. Optional start and end dates
@@ -86,6 +89,10 @@
# 05/01,06/01,09/01 Gerd Kortemeyer
# 09/01 Guy Albertelli
# 09/01,10/01,11/01 Gerd Kortemeyer
+# 02/27/01 Scott Harrison
+# 3/2 Gerd Kortemeyer
+# 3/15 Scott Harrison
+# 3/19,3/20 Gerd Kortemeyer
package Apache::lonnet;
@@ -622,12 +629,60 @@ 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 ''; }
+ unless ($symb=&symbread()) { return ''; }
+
+ &devalidate($symb);
+
+ $symb=escape($symb);
my $namespace;
unless ($namespace=$ENV{'request.course.id'}) { return ''; }
my $namevalue='';
@@ -645,7 +700,11 @@ sub store {
sub cstore {
my %storehash=@_;
my $symb;
- unless ($symb=escape(&symbread())) { return ''; }
+ unless ($symb=&symbread()) { return ''; }
+
+ &devalidate($symb);
+
+ $symb=escape($symb);
my $namespace;
unless ($namespace=$ENV{'request.course.id'}) { return ''; }
my $namevalue='';
@@ -719,7 +778,7 @@ sub coursedescription {
return ();
}
-# -------------------------------------------------------- Get user priviledges
+# -------------------------------------------------------- Get user privileges
sub rolesinit {
my ($domain,$username,$authhost)=@_;
@@ -793,12 +852,12 @@ sub rolesinit {
%thesepriv=();
map {
if ($_ ne '') {
- my ($priviledge,$restrictions)=split(/&/,$_);
+ my ($privilege,$restrictions)=split(/&/,$_);
if ($restrictions eq '') {
- $thesepriv{$priviledge}='F';
+ $thesepriv{$privilege}='F';
} else {
- if ($thesepriv{$priviledge} ne 'F') {
- $thesepriv{$priviledge}.=$restrictions;
+ if ($thesepriv{$privilege} ne 'F') {
+ $thesepriv{$privilege}.=$restrictions;
}
}
}
@@ -908,7 +967,7 @@ sub eget {
return %returnhash;
}
-# ------------------------------------------------- Check for a user priviledge
+# ------------------------------------------------- Check for a user privilege
sub allowed {
my ($priv,$uri)=@_;
@@ -959,7 +1018,7 @@ sub allowed {
return $thisallowed;
}
#
-# Gathered so far: system, domain and course wide priviledges
+# Gathered so far: system, domain and course wide privileges
#
# Course: See if uri or referer is an individual resource that is part of
# the course
@@ -1010,7 +1069,7 @@ sub allowed {
}
#
-# Gathered now: all priviledges that could apply, and condition number
+# Gathered now: all privileges that could apply, and condition number
#
#
# Full or no access?
@@ -1180,6 +1239,27 @@ sub definerole {
}
}
+# ---------------- Make a metadata query against the network of library servers
+
+sub metadata_query {
+<<<<<<< lonnet.pm
+ my ($query,$custom)=@_;
+ unless ($custom) {
+ my $reply=&reply("querysend:".&escape($query),'msul3');
+ return $reply;
+ }
+ else {
+ my $reply=&reply("querysend:".&escape($query).':'.
+ &escape($customquery),'msul3');
+ return $reply;
+ }
+=======
+ my ($query)=@_;
+ # need to put in a loop here and return list
+ my $reply=&reply("querysend:".&escape($query),'msul3');
+>>>>>>> 1.111
+}
+
# ------------------------------------------------------------------ Plain Text
sub plaintext {
@@ -1207,12 +1287,22 @@ sub assignrole {
my ($udom,$uname,$url,$role,$end,$start)=@_;
my $mrole;
if ($role =~ /^cr\//) {
- unless (&allowed('ccr',$url)) { return 'refused'; }
+ unless (&allowed('ccr',$url)) {
+ &logthis('Refused custom assignrole: '.
+ $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
+ $ENV{'user.name'}.' at '.$ENV{'user.domain'});
+ return 'refused';
+ }
$mrole='cr';
} else {
my $cwosec=$url;
$cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
- unless (&allowed('c'.$role,$cwosec)) { return 'refused'; }
+ unless (&allowed('c'.$role,$cwosec)) {
+ &logthis('Refused assignrole: '.
+ $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
+ $ENV{'user.name'}.' at '.$ENV{'user.domain'});
+ return 'refused';
+ }
$mrole=$role;
}
my $command="encrypt:rolesput:$ENV{'user.domain'}:$ENV{'user.name'}:".
@@ -1846,9 +1936,9 @@ sub rndseed {
{
use integer;
my $symbchck=unpack("%32C*",$symb) << 27;
- my $symbseed=numval($symb)%$symbchck << 22;
+ my $symbseed=numval($symb) << 22;
my $namechck=unpack("%32C*",$ENV{'user.name'}) << 17;
- my $nameseed=numval($ENV{'user.name'})%$namechck << 12;
+ my $nameseed=numval($ENV{'user.name'}) << 12;
my $domainseed=unpack("%32C*",$ENV{'user.domain'}) << 7;
my $courseseed=unpack("%32C*",$ENV{'request.course.id'});
my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;