Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.462 and 1.470

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 {

Removed from v.1.462  
changed lines
  Added in v.1.470


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>