version 1.1162, 2012/03/31 23:10:55
|
version 1.1170, 2012/05/18 20:03:22
|
Line 97 use File::MMagic;
|
Line 97 use File::MMagic;
|
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
use LONCAPA::lonmetadata; |
use LONCAPA::lonmetadata; |
|
use LONCAPA::Lond; |
|
|
use File::Copy; |
use File::Copy; |
|
|
Line 1535 sub idput {
|
Line 1536 sub idput {
|
|
|
# ------------------------------dump from db file owned by domainconfig user |
# ------------------------------dump from db file owned by domainconfig user |
sub dump_dom { |
sub dump_dom { |
my ($namespace,$udom,$regexp,$range)=@_; |
my ($namespace, $udom, $regexp) = @_; |
if (!$udom) { |
|
$udom=$env{'user.domain'}; |
$udom ||= $env{'user.domain'}; |
} |
|
my %returnhash; |
return () unless $udom; |
if ($udom) { |
|
my $uname = &get_domainconfiguser($udom); |
return &dump($namespace, $udom, &get_domainconfiguser($udom), $regexp); |
%returnhash = &dump($namespace,$udom,$uname,$regexp,$range); |
|
} |
|
return %returnhash; |
|
} |
} |
|
|
# ------------------------------------------ get items from domain db files |
# ------------------------------------------ get items from domain db files |
Line 2158 sub getsection {
|
Line 2156 sub getsection {
|
# If there is a role which has expired, return it. |
# If there is a role which has expired, return it. |
# |
# |
$courseid = &courseid_to_courseurl($courseid); |
$courseid = &courseid_to_courseurl($courseid); |
my $extra = &freeze_escape({'skipcheck' => 1}); |
my %roleshash = &dump('roles',$udom,$unam,$courseid); |
my %roleshash = &dump('roles',$udom,$unam,$courseid,undef,$extra); |
|
foreach my $key (keys(%roleshash)) { |
foreach my $key (keys(%roleshash)) { |
next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/); |
next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/); |
my $section=$1; |
my $section=$1; |
Line 2443 sub repcopy {
|
Line 2440 sub repcopy {
|
$filename=~s/\/+/\//g; |
$filename=~s/\/+/\//g; |
my $londocroot = $perlvar{'lonDocRoot'}; |
my $londocroot = $perlvar{'lonDocRoot'}; |
if ($filename=~m{^\Q$londocroot/adm/\E}) { return 'ok'; } |
if ($filename=~m{^\Q$londocroot/adm/\E}) { return 'ok'; } |
if ($filename=~m{^\Q$londocroot/lonUsers/\E}) { return 'ok'; } |
if ($filename=~m{^\Q/home/httpd/lonUsers/\E}) { return 'ok'; } |
if ($filename=~m{^\Q$londocroot/userfiles/\E} or |
if ($filename=~m{^\Q$londocroot/userfiles/\E} or |
$filename=~m{^/*(uploaded|editupload)/}) { |
$filename=~m{^/*(uploaded|editupload)/}) { |
return &repcopy_userfile($filename); |
return &repcopy_userfile($filename); |
Line 3033 sub finishuserfileupload {
|
Line 3030 sub finishuserfileupload {
|
sub extract_embedded_items { |
sub extract_embedded_items { |
my ($fullpath,$allfiles,$codebase,$content) = @_; |
my ($fullpath,$allfiles,$codebase,$content) = @_; |
my @state = (); |
my @state = (); |
|
my (%lastids,%related,%shockwave,%flashvars); |
my %javafiles = ( |
my %javafiles = ( |
codebase => '', |
codebase => '', |
code => '', |
code => '', |
Line 3062 sub extract_embedded_items {
|
Line 3060 sub extract_embedded_items {
|
&add_filetype($allfiles,$attr->{'href'},'href'); |
&add_filetype($allfiles,$attr->{'href'},'href'); |
} |
} |
if (lc($tagname) eq 'script') { |
if (lc($tagname) eq 'script') { |
|
my $src; |
if ($attr->{'archive'} =~ /\.jar$/i) { |
if ($attr->{'archive'} =~ /\.jar$/i) { |
&add_filetype($allfiles,$attr->{'archive'},'archive'); |
&add_filetype($allfiles,$attr->{'archive'},'archive'); |
} else { |
} else { |
&add_filetype($allfiles,$attr->{'src'},'src'); |
if ($attr->{'src'} ne '') { |
|
$src = $attr->{'src'}; |
|
&add_filetype($allfiles,$src,'src'); |
|
} |
|
} |
|
my $text = $p->get_trimmed_text(); |
|
if ($text =~ /\Qswfobject.registerObject(\E([^\)]+)\)/) { |
|
my @swfargs = split(/,/,$1); |
|
foreach my $item (@swfargs) { |
|
$item =~ s/["']//g; |
|
$item =~ s/^\s+//; |
|
$item =~ s/\s+$//; |
|
} |
|
if (($swfargs[0] ne'') && ($swfargs[2] ne '')) { |
|
if (ref($related{$swfargs[0]}) eq 'ARRAY') { |
|
push(@{$related{$swfargs[0]}},$swfargs[2]); |
|
} else { |
|
$related{$swfargs[0]} = [$swfargs[2]]; |
|
} |
|
} |
} |
} |
} |
} |
if (lc($tagname) eq 'link') { |
if (lc($tagname) eq 'link') { |
Line 3078 sub extract_embedded_items {
|
Line 3096 sub extract_embedded_items {
|
foreach my $item (keys(%javafiles)) { |
foreach my $item (keys(%javafiles)) { |
$javafiles{$item} = ''; |
$javafiles{$item} = ''; |
} |
} |
|
if ((lc($tagname) eq 'object') && (lc($state[-2]) ne 'object')) { |
|
$lastids{lc($tagname)} = $attr->{'id'}; |
|
} |
} |
} |
if (lc($state[-2]) eq 'object' && lc($tagname) eq 'param') { |
if (lc($state[-2]) eq 'object' && lc($tagname) eq 'param') { |
my $name = lc($attr->{'name'}); |
my $name = lc($attr->{'name'}); |
Line 3087 sub extract_embedded_items {
|
Line 3108 sub extract_embedded_items {
|
last; |
last; |
} |
} |
} |
} |
|
my $pathfrom; |
foreach my $item (keys(%mediafiles)) { |
foreach my $item (keys(%mediafiles)) { |
if ($name eq $item) { |
if ($name eq $item) { |
&add_filetype($allfiles, $attr->{'value'}, 'value'); |
$pathfrom = $attr->{'value'}; |
|
$shockwave{$lastids{lc($state[-2])}} = $pathfrom; |
|
&add_filetype($allfiles,$pathfrom,$name); |
last; |
last; |
} |
} |
} |
} |
|
if ($name eq 'flashvars') { |
|
$flashvars{$lastids{lc($state[-2])}} = $attr->{'value'}; |
|
} |
|
if ($pathfrom ne '') { |
|
&embedded_dependency($allfiles,\%related,$lastids{lc($state[-2])}, |
|
$pathfrom); |
|
} |
} |
} |
if (lc($tagname) eq 'embed' || lc($tagname) eq 'applet') { |
if (lc($tagname) eq 'embed' || lc($tagname) eq 'applet') { |
foreach my $item (keys(%javafiles)) { |
foreach my $item (keys(%javafiles)) { |
Line 3107 sub extract_embedded_items {
|
Line 3138 sub extract_embedded_items {
|
last; |
last; |
} |
} |
} |
} |
|
if (lc($tagname) eq 'embed') { |
|
if (($attr->{'name'} ne '') && ($attr->{'src'} ne '')) { |
|
&embedded_dependency($allfiles,\%related,$attr->{'name'}, |
|
$attr->{'src'}); |
|
} |
|
} |
} |
} |
|
if ($t->[4] =~ m{/>$}) { |
|
pop(@state); |
|
} |
} elsif ($t->[0] eq 'E') { |
} elsif ($t->[0] eq 'E') { |
my ($tagname) = ($t->[1]); |
my ($tagname) = ($t->[1]); |
if ($javafiles{'codebase'} ne '') { |
if ($javafiles{'codebase'} ne '') { |
Line 3127 sub extract_embedded_items {
|
Line 3167 sub extract_embedded_items {
|
pop @state; |
pop @state; |
} |
} |
} |
} |
|
foreach my $id (sort(keys(%flashvars))) { |
|
if ($shockwave{$id} ne '') { |
|
my @pairs = split(/\&/,$flashvars{$id}); |
|
foreach my $pair (@pairs) { |
|
my ($key,$value) = split(/\=/,$pair); |
|
if ($key eq 'thumb') { |
|
&add_filetype($allfiles,$value,$key); |
|
} elsif ($key eq 'content') { |
|
my ($path) = ($shockwave{$id} =~ m{^(.+/)[^/]+$}); |
|
my ($ext) = ($value =~ /\.([^.]+)$/); |
|
if ($ext ne '') { |
|
&add_filetype($allfiles,$path.$value,$ext); |
|
} |
|
} |
|
} |
|
} |
|
} |
return 'ok'; |
return 'ok'; |
} |
} |
|
|
Line 3141 sub add_filetype {
|
Line 3198 sub add_filetype {
|
} |
} |
} |
} |
|
|
|
sub embedded_dependency { |
|
my ($allfiles,$related,$identifier,$pathfrom) = @_; |
|
if ((ref($allfiles) eq 'HASH') && (ref($related) eq 'HASH')) { |
|
if (($identifier ne '') && |
|
(ref($related->{$identifier}) eq 'ARRAY') && |
|
($pathfrom ne '')) { |
|
my ($path) = ($pathfrom =~ m{^(.+/)[^/]+$}); |
|
foreach my $dep (@{$related->{$identifier}}) { |
|
&add_filetype($allfiles,$path.$dep,'object'); |
|
} |
|
} |
|
} |
|
return; |
|
} |
|
|
sub removeuploadedurl { |
sub removeuploadedurl { |
my ($url)=@_; |
my ($url)=@_; |
my (undef,undef,$udom,$uname,$fname)=split('/',$url,5); |
my (undef,undef,$udom,$uname,$fname)=split('/',$url,5); |
Line 3418 sub statslog {
|
Line 3490 sub statslog {
|
|
|
sub userrolelog { |
sub userrolelog { |
my ($trole,$username,$domain,$area,$tstart,$tend)=@_; |
my ($trole,$username,$domain,$area,$tstart,$tend)=@_; |
if (($trole=~/^ca/) || ($trole=~/^aa/) || |
if ( $trole =~ /^(ca|aa|in|cc|ep|cr|ta|co)/ ) { |
($trole=~/^in/) || ($trole=~/^cc/) || |
|
($trole=~/^ep/) || ($trole=~/^cr/) || |
|
($trole=~/^ta/) || ($trole=~/^co/)) { |
|
my (undef,$rudom,$runame,$rsec)=split(/\//,$area); |
my (undef,$rudom,$runame,$rsec)=split(/\//,$area); |
$userrolehash |
$userrolehash |
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} |
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} |
=$tend.':'.$tstart; |
=$tend.':'.$tstart; |
} |
} |
if (($env{'request.role'} =~ /dc\./) && |
if ($env{'request.role'} =~ /dc\./ && $trole =~ /^(au|in|cc|ep|cr|ta|co)/) { |
(($trole=~/^au/) || ($trole=~/^in/) || |
|
($trole=~/^cc/) || ($trole=~/^ep/) || |
|
($trole=~/^cr/) || ($trole=~/^ta/) || |
|
($trole=~/^co/))) { |
|
$userrolehash |
$userrolehash |
{$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'} |
{$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'} |
=$tend.':'.$tstart; |
=$tend.':'.$tstart; |
} |
} |
if (($trole=~/^dc/) || ($trole=~/^ad/) || |
if ($trole =~ /^(dc|ad|li|au|dg|sc)/ ) { |
($trole=~/^li/) || ($trole=~/^li/) || |
|
($trole=~/^au/) || ($trole=~/^dg/) || |
|
($trole=~/^sc/)) { |
|
my (undef,$rudom,$runame,$rsec)=split(/\//,$area); |
my (undef,$rudom,$runame,$rsec)=split(/\//,$area); |
$domainrolehash |
$domainrolehash |
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} |
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} |
Line 3548 sub get_my_roles {
|
Line 3610 sub get_my_roles {
|
unless (defined($udom)) { $udom=$env{'user.domain'}; } |
unless (defined($udom)) { $udom=$env{'user.domain'}; } |
my (%dumphash,%nothide); |
my (%dumphash,%nothide); |
if ($context eq 'userroles') { |
if ($context eq 'userroles') { |
my $extra = &freeze_escape({'skipcheck' => 1}); |
%dumphash = &dump('roles',$udom,$uname); |
%dumphash = &dump('roles',$udom,$uname,'.',undef,$extra); |
|
} else { |
} else { |
%dumphash= |
%dumphash= |
&dump('nohist_userroles',$udom,$uname); |
&dump('nohist_userroles',$udom,$uname); |
Line 4542 sub update_released_required {
|
Line 4603 sub update_released_required {
|
|
|
sub privileged { |
sub privileged { |
my ($username,$domain)=@_; |
my ($username,$domain)=@_; |
my $rolesdump=&reply("dump:$domain:$username:roles", |
|
&homeserver($username,$domain)); |
my %rolesdump = &dump("roles", $domain, $username) or return 0; |
if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || |
my $now = time; |
($rolesdump =~ /^error:/)) { |
|
return 0; |
for my $role (@rolesdump{grep { ! /^rolesdef_/ } keys %rolesdump}) { |
} |
my ($trole, $tend, $tstart) = split(/_/, $role); |
my $now=time; |
if (($trole eq 'dc') || ($trole eq 'su')) { |
if ($rolesdump ne '') { |
return 1 unless ($tend && $tend < $now) |
foreach my $entry (split(/&/,$rolesdump)) { |
or ($tstart && $tstart > $now); |
if ($entry!~/^rolesdef_/) { |
} |
my ($area,$role)=split(/=/,$entry); |
|
$area=~s/\_\w\w$//; |
|
my ($trole,$tend,$tstart)=split(/_/,$role); |
|
if (($trole eq 'dc') || ($trole eq 'su')) { |
|
my $active=1; |
|
if ($tend) { |
|
if ($tend<$now) { $active=0; } |
|
} |
|
if ($tstart) { |
|
if ($tstart>$now) { $active=0; } |
|
} |
|
if ($active) { return 1; } |
|
} |
|
} |
|
} |
} |
} |
|
return 0; |
return 0; |
} |
} |
|
|
# -------------------------------------------------------- Get user privileges |
# -------------------------------------------------------- Get user privileges |
|
|
sub rolesinit { |
sub rolesinit { |
my ($domain,$username,$authhost)=@_; |
my ($domain, $username) = @_; |
my $now=time; |
my %userroles = ('user.login.time' => time); |
my %userroles = ('user.login.time' => $now); |
my %rolesdump = &dump("roles", $domain, $username) or return \%userroles; |
my $extra = &freeze_escape({'skipcheck' => 1}); |
|
my $rolesdump=reply("dump:$domain:$username:roles:.::$extra",$authhost); |
# firstaccess and timerinterval are related to timed maps/resources. |
if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || |
# also, blocking can be triggered by an activating timer |
($rolesdump =~ /^error:/)) { |
# it's saved in the user's %env. |
return \%userroles; |
my %firstaccess = &dump('firstaccesstimes', $domain, $username); |
} |
my %timerinterval = &dump('timerinterval', $domain, $username); |
my %firstaccess = &dump('firstaccesstimes',$domain,$username); |
my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals, |
my %timerinterval = &dump('timerinterval',$domain,$username); |
%timerintchk, %timerintenv); |
my (%coursetimerstarts,%firstaccchk,%firstaccenv, |
|
%coursetimerintervals,%timerintchk,%timerintenv); |
|
foreach my $key (keys(%firstaccess)) { |
foreach my $key (keys(%firstaccess)) { |
my ($cid,$rest) = split(/\0/,$key); |
my ($cid, $rest) = split(/\0/, $key); |
$coursetimerstarts{$cid}{$rest} = $firstaccess{$key}; |
$coursetimerstarts{$cid}{$rest} = $firstaccess{$key}; |
} |
} |
|
|
foreach my $key (keys(%timerinterval)) { |
foreach my $key (keys(%timerinterval)) { |
my ($cid,$rest) = split(/\0/,$key); |
my ($cid,$rest) = split(/\0/,$key); |
$coursetimerintervals{$cid}{$rest} = $timerinterval{$key}; |
$coursetimerintervals{$cid}{$rest} = $timerinterval{$key}; |
} |
} |
|
|
my %allroles=(); |
my %allroles=(); |
my %allgroups=(); |
my %allgroups=(); |
|
|
if ($rolesdump ne '') { |
for my $area (grep { ! /^rolesdef_/ } keys %rolesdump) { |
foreach my $entry (split(/&/,$rolesdump)) { |
my $role = $rolesdump{$area}; |
if ($entry!~/^rolesdef_/) { |
$area =~ s/\_\w\w$//; |
my ($area,$role)=split(/=/,$entry); |
|
$area=~s/\_\w\w$//; |
my ($trole, $tend, $tstart, $group_privs); |
my ($trole,$tend,$tstart,$group_privs); |
|
if ($role=~/^cr/) { |
if ($role =~ /^cr/) { |
if ($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|) { |
# Custom role, defined by a user |
($trole,my $trest)=($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|); |
# e.g., user.role.cr/msu/smith/mynewrole |
($tend,$tstart)=split('_',$trest); |
if ($role =~ m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|) { |
} else { |
$trole = $1; |
$trole=$role; |
($tend, $tstart) = split('_', $2); |
} |
} else { |
} elsif ($role =~ m|^gr/|) { |
$trole = $role; |
($trole,$tend,$tstart) = split(/_/,$role); |
} |
next if ($tstart eq '-1'); |
} elsif ($role =~ m|^gr/|) { |
($trole,$group_privs) = split(/\//,$trole); |
# Role of member in a group, defined within a course/community |
$group_privs = &unescape($group_privs); |
# e.g., user.role.gr/msu/04935610a19ee4a5fmsul1/leopards |
} else { |
($trole, $tend, $tstart) = split(/_/, $role); |
($trole,$tend,$tstart)=split(/_/,$role); |
next if $tstart eq '-1'; |
} |
($trole, $group_privs) = split(/\//, $trole); |
my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain, |
$group_privs = &unescape($group_privs); |
$username); |
} else { |
@userroles{keys(%new_role)} = @new_role{keys(%new_role)}; |
# Just a normal role, defined in roles.tab |
if (($tend!=0) && ($tend<$now)) { $trole=''; } |
($trole, $tend, $tstart) = split(/_/,$role); |
if (($tstart!=0) && ($tstart>$now)) { $trole=''; } |
} |
if (($area ne '') && ($trole ne '')) { |
|
my $spec=$trole.'.'.$area; |
my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain, |
my ($tdummy,$tdomain,$trest)=split(/\//,$area); |
$username); |
if ($trole =~ /^cr\//) { |
@userroles{keys(%new_role)} = @new_role{keys(%new_role)}; |
&custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area); |
|
} elsif ($trole eq 'gr') { |
# role expired or not available yet? |
&group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart); |
$trole = '' if ($tend != 0 && $tend < $userroles{'user.login.time'}) or |
} else { |
($tstart != 0 && $tstart > $userroles{'user.login.time'}); |
&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); |
|
} |
next if $area eq '' or $trole eq ''; |
if ($trole ne 'gr') { |
|
my $cid = $tdomain.'_'.$trest; |
my $spec = "$trole.$area"; |
unless ($firstaccchk{$cid}) { |
my ($tdummy, $tdomain, $trest) = split(/\//, $area); |
if (ref($coursetimerstarts{$cid}) eq 'HASH') { |
|
foreach my $item (keys(%{$coursetimerstarts{$cid}})) { |
if ($trole =~ /^cr\//) { |
$firstaccenv{'course.'.$cid.'.firstaccess.'.$item} = |
# Custom role, defined by a user |
$coursetimerstarts{$cid}{$item}; |
&custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area); |
} |
} elsif ($trole eq 'gr') { |
} |
# Role of a member in a group, defined within a course/community |
$firstaccchk{$cid} = 1; |
&group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart); |
} |
next; |
unless ($timerintchk{$cid}) { |
} else { |
if (ref($coursetimerintervals{$cid}) eq 'HASH') { |
# Normal role, defined in roles.tab |
foreach my $item (keys(%{$coursetimerintervals{$cid}})) { |
&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); |
$timerintenv{'course.'.$cid.'.timerinterval.'.$item} = |
} |
$coursetimerintervals{$cid}{$item}; |
|
} |
my $cid = $tdomain.'_'.$trest; |
} |
unless ($firstaccchk{$cid}) { |
$timerintchk{$cid} = 1; |
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; |
} |
} |
my ($author,$adv) = &set_userprivs(\%userroles,\%allroles,\%allgroups); |
|
$userroles{'user.adv'} = $adv; |
|
$userroles{'user.author'} = $author; |
|
$env{'user.adv'}=$adv; |
|
} |
} |
|
|
|
@userroles{'user.author', 'user.adv'} = &set_userprivs(\%userroles, |
|
\%allroles, \%allgroups); |
|
$env{'user.adv'} = $userroles{'user.adv'}; |
|
|
return (\%userroles,\%firstaccenv,\%timerintenv); |
return (\%userroles,\%firstaccenv,\%timerintenv); |
} |
} |
|
|
Line 4998 sub del {
|
Line 5058 sub del {
|
# -------------------------------------------------------------- dump interface |
# -------------------------------------------------------------- dump interface |
|
|
sub dump { |
sub dump { |
my ($namespace,$udomain,$uname,$regexp,$range,$extra)=@_; |
my ($namespace,$udomain,$uname,$regexp,$range)=@_; |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
my $uhome=&homeserver($uname,$udomain); |
my $uhome=&homeserver($uname,$udomain); |
|
|
if ($regexp) { |
if ($regexp) { |
$regexp=&escape($regexp); |
$regexp=&escape($regexp); |
} else { |
} else { |
$regexp='.'; |
$regexp='.'; |
} |
} |
my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range:$extra",$uhome); |
my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
my %returnhash=(); |
my %returnhash=(); |
if (!($rep =~ /^error/ )) { |
if (!($rep =~ /^error/ )) { |
Line 6365 sub has_comm_blocking {
|
Line 6426 sub has_comm_blocking {
|
); |
); |
my @blockers; |
my @blockers; |
my $now = time; |
my $now = time; |
|
my $navmap = Apache::lonnavmaps::navmap->new(); |
foreach my $block (keys(%commblocks)) { |
foreach my $block (keys(%commblocks)) { |
if ($block =~ /^(\d+)____(\d+)$/) { |
if ($block =~ /^(\d+)____(\d+)$/) { |
my ($start,$end) = ($1,$2); |
my ($start,$end) = ($1,$2); |
Line 6390 sub has_comm_blocking {
|
Line 6452 sub has_comm_blocking {
|
} |
} |
} elsif ($block =~ /^firstaccess____(.+)$/) { |
} elsif ($block =~ /^firstaccess____(.+)$/) { |
my $item = $1; |
my $item = $1; |
|
my @to_test; |
if (ref($commblocks{$block}{'blocks'}) eq 'HASH') { |
if (ref($commblocks{$block}{'blocks'}) eq 'HASH') { |
if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') { |
if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') { |
my $check_interval; |
my $check_interval; |
Line 6403 sub has_comm_blocking {
|
Line 6466 sub has_comm_blocking {
|
if ($item =~ /___\d+___/) { |
if ($item =~ /___\d+___/) { |
$type = 'resource'; |
$type = 'resource'; |
@interval=&EXT("resource.0.interval",$item); |
@interval=&EXT("resource.0.interval",$item); |
|
if (ref($navmap)) { |
|
my $res = $navmap->getBySymb($item); |
|
push(@to_test,$res); |
|
} |
} else { |
} else { |
my $mapsymb = &symbread($item,1); |
my $mapsymb = &symbread($item,1); |
if ($mapsymb) { |
if ($mapsymb) { |
my $navmap = Apache::lonnavmaps::navmap->new(); |
|
if (ref($navmap)) { |
if (ref($navmap)) { |
my $mapres = $navmap->getBySymb($mapsymb); |
my $mapres = $navmap->getBySymb($mapsymb); |
my @resources = $mapres->retrieveResources($mapres,undef,0,1); |
@to_test = $mapres->retrieveResources($mapres,undef,0,1); |
foreach my $res (@resources) { |
foreach my $res (@to_test) { |
my $symb = $res->symb(); |
my $symb = $res->symb(); |
next if ($symb eq $mapsymb); |
next if ($symb eq $mapsymb); |
if ($symb ne '') { |
if ($symb ne '') { |
Line 6434 sub has_comm_blocking {
|
Line 6500 sub has_comm_blocking {
|
if ($first_access) { |
if ($first_access) { |
my $timesup = $first_access+$interval[0]; |
my $timesup = $first_access+$interval[0]; |
if ($timesup > $now) { |
if ($timesup > $now) { |
unless (grep(/^\Q$block\E$/,@blockers)) { |
foreach my $res (@to_test) { |
push(@blockers,$block); |
if ($res->is_problem()) { |
|
if ($res->completable()) { |
|
unless (grep(/^\Q$block\E$/,@blockers)) { |
|
push(@blockers,$block); |
|
} |
|
last; |
|
} |
|
} |
} |
} |
} |
} |
} |
} |
Line 7205 sub get_users_groups {
|
Line 7278 sub get_users_groups {
|
} else { |
} else { |
$grouplist = ''; |
$grouplist = ''; |
my $courseurl = &courseid_to_courseurl($courseid); |
my $courseurl = &courseid_to_courseurl($courseid); |
my $extra = &freeze_escape({'skipcheck' => 1}); |
my %roleshash = &dump('roles',$udom,$uname,$courseurl); |
my %roleshash = &dump('roles',$udom,$uname,$courseurl,undef,$extra); |
|
my $access_end = $env{'course.'.$courseid. |
my $access_end = $env{'course.'.$courseid. |
'.default_enrollment_end_date'}; |
'.default_enrollment_end_date'}; |
my $now = time; |
my $now = time; |
Line 8019 sub generate_coursenum {
|
Line 8091 sub generate_coursenum {
|
} |
} |
|
|
sub is_course { |
sub is_course { |
my ($cdom,$cnum) = @_; |
my ($cdom, $cnum) = scalar(@_) == 1 ? |
my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef, |
($_[0] =~ /^($match_domain)_($match_courseid)$/) : @_; |
undef,'.'); |
|
if (exists($courses{$cdom.'_'.$cnum})) { |
return unless $cdom and $cnum; |
return 1; |
|
} |
my %courses = &courseiddump($cdom, '.', 1, '.', '.', $cnum, undef, undef, |
return 0; |
'.'); |
|
|
|
return unless exists($courses{$cdom.'_'.$cnum}); |
|
return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum; |
} |
} |
|
|
sub store_userdata { |
sub store_userdata { |
Line 10428 sub repcopy_userfile {
|
Line 10503 sub repcopy_userfile {
|
my ($file)=@_; |
my ($file)=@_; |
my $londocroot = $perlvar{'lonDocRoot'}; |
my $londocroot = $perlvar{'lonDocRoot'}; |
if ($file =~ m{^/*(uploaded|editupload)/}) { $file=&filelocation("",$file); } |
if ($file =~ m{^/*(uploaded|editupload)/}) { $file=&filelocation("",$file); } |
if ($file =~ m{^\Q$londocroot/lonUsers/\E}) { return 'ok'; } |
if ($file =~ m{^\Q/home/httpd/lonUsers/\E}) { return 'ok'; } |
my ($cdom,$cnum,$filename) = |
my ($cdom,$cnum,$filename) = |
($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_name)/+(.*)|); |
($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_name)/+(.*)|); |
my $uri="/uploaded/$cdom/$cnum/$filename"; |
my $uri="/uploaded/$cdom/$cnum/$filename"; |
Line 11603 B<idput($udom,%ids)>: store away a list
|
Line 11678 B<idput($udom,%ids)>: store away a list
|
|
|
=item * |
=item * |
X<rolesinit()> |
X<rolesinit()> |
B<rolesinit($udom,$username,$authhost)>: get user privileges |
B<rolesinit($udom,$username)>: get user privileges. |
|
returns user role, first access and timer interval hashes |
|
|
=item * |
=item * |
X<getsection()> |
X<getsection()> |
Line 11896 createcourse($udom,$description,$url,$co
|
Line 11972 createcourse($udom,$description,$url,$co
|
|
|
generate_coursenum($udom,$crstype) : get a unique (unused) course number in domain $udom for course type $crstype (Course or Community). |
generate_coursenum($udom,$crstype) : get a unique (unused) course number in domain $udom for course type $crstype (Course or Community). |
|
|
|
=item * |
|
|
|
is_course($courseid), is_course($cdom, $cnum) |
|
|
|
Accepts either a combined $courseid (in the form of domain_courseid) or the |
|
two component version $cdom, $cnum. It checks if the specified course exists. |
|
|
|
Returns: |
|
undef if the course doesn't exist, otherwise |
|
in scalar context the combined courseid. |
|
in list context the two components of the course identifier, domain and |
|
courseid. |
|
|
=back |
=back |
|
|
=head2 Resource Subroutines |
=head2 Resource Subroutines |