version 1.1142, 2011/11/07 18:27:19
|
version 1.1163, 2012/04/01 16:19:20
|
Line 96 use Math::Random;
|
Line 96 use Math::Random;
|
use File::MMagic; |
use File::MMagic; |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
|
use LONCAPA::lonmetadata; |
|
|
use File::Copy; |
use File::Copy; |
|
|
Line 595 sub transfer_profile_to_env {
|
Line 596 sub transfer_profile_to_env {
|
|
|
# ---------------------------------------------------- Check for valid session |
# ---------------------------------------------------- Check for valid session |
sub check_for_valid_session { |
sub check_for_valid_session { |
my ($r) = @_; |
my ($r,$name) = @_; |
my %cookies=CGI::Cookie->parse($r->header_in('Cookie')); |
my %cookies=CGI::Cookie->parse($r->header_in('Cookie')); |
my $lonid=$cookies{'lonID'}; |
if ($name eq '') { |
|
$name = 'lonID'; |
|
} |
|
my $lonid=$cookies{$name}; |
return undef if (!$lonid); |
return undef if (!$lonid); |
|
|
my $handle=&LONCAPA::clean_handle($lonid->value); |
my $handle=&LONCAPA::clean_handle($lonid->value); |
my $lonidsdir=$r->dir_config('lonIDsDir'); |
my $lonidsdir; |
|
if ($name eq 'lonDAV') { |
|
$lonidsdir=$r->dir_config('lonDAVsessDir'); |
|
} else { |
|
$lonidsdir=$r->dir_config('lonIDsDir'); |
|
} |
return undef if (!-e "$lonidsdir/$handle.id"); |
return undef if (!-e "$lonidsdir/$handle.id"); |
|
|
my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id"); |
my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id"); |
Line 930 sub choose_server {
|
Line 939 sub choose_server {
|
my %domconfhash = &Apache::loncommon::get_domainconf($udom); |
my %domconfhash = &Apache::loncommon::get_domainconf($udom); |
my %servers = &get_servers($udom); |
my %servers = &get_servers($udom); |
my $lowest_load = 30000; |
my $lowest_load = 30000; |
my ($login_host,$hostname,$portal_path); |
my ($login_host,$hostname,$portal_path,$isredirect); |
foreach my $lonhost (keys(%servers)) { |
foreach my $lonhost (keys(%servers)) { |
my $loginvia; |
my $loginvia; |
if ($checkloginvia) { |
if ($checkloginvia) { |
Line 941 sub choose_server {
|
Line 950 sub choose_server {
|
&compare_server_load($server, $login_host, $lowest_load); |
&compare_server_load($server, $login_host, $lowest_load); |
if ($login_host eq $server) { |
if ($login_host eq $server) { |
$portal_path = $path; |
$portal_path = $path; |
|
$isredirect = 1; |
} |
} |
} else { |
} else { |
($login_host, $lowest_load) = |
($login_host, $lowest_load) = |
&compare_server_load($lonhost, $login_host, $lowest_load); |
&compare_server_load($lonhost, $login_host, $lowest_load); |
if ($login_host eq $lonhost) { |
if ($login_host eq $lonhost) { |
$portal_path = ''; |
$portal_path = ''; |
|
$isredirect = ''; |
} |
} |
} |
} |
} else { |
} else { |
Line 957 sub choose_server {
|
Line 968 sub choose_server {
|
if ($login_host ne '') { |
if ($login_host ne '') { |
$hostname = &hostname($login_host); |
$hostname = &hostname($login_host); |
} |
} |
return ($login_host,$hostname,$portal_path); |
return ($login_host,$hostname,$portal_path,$isredirect); |
} |
} |
|
|
# --------------------------------------------- Try to change a user's password |
# --------------------------------------------- Try to change a user's password |
Line 1920 sub get_domain_defaults {
|
Line 1931 sub get_domain_defaults {
|
$domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'}; |
$domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'}; |
$domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'}; |
$domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'}; |
$domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'}; |
$domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'}; |
|
$domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'}; |
} else { |
} else { |
$domdefaults{'lang_def'} = &domain($domain,'lang_def'); |
$domdefaults{'lang_def'} = &domain($domain,'lang_def'); |
$domdefaults{'auth_def'} = &domain($domain,'auth_def'); |
$domdefaults{'auth_def'} = &domain($domain,'auth_def'); |
Line 2798 sub resizeImage {
|
Line 2810 sub resizeImage {
|
# $resizewidth - width (pixels) to which to resize uploaded image |
# $resizewidth - width (pixels) to which to resize uploaded image |
# $resizeheight - height (pixels) to which to resize uploaded image |
# $resizeheight - height (pixels) to which to resize uploaded image |
# $mimetype - reference to scalar to accommodate mime type determined |
# $mimetype - reference to scalar to accommodate mime type determined |
# from File::MMagic if $parser = parse. |
# from File::MMagic. |
# |
# |
# output: url of file in userspace, or error: <message> |
# output: url of file in userspace, or error: <message> |
# or /adm/notfound.html if failure to upload occurse |
# or /adm/notfound.html if failure to upload occurse |
Line 2967 sub finishuserfileupload {
|
Line 2979 sub finishuserfileupload {
|
} |
} |
} |
} |
} |
} |
|
if (($context eq 'coursedoc') || ($parser eq 'parse')) { |
|
if (ref($mimetype)) { |
|
if ($$mimetype eq '') { |
|
my $mm = new File::MMagic; |
|
my $type = $mm->checktype_filename($filepath.'/'.$file); |
|
$$mimetype = $type; |
|
} |
|
} |
|
} |
if ($parser eq 'parse') { |
if ($parser eq 'parse') { |
my $mm = new File::MMagic; |
if ((ref($mimetype)) && ($$mimetype eq 'text/html')) { |
my $type = $mm->checktype_filename($filepath.'/'.$file); |
|
if ($type eq 'text/html') { |
|
my $parse_result = &extract_embedded_items($filepath.'/'.$file, |
my $parse_result = &extract_embedded_items($filepath.'/'.$file, |
$allfiles,$codebase); |
$allfiles,$codebase); |
unless ($parse_result eq 'ok') { |
unless ($parse_result eq 'ok') { |
Line 2978 sub finishuserfileupload {
|
Line 2997 sub finishuserfileupload {
|
' for embedded media: '.$parse_result); |
' for embedded media: '.$parse_result); |
} |
} |
} |
} |
if (ref($mimetype)) { |
|
$$mimetype = $type; |
|
} |
|
} |
} |
if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) { |
if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) { |
my $input = $filepath.'/'.$file; |
my $input = $filepath.'/'.$file; |
Line 3251 sub flushcourselogs {
|
Line 3267 sub flushcourselogs {
|
my $result = &inc('nohist_accesscount',\%temphash,$dom,$name); |
my $result = &inc('nohist_accesscount',\%temphash,$dom,$name); |
if ($result eq 'ok') { |
if ($result eq 'ok') { |
delete $accesshash{$entry}; |
delete $accesshash{$entry}; |
} elsif ($result eq 'unknown_cmd') { |
|
# Target server has old code running on it. |
|
my %temphash=($entry => $value); |
|
if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') { |
|
delete $accesshash{$entry}; |
|
} |
|
} |
} |
} else { |
} else { |
my ($dom,$name) = ($entry=~m{___($match_domain)/($match_name)/(.*)___(\w+)$}); |
my ($dom,$name) = ($entry=~m{___($match_domain)/($match_name)/(.*)___(\w+)$}); |
|
if (($dom eq 'uploaded') || ($dom eq 'adm')) { next; } |
my %temphash=($entry => $accesshash{$entry}); |
my %temphash=($entry => $accesshash{$entry}); |
if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') { |
if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') { |
delete $accesshash{$entry}; |
delete $accesshash{$entry}; |
Line 3338 sub courseacclog {
|
Line 3349 sub courseacclog {
|
my $fnsymb=shift; |
my $fnsymb=shift; |
unless ($env{'request.course.id'}) { return ''; } |
unless ($env{'request.course.id'}) { return ''; } |
my $what=$fnsymb.':'.$env{'user.name'}.':'.$env{'user.domain'}; |
my $what=$fnsymb.':'.$env{'user.name'}.':'.$env{'user.domain'}; |
if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|task|page)$/) { |
if ($fnsymb=~/$LONCAPA::assess_re/) { |
$what.=':POST'; |
$what.=':POST'; |
# FIXME: Probably ought to escape things.... |
# FIXME: Probably ought to escape things.... |
foreach my $key (keys(%env)) { |
foreach my $key (keys(%env)) { |
Line 3370 sub countacc {
|
Line 3381 sub countacc {
|
my $url=&declutter(shift); |
my $url=&declutter(shift); |
return if (! defined($url) || $url eq ''); |
return if (! defined($url) || $url eq ''); |
unless ($env{'request.course.id'}) { return ''; } |
unless ($env{'request.course.id'}) { return ''; } |
|
# |
|
# Mark that this url was used in this course |
|
# |
$accesshash{$env{'request.course.id'}.'___'.$url.'___course'}=1; |
$accesshash{$env{'request.course.id'}.'___'.$url.'___course'}=1; |
|
# |
|
# Increase the access count for this resource in this child process |
|
# |
my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count'; |
my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count'; |
$accesshash{$key}++; |
$accesshash{$key}++; |
} |
} |
Line 3382 sub linklog {
|
Line 3399 sub linklog {
|
$accesshash{$from.'___'.$to.'___comefrom'}=1; |
$accesshash{$from.'___'.$to.'___comefrom'}=1; |
$accesshash{$to.'___'.$from.'___goto'}=1; |
$accesshash{$to.'___'.$from.'___goto'}=1; |
} |
} |
|
|
|
sub statslog { |
|
my ($symb,$part,$users,$av_attempts,$degdiff)=@_; |
|
if ($users<2) { return; } |
|
my %dynstore=&LONCAPA::lonmetadata::dynamic_metadata_storage({ |
|
'course' => $env{'request.course.id'}, |
|
'sections' => '"all"', |
|
'num_students' => $users, |
|
'part' => $part, |
|
'symb' => $symb, |
|
'mean_tries' => $av_attempts, |
|
'deg_of_diff' => $degdiff}); |
|
foreach my $key (keys(%dynstore)) { |
|
$accesshash{$key}=$dynstore{$key}; |
|
} |
|
} |
|
|
sub userrolelog { |
sub userrolelog { |
my ($trole,$username,$domain,$area,$tstart,$tend)=@_; |
my ($trole,$username,$domain,$area,$tstart,$tend)=@_; |
Line 3537 sub get_my_roles {
|
Line 3570 sub get_my_roles {
|
foreach my $entry (keys(%dumphash)) { |
foreach my $entry (keys(%dumphash)) { |
my ($role,$tend,$tstart); |
my ($role,$tend,$tstart); |
if ($context eq 'userroles') { |
if ($context eq 'userroles') { |
|
next if ($entry =~ /^rolesdef/); |
($role,$tend,$tstart)=split(/_/,$dumphash{$entry}); |
($role,$tend,$tstart)=split(/_/,$dumphash{$entry}); |
} else { |
} else { |
($tend,$tstart)=split(/\:/,$dumphash{$entry}); |
($tend,$tstart)=split(/\:/,$dumphash{$entry}); |
Line 3850 sub get_domain_roles {
|
Line 3884 sub get_domain_roles {
|
|
|
# ----------------------------------------------------------- Interval timing |
# ----------------------------------------------------------- Interval timing |
|
|
|
{ |
|
# Caches needed for speedup of navmaps |
|
# We don't want to cache this for very long at all (5 seconds at most) |
|
# |
|
# The user for whom we cache |
|
my $cachedkey=''; |
|
# The cached times for this user |
|
my %cachedtimes=(); |
|
# When this was last done |
|
my $cachedtime=(); |
|
|
|
sub load_all_first_access { |
|
my ($uname,$udom)=@_; |
|
if (($cachedkey eq $uname.':'.$udom) && |
|
(abs($cachedtime-time)<5)) { |
|
return; |
|
} |
|
$cachedtime=time; |
|
$cachedkey=$uname.':'.$udom; |
|
%cachedtimes=&dump('firstaccesstimes',$udom,$uname); |
|
} |
|
|
sub get_first_access { |
sub get_first_access { |
my ($type,$argsymb)=@_; |
my ($type,$argsymb,$argmap)=@_; |
my ($symb,$courseid,$udom,$uname)=&whichuser(); |
my ($symb,$courseid,$udom,$uname)=&whichuser(); |
if ($argsymb) { $symb=$argsymb; } |
if ($argsymb) { $symb=$argsymb; } |
my ($map,$id,$res)=&decode_symb($symb); |
my ($map,$id,$res)=&decode_symb($symb); |
|
if ($argmap) { $map = $argmap; } |
if ($type eq 'course') { |
if ($type eq 'course') { |
$res='course'; |
$res='course'; |
} elsif ($type eq 'map') { |
} elsif ($type eq 'map') { |
Line 3862 sub get_first_access {
|
Line 3919 sub get_first_access {
|
} else { |
} else { |
$res=$symb; |
$res=$symb; |
} |
} |
my %times=&get('firstaccesstimes',["$courseid\0$res"],$udom,$uname); |
&load_all_first_access($uname,$udom); |
return $times{"$courseid\0$res"}; |
return $cachedtimes{"$courseid\0$res"}; |
} |
} |
|
|
sub set_first_access { |
sub set_first_access { |
my ($type)=@_; |
my ($type,$interval)=@_; |
my ($symb,$courseid,$udom,$uname)=&whichuser(); |
my ($symb,$courseid,$udom,$uname)=&whichuser(); |
my ($map,$id,$res)=&decode_symb($symb); |
my ($map,$id,$res)=&decode_symb($symb); |
if ($type eq 'course') { |
if ($type eq 'course') { |
Line 3877 sub set_first_access {
|
Line 3934 sub set_first_access {
|
} else { |
} else { |
$res=$symb; |
$res=$symb; |
} |
} |
my $firstaccess=&get_first_access($type,$symb); |
$cachedkey=''; |
|
my $firstaccess=&get_first_access($type,$symb,$map); |
if (!$firstaccess) { |
if (!$firstaccess) { |
return &put('firstaccesstimes',{"$courseid\0$res"=>time},$udom,$uname); |
my $start = time; |
|
my $putres = &put('firstaccesstimes',{"$courseid\0$res"=>$start}, |
|
$udom,$uname); |
|
if ($putres eq 'ok') { |
|
&put('timerinterval',{"$courseid\0$res"=>$interval}, |
|
$udom,$uname); |
|
&appenv( |
|
{ |
|
'course.'.$courseid.'.firstaccess.'.$res => $start, |
|
'course.'.$courseid.'.timerinterval.'.$res => $interval, |
|
} |
|
); |
|
} |
|
return $putres; |
} |
} |
return 'already_set'; |
return 'already_set'; |
} |
} |
|
} |
# --------------------------------------------- Set Expire Date for Spreadsheet |
# --------------------------------------------- Set Expire Date for Spreadsheet |
|
|
sub expirespread { |
sub expirespread { |
Line 4512 sub rolesinit {
|
Line 4583 sub rolesinit {
|
($rolesdump =~ /^error:/)) { |
($rolesdump =~ /^error:/)) { |
return \%userroles; |
return \%userroles; |
} |
} |
|
my %firstaccess = &dump('firstaccesstimes',$domain,$username); |
|
my %timerinterval = &dump('timerinterval',$domain,$username); |
|
my (%coursetimerstarts,%firstaccchk,%firstaccenv, |
|
%coursetimerintervals,%timerintchk,%timerintenv); |
|
foreach my $key (keys(%firstaccess)) { |
|
my ($cid,$rest) = split(/\0/,$key); |
|
$coursetimerstarts{$cid}{$rest} = $firstaccess{$key}; |
|
} |
|
foreach my $key (keys(%timerinterval)) { |
|
my ($cid,$rest) = split(/\0/,$key); |
|
$coursetimerintervals{$cid}{$rest} = $timerinterval{$key}; |
|
} |
my %allroles=(); |
my %allroles=(); |
my %allgroups=(); |
my %allgroups=(); |
|
|
if ($rolesdump ne '') { |
if ($rolesdump ne '') { |
foreach my $entry (split(/&/,$rolesdump)) { |
foreach my $entry (split(/&/,$rolesdump)) { |
Line 4551 sub rolesinit {
|
Line 4634 sub rolesinit {
|
} else { |
} else { |
&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); |
&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); |
} |
} |
|
if ($trole ne 'gr') { |
|
my $cid = $tdomain.'_'.$trest; |
|
unless ($firstaccchk{$cid}) { |
|
if (ref($coursetimerstarts{$cid}) eq 'HASH') { |
|
foreach my $item (keys(%{$coursetimerstarts{$cid}})) { |
|
$firstaccenv{'course.'.$cid.'.firstaccess.'.$item} = |
|
$coursetimerstarts{$cid}{$item}; |
|
} |
|
} |
|
$firstaccchk{$cid} = 1; |
|
} |
|
unless ($timerintchk{$cid}) { |
|
if (ref($coursetimerintervals{$cid}) eq 'HASH') { |
|
foreach my $item (keys(%{$coursetimerintervals{$cid}})) { |
|
$timerintenv{'course.'.$cid.'.timerinterval.'.$item} = |
|
$coursetimerintervals{$cid}{$item}; |
|
} |
|
} |
|
$timerintchk{$cid} = 1; |
|
} |
|
} |
} |
} |
} |
} |
} |
} |
Line 4559 sub rolesinit {
|
Line 4663 sub rolesinit {
|
$userroles{'user.author'} = $author; |
$userroles{'user.author'} = $author; |
$env{'user.adv'}=$adv; |
$env{'user.adv'}=$adv; |
} |
} |
return \%userroles; |
return (\%userroles,\%firstaccenv,\%timerintenv); |
} |
} |
|
|
sub set_arearole { |
sub set_arearole { |
Line 5940 sub allowed {
|
Line 6044 sub allowed {
|
if ($match) { |
if ($match) { |
if ($env{'user.priv.'.$env{'request.role'}.'./'} |
if ($env{'user.priv.'.$env{'request.role'}.'./'} |
=~/\Q$priv\E\&([^\:]*)/) { |
=~/\Q$priv\E\&([^\:]*)/) { |
$thisallowed.=$1; |
my @blockers = &has_comm_blocking($priv,$symb,$uri); |
|
if (@blockers > 0) { |
|
$thisallowed = 'B'; |
|
} else { |
|
$thisallowed.=$1; |
|
} |
} |
} |
} else { |
} else { |
my $refuri = $env{'httpref.'.$orguri} || $env{'httpref.'.$ver_orguri}; |
my $refuri = $env{'httpref.'.$orguri} || $env{'httpref.'.$ver_orguri}; |
Line 5951 sub allowed {
|
Line 6060 sub allowed {
|
$refuri=&declutter($refuri); |
$refuri=&declutter($refuri); |
my ($match) = &is_on_map($refuri); |
my ($match) = &is_on_map($refuri); |
if ($match) { |
if ($match) { |
$thisallowed='F'; |
my @blockers = &has_comm_blocking($priv,$symb,$refuri); |
|
if (@blockers > 0) { |
|
$thisallowed = 'B'; |
|
} else { |
|
$thisallowed='F'; |
|
} |
} |
} |
} |
} |
} |
} |
Line 6003 sub allowed {
|
Line 6117 sub allowed {
|
$statecond=$cond; |
$statecond=$cond; |
if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid} |
if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid} |
=~/\Q$priv\E\&([^\:]*)/) { |
=~/\Q$priv\E\&([^\:]*)/) { |
$thisallowed.=$1; |
my $value = $1; |
|
if ($priv eq 'bre') { |
|
my @blockers = &has_comm_blocking($priv,$symb,$uri); |
|
if (@blockers > 0) { |
|
$thisallowed = 'B'; |
|
} else { |
|
$thisallowed.=$value; |
|
} |
|
} else { |
|
$thisallowed.=$value; |
|
} |
$checkreferer=0; |
$checkreferer=0; |
} |
} |
} |
} |
Line 6031 sub allowed {
|
Line 6155 sub allowed {
|
my $refstatecond=$cond; |
my $refstatecond=$cond; |
if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid} |
if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid} |
=~/\Q$priv\E\&([^\:]*)/) { |
=~/\Q$priv\E\&([^\:]*)/) { |
$thisallowed.=$1; |
my $value = $1; |
|
if ($priv eq 'bre') { |
|
my @blockers = &has_comm_blocking($priv,$symb,$refuri); |
|
if (@blockers > 0) { |
|
$thisallowed = 'B'; |
|
} else { |
|
$thisallowed.=$value; |
|
} |
|
} else { |
|
$thisallowed.=$value; |
|
} |
$uri=$refuri; |
$uri=$refuri; |
$statecond=$refstatecond; |
$statecond=$refstatecond; |
} |
} |
Line 6190 sub allowed {
|
Line 6324 sub allowed {
|
} |
} |
return 'F'; |
return 'F'; |
} |
} |
|
|
|
sub get_comm_blocks { |
|
my ($cdom,$cnum) = @_; |
|
if ($cdom eq '' || $cnum eq '') { |
|
return unless ($env{'request.course.id'}); |
|
$cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; |
|
$cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
|
} |
|
my %commblocks; |
|
my $hashid=$cdom.'_'.$cnum; |
|
my ($blocksref,$cached)=&is_cached_new('comm_block',$hashid); |
|
if ((defined($cached)) && (ref($blocksref) eq 'HASH')) { |
|
%commblocks = %{$blocksref}; |
|
} else { |
|
%commblocks = &Apache::lonnet::dump('comm_block',$cdom,$cnum); |
|
my $cachetime = 600; |
|
&do_cache_new('comm_block',$hashid,\%commblocks,$cachetime); |
|
} |
|
return %commblocks; |
|
} |
|
|
|
sub has_comm_blocking { |
|
my ($priv,$symb,$uri,$blocks) = @_; |
|
return unless ($env{'request.course.id'}); |
|
return unless ($priv eq 'bre'); |
|
return if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/); |
|
my %commblocks; |
|
if (ref($blocks) eq 'HASH') { |
|
%commblocks = %{$blocks}; |
|
} else { |
|
%commblocks = &get_comm_blocks(); |
|
} |
|
return unless (keys(%commblocks) > 0); |
|
if (!$symb) { $symb=&symbread($uri,1); } |
|
my ($map,$resid,undef)=&decode_symb($symb); |
|
my %tocheck = ( |
|
maps => $map, |
|
resources => $symb, |
|
); |
|
my @blockers; |
|
my $now = time; |
|
my $navmap = Apache::lonnavmaps::navmap->new(); |
|
foreach my $block (keys(%commblocks)) { |
|
if ($block =~ /^(\d+)____(\d+)$/) { |
|
my ($start,$end) = ($1,$2); |
|
if ($start <= $now && $end >= $now) { |
|
if (ref($commblocks{$block}{'blocks'}) eq 'HASH') { |
|
if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') { |
|
if (ref($commblocks{$block}{'blocks'}{'docs'}{'maps'}) eq 'HASH') { |
|
if ($commblocks{$block}{'blocks'}{'docs'}{'maps'}{$map}) { |
|
unless (grep(/^\Q$block\E$/,@blockers)) { |
|
push(@blockers,$block); |
|
} |
|
} |
|
} |
|
if (ref($commblocks{$block}{'blocks'}{'docs'}{'resources'}) eq 'HASH') { |
|
if ($commblocks{$block}{'blocks'}{'docs'}{'resources'}{$symb}) { |
|
unless (grep(/^\Q$block\E$/,@blockers)) { |
|
push(@blockers,$block); |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} elsif ($block =~ /^firstaccess____(.+)$/) { |
|
my $item = $1; |
|
my @to_test; |
|
if (ref($commblocks{$block}{'blocks'}) eq 'HASH') { |
|
if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') { |
|
my $check_interval; |
|
if (&check_docs_block($commblocks{$block}{'blocks'}{'docs'},\%tocheck)) { |
|
my @interval; |
|
my $type = 'map'; |
|
if ($item eq 'course') { |
|
$type = 'course'; |
|
@interval=&EXT("resource.0.interval"); |
|
} else { |
|
if ($item =~ /___\d+___/) { |
|
$type = 'resource'; |
|
@interval=&EXT("resource.0.interval",$item); |
|
if (ref($navmap)) { |
|
my $res = $navmap->getBySymb($item); |
|
push(@to_test,$res); |
|
} |
|
} else { |
|
my $mapsymb = &symbread($item,1); |
|
if ($mapsymb) { |
|
if (ref($navmap)) { |
|
my $mapres = $navmap->getBySymb($mapsymb); |
|
@to_test = $mapres->retrieveResources($mapres,undef,0,1); |
|
foreach my $res (@to_test) { |
|
my $symb = $res->symb(); |
|
next if ($symb eq $mapsymb); |
|
if ($symb ne '') { |
|
@interval=&EXT("resource.0.interval",$symb); |
|
last; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
if ($interval[0] =~ /\d+/) { |
|
my $first_access; |
|
if ($type eq 'resource') { |
|
$first_access=&get_first_access($interval[1],$item); |
|
} elsif ($type eq 'map') { |
|
$first_access=&get_first_access($interval[1],undef,$item); |
|
} else { |
|
$first_access=&get_first_access($interval[1]); |
|
} |
|
if ($first_access) { |
|
my $timesup = $first_access+$interval[0]; |
|
if ($timesup > $now) { |
|
foreach my $res (@to_test) { |
|
if ($res->is_problem()) { |
|
if ($res->completable()) { |
|
unless (grep(/^\Q$block\E$/,@blockers)) { |
|
push(@blockers,$block); |
|
} |
|
last; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
return @blockers; |
|
} |
|
|
|
sub check_docs_block { |
|
my ($docsblock,$tocheck) =@_; |
|
if ((ref($docsblock) ne 'HASH') || (ref($tocheck) ne 'HASH')) { |
|
return; |
|
} |
|
if (ref($docsblock->{'maps'}) eq 'HASH') { |
|
if ($tocheck->{'maps'}) { |
|
if ($docsblock->{'maps'}{$tocheck->{'maps'}}) { |
|
return 1; |
|
} |
|
} |
|
} |
|
if (ref($docsblock->{'resources'}) eq 'HASH') { |
|
if ($tocheck->{'resources'}) { |
|
if ($docsblock->{'resources'}{$tocheck->{'resources'}}) { |
|
return 1; |
|
} |
|
} |
|
} |
|
return; |
|
} |
|
|
# |
# |
# Removes the versino from a URI and |
# Removes the versino from a URI and |
# splits it in to its filename and path to the filename. |
# splits it in to its filename and path to the filename. |
Line 7514 sub modify_student_enrollment {
|
Line 7806 sub modify_student_enrollment {
|
$uid = $tmp{'id'} if (!defined($uid) || $uid eq ''); |
$uid = $tmp{'id'} if (!defined($uid) || $uid eq ''); |
} |
} |
my $fullname = &format_name($first,$middle,$last,$gene,'lastname'); |
my $fullname = &format_name($first,$middle,$last,$gene,'lastname'); |
|
my $user = "$uname:$udom"; |
|
my %old_entry = &Apache::lonnet::get('classlist',[$user],$cdom,$cnum); |
my $reply=cput('classlist', |
my $reply=cput('classlist', |
{"$uname:$udom" => |
{$user => |
join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype) }, |
join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype) }, |
$cdom,$cnum); |
$cdom,$cnum); |
unless (($reply eq 'ok') || ($reply eq 'delayed')) { |
if (($reply eq 'ok') || ($reply eq 'delayed')) { |
|
&devalidate_getsection_cache($udom,$uname,$cid); |
|
} else { |
return 'error: '.$reply; |
return 'error: '.$reply; |
} else { |
|
&devalidate_getsection_cache($udom,$uname,$cid); |
|
} |
} |
# Add student role to user |
# Add student role to user |
my $uurl='/'.$cid; |
my $uurl='/'.$cid; |
Line 7529 sub modify_student_enrollment {
|
Line 7823 sub modify_student_enrollment {
|
if ($usec) { |
if ($usec) { |
$uurl.='/'.$usec; |
$uurl.='/'.$usec; |
} |
} |
return &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,$selfenroll,$context); |
my $result = &assignrole($udom,$uname,$uurl,'st',$end,$start,undef, |
|
$selfenroll,$context); |
|
if ($result ne 'ok') { |
|
if ($old_entry{$user} ne '') { |
|
$reply = &cput('classlist',\%old_entry,$cdom,$cnum); |
|
} else { |
|
$reply = &del('classlist',[$user],$cdom,$cnum); |
|
} |
|
} |
|
return $result; |
} |
} |
|
|
sub format_name { |
sub format_name { |
Line 8709 sub EXT {
|
Line 9012 sub EXT {
|
} elsif ($realm eq 'request') { |
} elsif ($realm eq 'request') { |
# ------------------------------------------------------------- request.browser |
# ------------------------------------------------------------- request.browser |
if ($space eq 'browser') { |
if ($space eq 'browser') { |
if ($qualifier eq 'textremote') { |
return $env{'browser.'.$qualifier}; |
if (&Apache::lonlocal::mt('textual_remote_display') eq 'on') { |
|
return 1; |
|
} else { |
|
return 0; |
|
} |
|
} else { |
|
return $env{'browser.'.$qualifier}; |
|
} |
|
# ------------------------------------------------------------ request.filename |
# ------------------------------------------------------------ request.filename |
} else { |
} else { |
return $env{'request.'.$spacequalifierrest}; |
return $env{'request.'.$spacequalifierrest}; |
Line 9362 sub gettitle {
|
Line 9657 sub gettitle {
|
} |
} |
$title=~s/\&colon\;/\:/gs; |
$title=~s/\&colon\;/\:/gs; |
if ($title) { |
if ($title) { |
|
# Remember both $symb and $title for dynamic metadata |
|
$accesshash{$symb.'___crstitle'}=$title; |
|
$accesshash{&declutter($map).'___'.&declutter($url).'___usage'}=time; |
|
# Cache this title and then return it |
return &do_cache_new('title',$key,$title,600); |
return &do_cache_new('title',$key,$title,600); |
} |
} |
$urlsymb=$url; |
$urlsymb=$url; |
Line 9394 sub get_slot {
|
Line 9693 sub get_slot {
|
} |
} |
return $slotinfo{$which}; |
return $slotinfo{$which}; |
} |
} |
|
|
|
sub get_reservable_slots { |
|
my ($cnum,$cdom,$uname,$udom) = @_; |
|
my $now = time; |
|
my $reservable_info; |
|
my $key=join("\0",'reservableslots',$cdom,$cnum,$uname,$udom); |
|
if (exists($remembered{$key})) { |
|
$reservable_info = $remembered{$key}; |
|
} else { |
|
my %resv; |
|
($resv{'now_order'},$resv{'now'},$resv{'future_order'},$resv{'future'}) = |
|
&Apache::loncommon::get_future_slots($cnum,$cdom,$now); |
|
$reservable_info = \%resv; |
|
$remembered{$key} = $reservable_info; |
|
} |
|
return $reservable_info; |
|
} |
|
|
|
sub get_course_slots { |
|
my ($cnum,$cdom) = @_; |
|
my $hashid=$cnum.':'.$cdom; |
|
my ($result,$cached) = &Apache::lonnet::is_cached_new('allslots',$hashid); |
|
if (defined($cached)) { |
|
if (ref($result) eq 'HASH') { |
|
return %{$result}; |
|
} |
|
} else { |
|
my %slots=&Apache::lonnet::dump('slots',$cdom,$cnum); |
|
my ($tmp) = keys(%slots); |
|
if ($tmp !~ /^(con_lost|error|no_such_host)/i) { |
|
&Apache::lonnet::do_cache_new('allslots',$hashid,\%slots,600); |
|
return %slots; |
|
} |
|
} |
|
return; |
|
} |
|
|
|
sub devalidate_slots_cache { |
|
my ($cnum,$cdom)=@_; |
|
my $hashid=$cnum.':'.$cdom; |
|
&devalidate_cache_new('allslots',$hashid); |
|
} |
|
|
# ------------------------------------------------- Update symbolic store links |
# ------------------------------------------------- Update symbolic store links |
|
|
sub symblist { |
sub symblist { |
Line 9759 sub rndseed {
|
Line 10101 sub rndseed {
|
if (!defined($symb)) { |
if (!defined($symb)) { |
unless ($symb=$wsymb) { return time; } |
unless ($symb=$wsymb) { return time; } |
} |
} |
if (!$courseid) { $courseid=$wcourseid; } |
if (!defined $courseid) { |
if (!$domain) { $domain=$wdomain; } |
$courseid=$wcourseid; |
if (!$username) { $username=$wusername } |
} |
|
if (!defined $domain) { $domain=$wdomain; } |
|
if (!defined $username) { $username=$wusername } |
|
|
my $which; |
my $which; |
if (defined($cenv->{'rndseed'})) { |
if (defined($cenv->{'rndseed'})) { |
Line 9769 sub rndseed {
|
Line 10113 sub rndseed {
|
} else { |
} else { |
$which =&get_rand_alg($courseid); |
$which =&get_rand_alg($courseid); |
} |
} |
|
|
if (defined(&getCODE())) { |
if (defined(&getCODE())) { |
|
|
if ($which eq '64bit5') { |
if ($which eq '64bit5') { |
Line 10276 sub hreflocation {
|
Line 10619 sub hreflocation {
|
if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) { |
if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) { |
$file=~s-^\Q$perlvar{'lonDocRoot'}\E--; |
$file=~s-^\Q$perlvar{'lonDocRoot'}\E--; |
} elsif ($file=~m-^\Q$perlvar{'lonUsersDir'}\E-) { |
} elsif ($file=~m-^\Q$perlvar{'lonUsersDir'}\E-) { |
$file=~s{^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/ |
$file=~s{^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/} |
-/uploaded/$1/$2/-x; |
{/uploaded/$1/$2/}x; |
} |
} |
if ($file=~ m{^/userfiles/}) { |
if ($file=~ m{^/userfiles/}) { |
$file =~ s{^/userfiles/}{/uploaded/}; |
$file =~ s{^/userfiles/}{/uploaded/}; |