--- loncom/lonnet/perl/lonnet.pm 2007/10/04 19:59:16 1.920
+++ loncom/lonnet/perl/lonnet.pm 2007/11/13 22:19:53 1.924
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.920 2007/10/04 19:59:16 raeburn Exp $
+# $Id: lonnet.pm,v 1.924 2007/11/13 22:19:53 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1047,7 +1047,7 @@ sub get_instuser {
}
sub inst_rulecheck {
- my ($udom,$uname,$rules) = @_;
+ my ($udom,$uname,$id,$item,$rules) = @_;
my %returnhash;
if ($udom ne '') {
if (ref($rules) eq 'ARRAY') {
@@ -1055,9 +1055,16 @@ sub inst_rulecheck {
my $rulestr = join(':',@{$rules});
my $homeserver=&domain($udom,'primary');
if (($homeserver ne '') && ($homeserver ne 'no_host')) {
- my $response=&unescape(&reply('instrulecheck:'.&escape($udom).':'.
- &escape($uname).':'.$rulestr,
+ my $response;
+ if ($item eq 'username') {
+ $response=&unescape(&reply('instrulecheck:'.&escape($udom).
+ ':'.&escape($uname).':'.$rulestr,
$homeserver));
+ } elsif ($item eq 'id') {
+ $response=&unescape(&reply('instidrulecheck:'.&escape($udom).
+ ':'.&escape($id).':'.$rulestr,
+ $homeserver));
+ }
if ($response ne 'refused') {
my @pairs=split(/\&/,$response);
foreach my $item (@pairs) {
@@ -1074,14 +1081,21 @@ sub inst_rulecheck {
}
sub inst_userrules {
- my ($udom) = @_;
+ my ($udom,$check) = @_;
my (%ruleshash,@ruleorder);
if ($udom ne '') {
my $homeserver=&domain($udom,'primary');
if (($homeserver ne '') && ($homeserver ne 'no_host')) {
- my $response=&reply('instuserrules:'.&escape($udom),
+ my $response;
+ if ($check eq 'id') {
+ $response=&reply('instidrules:'.&escape($udom),
$homeserver);
+ } else {
+ $response=&reply('instuserrules:'.&escape($udom),
+ $homeserver);
+ }
if (($response ne 'refused') && ($response ne 'error') &&
+ ($response ne 'unknown_cmd') &&
($response ne 'no_such_host')) {
my ($hashitems,$orderitems) = split(/:/,$response);
my @pairs=split(/\&/,$hashitems);
@@ -2172,7 +2186,7 @@ sub flushcourselogs {
# times and course titles for all courseids
#
my %courseidbuffer=();
- foreach my $crsid (keys %courselogs) {
+ foreach my $crsid (keys(%courselogs)) {
if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'.
&escape($courselogs{$crsid}),
$coursehombuf{$crsid}) eq 'ok') {
@@ -2187,7 +2201,7 @@ sub flushcourselogs {
}
$courseidbuffer{$coursehombuf{$crsid}}{$crsid} = {
'description' => &escape($coursedescrbuf{$crsid}),
- 'instcode' => &escape($courseinstcodebuf{$crsid}),
+ 'inst_code' => &escape($courseinstcodebuf{$crsid}),
'type' => &escape($coursetypebuf{$crsid}),
'owner' => &escape($courseownerbuf{$crsid}),
};
@@ -2198,7 +2212,8 @@ sub flushcourselogs {
#
foreach my $crs_home (keys(%courseidbuffer)) {
my $response = &courseidput(&host_domain($crs_home),
- $courseidbuffer{$crs_home},$crs_home);
+ $courseidbuffer{$crs_home},
+ $crs_home,'timeonly');
}
#
# File accesses
@@ -2462,7 +2477,13 @@ sub get_my_roles {
}
if (ref($roles) eq 'ARRAY') {
if (!grep(/^\Q$role\E$/,@{$roles})) {
- next;
+ if ($role =~ /^cr\//) {
+ if (!grep(/^cr$/,@{$roles})) {
+ next;
+ }
+ } else {
+ next;
+ }
}
}
$returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;
@@ -2504,21 +2525,32 @@ sub getannounce {
#
sub courseidput {
- my ($domain,$storehash,$coursehome)=@_;
- my $items='';
- my $now = time;
- foreach my $item (keys(%$storehash)) {
- $storehash->{$item}{'lasttime'} = $now;
- $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
+ my ($domain,$storehash,$coursehome,$caller) = @_;
+ my $outcome;
+ if ($caller eq 'timeonly') {
+ my $cids = '';
+ foreach my $item (keys(%$storehash)) {
+ $cids.=&escape($item).'&';
+ }
+ $cids=~s/\&$//;
+ $outcome = &reply('courseidputhash:'.$domain.':'.$caller.':'.$cids,
+ $coursehome);
+ } else {
+ my $items = '';
+ foreach my $item (keys(%$storehash)) {
+ $items.= &escape($item).'='.
+ &freeze_escape($$storehash{$item}).'&';
+ }
+ $items=~s/\&$//;
+ $outcome = &reply('courseidputhash:'.$domain.':'.$caller.':'.$items,
+ $coursehome);
}
- $items=~s/\&$//;
- my $outcome = &reply('courseidputhash:'.$domain.':'.$items,$coursehome);
if ($outcome eq 'unknown_cmd') {
my $what;
foreach my $cid (keys(%$storehash)) {
$what .= &escape($cid).'=';
- foreach my $item ('description','instcode','owner','type') {
- $what .= $storehash->{$item}.':';
+ foreach my $item ('description','inst_code','owner','type') {
+ $what .= &escape($storehash->{$item}).':';
}
$what =~ s/\:$/&/;
}
@@ -2530,7 +2562,8 @@ sub courseidput {
}
sub courseiddump {
- my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
+ my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
+ $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
my $as_hash = 1;
my %returnhash;
if (!$domfilter) { $domfilter=''; }
@@ -2547,7 +2580,7 @@ sub courseiddump {
$sincefilter.':'.&escape($descfilter).':'.
&escape($instcodefilter).':'.&escape($ownerfilter).
':'.&escape($coursefilter).':'.&escape($typefilter).
- ':'.&escape($regexp_ok).':'.$as_hash,$tryserver);
+ ':'.&escape($regexp_ok).':'.$as_hash,$tryserver);
my @pairs=split(/\&/,$rep);
foreach my $item (@pairs) {
my ($key,$value)=split(/\=/,$item,2);
@@ -2557,10 +2590,10 @@ sub courseiddump {
if (ref($result) eq 'HASH') {
$returnhash{$key}=$result;
} else {
- my @responses = split(/:/,$result);
- my @items = ('description','instcode','owner','type');
+ my @responses = split(/:/,$value);
+ my @items = ('description','inst_code','owner','type');
for (my $i=0; $i<@responses; $i++) {
- $returnhash{$key}{$items[$i]} = $responses[$i];
+ $returnhash{$key}{$items[$i]} = &unescape($responses[$i]);
}
}
}
@@ -2608,7 +2641,10 @@ sub get_domain_roles {
if (undef($enddate) || $enddate eq '') {
$enddate = '.';
}
- my $rolelist = join(':',@{$roles});
+ my $rolelist;
+ if (ref($roles) eq 'ARRAY') {
+ $rolelist = join(':',@{$roles});
+ }
my %personnel = ();
my %servers = &get_servers($dom,'library');
@@ -5548,14 +5584,13 @@ sub createcourse {
# log existence
my $newcourse = {
$udom.'_'.$uname => {
- description => &escape($description),
- inst_code => &escape($inst_code),
- owner => &escape($course_owner),
- type => &escape($crstype),
+ description => $description,
+ inst_code => $inst_code,
+ owner => $course_owner,
+ type => $crstype,
},
};
- &courseidput($udom,$newcourse);
- &flushcourselogs();
+ &courseidput($udom,$newcourse,$uhome,'notime');
# set toplevel url
my $topurl=$url;
unless ($nonstandard) {
@@ -6766,8 +6801,11 @@ sub metadata {
if (($uri eq '') ||
(($uri =~ m|^/*adm/|) &&
($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||
- ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) ||
- ($uri =~ m|home/$match_username/public_html/|)) {
+ ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) ) {
+ return undef;
+ }
+ if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/})
+ && &Apache::lonxml::get_state('target') =~ /^(|meta)$/) {
return undef;
}
my $filename=$uri;
@@ -6788,6 +6826,7 @@ sub metadata {
# if (! exists($metacache{$uri})) {
# $metacache{$uri}={};
# }
+ my $cachetime = 60*60;
if ($liburi) {
$liburi=&declutter($liburi);
$filename=$liburi;
@@ -6798,7 +6837,12 @@ sub metadata {
my %metathesekeys=();
unless ($filename=~/\.meta$/) { $filename.='.meta'; }
my $metastring;
- if ($uri !~ m -^(editupload)/-) {
+ if ($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) {
+ $metastring =
+ &Apache::lonnet::ssi_body(&hreflocation('','/'.$uri),
+ ('grade_target' => 'meta'));
+ $cachetime = 1; # only want this cached in the child not long term
+ } elsif ($uri !~ m -^(editupload)/-) {
my $file=&filelocation('',&clutter($filename));
#push(@{$metaentry{$uri.'.file'}},$file);
$metastring=&getfile($file);
@@ -6965,7 +7009,7 @@ sub metadata {
$metaentry{':keys'} = join(',',keys(%metathesekeys));
&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
- &do_cache_new('meta',$uri,\%metaentry,60*60);
+ &do_cache_new('meta',$uri,\%metaentry,$cachetime);
# this is the end of "was not already recently cached
}
return $metaentry{':'.$what};