version 1.462, 2004/01/13 16:33:37
|
version 1.470, 2004/02/02 20:21:25
|
Line 1424 sub userrolelog {
|
Line 1424 sub userrolelog {
|
my ($trole,$username,$domain,$area,$tstart,$tend)=@_; |
my ($trole,$username,$domain,$area,$tstart,$tend)=@_; |
if (($trole=~/^ca/) || ($trole=~/^in/) || |
if (($trole=~/^ca/) || ($trole=~/^in/) || |
($trole=~/^cc/) || ($trole=~/^ep/) || |
($trole=~/^cc/) || ($trole=~/^ep/) || |
($trole=~/^cr/)) { |
($trole=~/^cr/) || ($trole=~/^ta/)) { |
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} |
Line 1436 sub get_course_adv_roles {
|
Line 1436 sub get_course_adv_roles {
|
my $cid=shift; |
my $cid=shift; |
$cid=$ENV{'request.course.id'} unless (defined($cid)); |
$cid=$ENV{'request.course.id'} unless (defined($cid)); |
my %coursehash=&coursedescription($cid); |
my %coursehash=&coursedescription($cid); |
|
my %nothide=(); |
|
foreach (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) { |
|
$nothide{join(':',split(/[\@\:]/,$_))}=1; |
|
} |
my %returnhash=(); |
my %returnhash=(); |
my %dumphash= |
my %dumphash= |
&dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'}); |
&dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'}); |
Line 1446 sub get_course_adv_roles {
|
Line 1450 sub get_course_adv_roles {
|
if (($tend) && ($tend<$now)) { next; } |
if (($tend) && ($tend<$now)) { next; } |
if (($tstart) && ($now<$tstart)) { next; } |
if (($tstart) && ($now<$tstart)) { next; } |
my ($role,$username,$domain,$section)=split(/\:/,$_); |
my ($role,$username,$domain,$section)=split(/\:/,$_); |
|
if ((&privileged($username,$domain)) && |
|
(!$nothide{$username.':'.$domain})) { next; } |
my $key=&plaintext($role); |
my $key=&plaintext($role); |
if ($section) { $key.=' (Sec/Grp '.$section.')'; } |
if ($section) { $key.=' (Sec/Grp '.$section.')'; } |
if ($returnhash{$key}) { |
if ($returnhash{$key}) { |
Line 3821 sub packages_tab_default {
|
Line 3827 sub packages_tab_default {
|
my $packages=&metadata($uri,'packages'); |
my $packages=&metadata($uri,'packages'); |
foreach my $package (split(/,/,$packages)) { |
foreach my $package (split(/,/,$packages)) { |
my ($pack_type,$pack_part)=split(/_/,$package,2); |
my ($pack_type,$pack_part)=split(/_/,$package,2); |
if ($pack_part eq $part) { |
if (defined($packagetab{"$pack_type&$name&default"})) { |
return $packagetab{"$pack_type&$name&default"}; |
return $packagetab{"$pack_type&$name&default"}; |
} |
} |
|
if (defined($packagetab{$pack_type."_".$pack_part."&$name&default"})) { |
|
return $packagetab{$pack_type."_".$pack_part."&$name&default"}; |
|
} |
} |
} |
return undef; |
return undef; |
} |
} |
Line 3853 sub metadata {
|
Line 3862 sub metadata {
|
if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) || |
if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) || |
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) || |
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) || |
($uri =~ m|home/[^/]+/public_html/|)) { |
($uri =~ m|home/[^/]+/public_html/|)) { |
return ''; |
return undef; |
} |
} |
my $filename=$uri; |
my $filename=$uri; |
$uri=~s/\.meta$//; |
$uri=~s/\.meta$//; |
Line 4457 sub filelocation {
|
Line 4466 sub filelocation {
|
$location=$file; |
$location=$file; |
} else { |
} else { |
$file=~s/^$perlvar{'lonDocRoot'}//; |
$file=~s/^$perlvar{'lonDocRoot'}//; |
$file=~s:^/*res::; |
$file=~s:^/res/:/:; |
if ( !( $file =~ m:^/:) ) { |
if ( !( $file =~ m:^/:) ) { |
$location = $dir. '/'.$file; |
$location = $dir. '/'.$file; |
} else { |
} else { |
Line 4484 sub hreflocation {
|
Line 4493 sub hreflocation {
|
return $file; |
return $file; |
} |
} |
|
|
|
sub current_machine_domains { |
|
my $hostname=$hostname{$perlvar{'lonHostID'}}; |
|
my @domains; |
|
while( my($id, $name) = each(%hostname)) { |
|
# &logthis("-$id-$name-$hostname-"); |
|
if ($hostname eq $name) { |
|
push(@domains,$hostdom{$id}); |
|
} |
|
} |
|
return @domains; |
|
} |
|
|
|
sub current_machine_ids { |
|
my $hostname=$hostname{$perlvar{'lonHostID'}}; |
|
my @ids; |
|
while( my($id, $name) = each(%hostname)) { |
|
# &logthis("-$id-$name-$hostname-"); |
|
if ($hostname eq $name) { |
|
push(@ids,$id); |
|
} |
|
} |
|
return @ids; |
|
} |
|
|
# ------------------------------------------------------------- Declutters URLs |
# ------------------------------------------------------------- Declutters URLs |
|
|
sub declutter { |
sub declutter { |