Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.650.2.1 and 1.651.2.5

version 1.650.2.1, 2005/08/17 19:18:36 version 1.651.2.5, 2005/09/26 22:16:58
Line 1636  sub courseacclog { Line 1636  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|page)$/) {      if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|task|page)$/) {
         $what.=':POST';          $what.=':POST';
         # FIXME: Probably ought to escape things....          # FIXME: Probably ought to escape things....
  foreach (keys %env) {   foreach (keys %env) {
Line 1709  sub get_course_adv_roles { Line 1709  sub get_course_adv_roles {
  if ($username eq '' || $domain eq '') { next; }   if ($username eq '' || $domain eq '') { next; }
  if ((&privileged($username,$domain)) &&    if ((&privileged($username,$domain)) && 
     (!$nothide{$username.':'.$domain})) { next; }      (!$nothide{$username.':'.$domain})) { next; }
    if ($role eq 'cr') { next; }
         my $key=&plaintext($role);          my $key=&plaintext($role);
    if ($role =~ /^cr/) {
       $key=(split('/',$role))[3];
    }
         if ($section) { $key.=' (Sec/Grp '.$section.')'; }          if ($section) { $key.=' (Sec/Grp '.$section.')'; }
         if ($returnhash{$key}) {          if ($returnhash{$key}) {
     $returnhash{$key}.=','.$username.':'.$domain;      $returnhash{$key}.=','.$username.':'.$domain;
Line 2478  sub rolesinit { Line 2482  sub rolesinit {
           
             my ($trole,$tend,$tstart);              my ($trole,$tend,$tstart);
     if ($role=~/^cr/) {       if ($role=~/^cr/) { 
  ($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|);   if ($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|) {
  ($tend,$tstart)=split('_',$trest);      ($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|);
       ($tend,$tstart)=split('_',$trest);
    } else {
       $trole=$role;
    }
     } else {      } else {
  ($trole,$tend,$tstart)=split(/_/,$role);   ($trole,$tend,$tstart)=split(/_/,$role);
     }      }
Line 4420  sub EXT { Line 4428  sub EXT {
     if ($realm eq 'user') {      if ($realm eq 'user') {
 # --------------------------------------------------------------- user.resource  # --------------------------------------------------------------- user.resource
  if ($space eq 'resource') {   if ($space eq 'resource') {
     if (defined($Apache::lonhomework::parsing_a_problem) ||      if ( (defined($Apache::lonhomework::parsing_a_problem)
  defined($Apache::lonhomework::parsing_a_task)) {    || defined($Apache::lonhomework::parsing_a_task))
    &&
    ($symbparm eq &symbread()) ) {
  return $Apache::lonhomework::history{$qualifierrest};   return $Apache::lonhomework::history{$qualifierrest};
     } else {      } else {
  my %restored;   my %restored;
Line 4850  sub metadata { Line 4860  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*24);   &do_cache_new('meta',$uri,\%metaentry,600);
 # 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};
Line 5885  BEGIN { Line 5895  BEGIN {
   
 sub get_iphost {  sub get_iphost {
     if (%iphost) { return %iphost; }      if (%iphost) { return %iphost; }
       my %name_to_ip;
     foreach my $id (keys(%hostname)) {      foreach my $id (keys(%hostname)) {
  my $name=$hostname{$id};   my $name=$hostname{$id};
  my $ip = gethostbyname($name);   my $ip;
  if (!$ip || length($ip) ne 4) {   if (!exists($name_to_ip{$name})) {
     &logthis("Skipping host $id name $name no IP found\n");      $ip = gethostbyname($name);
     next;      if (!$ip || length($ip) ne 4) {
    &logthis("Skipping host $id name $name no IP found\n");
    next;
       }
       $ip=inet_ntoa($ip);
       $name_to_ip{$name} = $ip;
    } else {
       $ip = $name_to_ip{$name};
  }   }
  $ip=inet_ntoa($ip);  
  push(@{$iphost{$ip}},$id);   push(@{$iphost{$ip}},$id);
     }      }
     return %iphost;      return %iphost;

Removed from v.1.650.2.1  
changed lines
  Added in v.1.651.2.5


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