version 1.918, 2007/10/03 19:57:26
|
version 1.924, 2007/11/13 22:19:53
|
Line 1047 sub get_instuser {
|
Line 1047 sub get_instuser {
|
} |
} |
|
|
sub inst_rulecheck { |
sub inst_rulecheck { |
my ($udom,$uname,$rules) = @_; |
my ($udom,$uname,$id,$item,$rules) = @_; |
my %returnhash; |
my %returnhash; |
if ($udom ne '') { |
if ($udom ne '') { |
if (ref($rules) eq 'ARRAY') { |
if (ref($rules) eq 'ARRAY') { |
Line 1055 sub inst_rulecheck {
|
Line 1055 sub inst_rulecheck {
|
my $rulestr = join(':',@{$rules}); |
my $rulestr = join(':',@{$rules}); |
my $homeserver=&domain($udom,'primary'); |
my $homeserver=&domain($udom,'primary'); |
if (($homeserver ne '') && ($homeserver ne 'no_host')) { |
if (($homeserver ne '') && ($homeserver ne 'no_host')) { |
my $response=&unescape(&reply('instrulecheck:'.&escape($udom).':'. |
my $response; |
&escape($uname).':'.$rulestr, |
if ($item eq 'username') { |
|
$response=&unescape(&reply('instrulecheck:'.&escape($udom). |
|
':'.&escape($uname).':'.$rulestr, |
$homeserver)); |
$homeserver)); |
|
} elsif ($item eq 'id') { |
|
$response=&unescape(&reply('instidrulecheck:'.&escape($udom). |
|
':'.&escape($id).':'.$rulestr, |
|
$homeserver)); |
|
} |
if ($response ne 'refused') { |
if ($response ne 'refused') { |
my @pairs=split(/\&/,$response); |
my @pairs=split(/\&/,$response); |
foreach my $item (@pairs) { |
foreach my $item (@pairs) { |
Line 1074 sub inst_rulecheck {
|
Line 1081 sub inst_rulecheck {
|
} |
} |
|
|
sub inst_userrules { |
sub inst_userrules { |
my ($udom) = @_; |
my ($udom,$check) = @_; |
my (%ruleshash,@ruleorder); |
my (%ruleshash,@ruleorder); |
if ($udom ne '') { |
if ($udom ne '') { |
my $homeserver=&domain($udom,'primary'); |
my $homeserver=&domain($udom,'primary'); |
if (($homeserver ne '') && ($homeserver ne 'no_host')) { |
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); |
$homeserver); |
|
} else { |
|
$response=&reply('instuserrules:'.&escape($udom), |
|
$homeserver); |
|
} |
if (($response ne 'refused') && ($response ne 'error') && |
if (($response ne 'refused') && ($response ne 'error') && |
|
($response ne 'unknown_cmd') && |
($response ne 'no_such_host')) { |
($response ne 'no_such_host')) { |
my ($hashitems,$orderitems) = split(/:/,$response); |
my ($hashitems,$orderitems) = split(/:/,$response); |
my @pairs=split(/\&/,$hashitems); |
my @pairs=split(/\&/,$hashitems); |
Line 1383 sub do_cache_new {
|
Line 1397 sub do_cache_new {
|
$memcache->disconnect_all(); |
$memcache->disconnect_all(); |
} |
} |
# need to make a copy of $value |
# need to make a copy of $value |
#&make_room($id,$value,$debug); |
&make_room($id,$value,$debug); |
return $value; |
return $value; |
} |
} |
|
|
sub make_room { |
sub make_room { |
my ($id,$value,$debug)=@_; |
my ($id,$value,$debug)=@_; |
$remembered{$id}=$value; |
|
|
$remembered{$id}= (ref($value)) ? &Storable::dclone($value) |
|
: $value; |
if ($to_remember<0) { return; } |
if ($to_remember<0) { return; } |
$accessed{$id}=[&gettimeofday()]; |
$accessed{$id}=[&gettimeofday()]; |
if (scalar(keys(%remembered)) <= $to_remember) { return; } |
if (scalar(keys(%remembered)) <= $to_remember) { return; } |
Line 2170 sub flushcourselogs {
|
Line 2186 sub flushcourselogs {
|
# times and course titles for all courseids |
# times and course titles for all courseids |
# |
# |
my %courseidbuffer=(); |
my %courseidbuffer=(); |
foreach my $crsid (keys %courselogs) { |
foreach my $crsid (keys(%courselogs)) { |
if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'. |
if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'. |
&escape($courselogs{$crsid}), |
&escape($courselogs{$crsid}), |
$coursehombuf{$crsid}) eq 'ok') { |
$coursehombuf{$crsid}) eq 'ok') { |
Line 2183 sub flushcourselogs {
|
Line 2199 sub flushcourselogs {
|
delete $courselogs{$crsid}; |
delete $courselogs{$crsid}; |
} |
} |
} |
} |
$courseidbuffer{$coursehombuf{$crsid}}{$crsid} = ( |
$courseidbuffer{$coursehombuf{$crsid}}{$crsid} = { |
'description' => &escape($coursedescrbuf{$crsid}), |
'description' => &escape($coursedescrbuf{$crsid}), |
'instcode' => &escape($courseinstcodebuf{$crsid}), |
'inst_code' => &escape($courseinstcodebuf{$crsid}), |
'type' => &escape($coursetypebuf{$crsid}), |
'type' => &escape($coursetypebuf{$crsid}), |
'owner' => &escape($courseownerbuf{$crsid}), |
'owner' => &escape($courseownerbuf{$crsid}), |
); |
}; |
} |
} |
# |
# |
# Write course id database (reverse lookup) to homeserver of courses |
# Write course id database (reverse lookup) to homeserver of courses |
Line 2196 sub flushcourselogs {
|
Line 2212 sub flushcourselogs {
|
# |
# |
foreach my $crs_home (keys(%courseidbuffer)) { |
foreach my $crs_home (keys(%courseidbuffer)) { |
my $response = &courseidput(&host_domain($crs_home), |
my $response = &courseidput(&host_domain($crs_home), |
$courseidbuffer{$crs_home},$crs_home); |
$courseidbuffer{$crs_home}, |
|
$crs_home,'timeonly'); |
} |
} |
# |
# |
# File accesses |
# File accesses |
Line 2460 sub get_my_roles {
|
Line 2477 sub get_my_roles {
|
} |
} |
if (ref($roles) eq 'ARRAY') { |
if (ref($roles) eq 'ARRAY') { |
if (!grep(/^\Q$role\E$/,@{$roles})) { |
if (!grep(/^\Q$role\E$/,@{$roles})) { |
next; |
if ($role =~ /^cr\//) { |
|
if (!grep(/^cr$/,@{$roles})) { |
|
next; |
|
} |
|
} else { |
|
next; |
|
} |
} |
} |
} |
} |
$returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend; |
$returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend; |
Line 2502 sub getannounce {
|
Line 2525 sub getannounce {
|
# |
# |
|
|
sub courseidput { |
sub courseidput { |
my ($domain,$storehash,$coursehome)=@_; |
my ($domain,$storehash,$coursehome,$caller) = @_; |
my $items=''; |
my $outcome; |
my $now = time; |
if ($caller eq 'timeonly') { |
foreach my $item (keys(%$storehash)) { |
my $cids = ''; |
$storehash->{$item}{'lasttime'} = $now; |
foreach my $item (keys(%$storehash)) { |
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
$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') { |
if ($outcome eq 'unknown_cmd') { |
my $what; |
my $what; |
foreach my $cid (keys(%$storehash)) { |
foreach my $cid (keys(%$storehash)) { |
$what .= &escape($cid).'='; |
$what .= &escape($cid).'='; |
foreach my $item ('description','instcode','owner','type') { |
foreach my $item ('description','inst_code','owner','type') { |
$what .= $storehash->{$item}.':'; |
$what .= &escape($storehash->{$item}).':'; |
} |
} |
$what =~ s/\:$/&/; |
$what =~ s/\:$/&/; |
} |
} |
Line 2528 sub courseidput {
|
Line 2562 sub courseidput {
|
} |
} |
|
|
sub courseiddump { |
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 $as_hash = 1; |
my %returnhash; |
my %returnhash; |
if (!$domfilter) { $domfilter=''; } |
if (!$domfilter) { $domfilter=''; } |
Line 2545 sub courseiddump {
|
Line 2580 sub courseiddump {
|
$sincefilter.':'.&escape($descfilter).':'. |
$sincefilter.':'.&escape($descfilter).':'. |
&escape($instcodefilter).':'.&escape($ownerfilter). |
&escape($instcodefilter).':'.&escape($ownerfilter). |
':'.&escape($coursefilter).':'.&escape($typefilter). |
':'.&escape($coursefilter).':'.&escape($typefilter). |
':'.&escape($regexp_ok).':'.$as_hash,$tryserver); |
':'.&escape($regexp_ok).':'.$as_hash,$tryserver); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
foreach my $item (@pairs) { |
foreach my $item (@pairs) { |
my ($key,$value)=split(/\=/,$item,2); |
my ($key,$value)=split(/\=/,$item,2); |
Line 2555 sub courseiddump {
|
Line 2590 sub courseiddump {
|
if (ref($result) eq 'HASH') { |
if (ref($result) eq 'HASH') { |
$returnhash{$key}=$result; |
$returnhash{$key}=$result; |
} else { |
} else { |
my @responses = split(/:/,$result); |
my @responses = split(/:/,$value); |
my @items = ('description','instcode','owner','type'); |
my @items = ('description','inst_code','owner','type'); |
for (my $i=0; $i<@responses; $i++) { |
for (my $i=0; $i<@responses; $i++) { |
$returnhash{$key}{$items[$i]} = $responses[$i]; |
$returnhash{$key}{$items[$i]} = &unescape($responses[$i]); |
} |
} |
} |
} |
} |
} |
Line 2606 sub get_domain_roles {
|
Line 2641 sub get_domain_roles {
|
if (undef($enddate) || $enddate eq '') { |
if (undef($enddate) || $enddate eq '') { |
$enddate = '.'; |
$enddate = '.'; |
} |
} |
my $rolelist = join(':',@{$roles}); |
my $rolelist; |
|
if (ref($roles) eq 'ARRAY') { |
|
$rolelist = join(':',@{$roles}); |
|
} |
my %personnel = (); |
my %personnel = (); |
|
|
my %servers = &get_servers($dom,'library'); |
my %servers = &get_servers($dom,'library'); |
Line 5546 sub createcourse {
|
Line 5584 sub createcourse {
|
# log existence |
# log existence |
my $newcourse = { |
my $newcourse = { |
$udom.'_'.$uname => { |
$udom.'_'.$uname => { |
description => &escape($description), |
description => $description, |
inst_code => &escape($inst_code), |
inst_code => $inst_code, |
owner => &escape($course_owner), |
owner => $course_owner, |
type => &escape($crstype), |
type => $crstype, |
}, |
}, |
}; |
}; |
&courseidput($udom,$newcourse); |
&courseidput($udom,$newcourse,$uhome,'notime'); |
&flushcourselogs(); |
|
# set toplevel url |
# set toplevel url |
my $topurl=$url; |
my $topurl=$url; |
unless ($nonstandard) { |
unless ($nonstandard) { |
Line 6764 sub metadata {
|
Line 6801 sub metadata {
|
if (($uri eq '') || |
if (($uri eq '') || |
(($uri =~ m|^/*adm/|) && |
(($uri =~ m|^/*adm/|) && |
($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) || |
($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) || |
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) || |
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) ) { |
($uri =~ m|home/$match_username/public_html/|)) { |
return undef; |
|
} |
|
if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) |
|
&& &Apache::lonxml::get_state('target') =~ /^(|meta)$/) { |
return undef; |
return undef; |
} |
} |
my $filename=$uri; |
my $filename=$uri; |
Line 6786 sub metadata {
|
Line 6826 sub metadata {
|
# if (! exists($metacache{$uri})) { |
# if (! exists($metacache{$uri})) { |
# $metacache{$uri}={}; |
# $metacache{$uri}={}; |
# } |
# } |
|
my $cachetime = 60*60; |
if ($liburi) { |
if ($liburi) { |
$liburi=&declutter($liburi); |
$liburi=&declutter($liburi); |
$filename=$liburi; |
$filename=$liburi; |
Line 6796 sub metadata {
|
Line 6837 sub metadata {
|
my %metathesekeys=(); |
my %metathesekeys=(); |
unless ($filename=~/\.meta$/) { $filename.='.meta'; } |
unless ($filename=~/\.meta$/) { $filename.='.meta'; } |
my $metastring; |
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)); |
my $file=&filelocation('',&clutter($filename)); |
#push(@{$metaentry{$uri.'.file'}},$file); |
#push(@{$metaentry{$uri.'.file'}},$file); |
$metastring=&getfile($file); |
$metastring=&getfile($file); |
Line 6963 sub metadata {
|
Line 7009 sub metadata {
|
$metaentry{':keys'} = join(',',keys(%metathesekeys)); |
$metaentry{':keys'} = join(',',keys(%metathesekeys)); |
&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); |
&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); |
$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys); |
$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 |
# this is the end of "was not already recently cached |
} |
} |
return $metaentry{':'.$what}; |
return $metaentry{':'.$what}; |