[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.550 and 1.551

version 1.550, 2004/10/06 09:48:39 version 1.551, 2004/10/12 20:51:54
Line 39  qw(%perlvar %hostname %homecache %badSer Line 39  qw(%perlvar %hostname %homecache %badSer
    %libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache     %libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache
    %courselogs %accesshash %userrolehash $processmarker $dumpcount      %courselogs %accesshash %userrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseresdatacache      %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseresdatacache 
    %userresdatacache %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def      %userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def 
    %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir);     %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir);
   
 use IO::Socket;  use IO::Socket;
Line 798  sub getsection { Line 798  sub getsection {
     my ($udom,$unam,$courseid)=@_;      my ($udom,$unam,$courseid)=@_;
     $courseid=~s/\_/\//g;      $courseid=~s/\_/\//g;
     $courseid=~s/^(\w)/\/$1/;      $courseid=~s/^(\w)/\/$1/;
   
       my $hashid="$udom:$unam:$courseid";
       my ($result,$cached)=&is_cached(\%getsectioncache,$hashid,'getsection');
       if (defined($cached)) { return $result; }
   
     my %Pending;       my %Pending; 
     my %Expired;      my %Expired;
     #      #
Line 830  sub getsection { Line 835  sub getsection {
             $Pending{$start}=$section;              $Pending{$start}=$section;
             next;              next;
         }          }
         return $section;          return &do_cache(\%getsectioncache,$hashid,$section,'getsection');
     }      }
     #      #
     # Presumedly there will be few matching roles from the above      # Presumedly there will be few matching roles from the above
     # loop and the sorting time will be negligible.      # loop and the sorting time will be negligible.
     if (scalar(keys(%Pending))) {      if (scalar(keys(%Pending))) {
         my ($time) = sort {$a <=> $b} keys(%Pending);          my ($time) = sort {$a <=> $b} keys(%Pending);
         return $Pending{$time};          return &do_cache(\%getsectioncache,$hashid,$Pending{$time},'getsection');
     }       } 
     if (scalar(keys(%Expired))) {      if (scalar(keys(%Expired))) {
         my @sorted = sort {$a <=> $b} keys(%Expired);          my @sorted = sort {$a <=> $b} keys(%Expired);
         my $time = pop(@sorted);          my $time = pop(@sorted);
         return $Expired{$time};          return &do_cache(\%getsectioncache,$hashid,$Expired{$time},'getsection');
     }      }
     return '-1';      return &do_cache(\%getsectioncache,$hashid,'-1','getsection');
 }  }
   
   
Line 1035  EVALBLOCK Line 1040  EVALBLOCK
 #    &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime));  #    &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime));
 }  }
   
 sub usection {  
     my ($udom,$unam,$courseid)=@_;  
     my $hashid="$udom:$unam:$courseid";  
       
     my ($result,$cached)=&is_cached(\%usectioncache,$hashid,'usection');  
     if (defined($cached)) { return $result; }  
     $courseid=~s/\_/\//g;  
     $courseid=~s/^(\w)/\/$1/;  
     foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',  
                         &homeserver($unam,$udom)))) {  
         my ($key,$value)=split(/\=/,$_);  
         $key=&unescape($key);  
         if ($key=~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/) {  
             my $section=$1;  
             if ($key eq $courseid.'_st') { $section=''; }  
     my ($dummy,$end,$start)=split(/\_/,&unescape($value));  
             my $now=time;  
             my $notactive=0;  
             if ($start) {  
  if ($now<$start) { $notactive=1; }  
             }  
             if ($end) {  
                 if ($now>$end) { $notactive=1; }  
             }   
             unless ($notactive) {  
  return &do_cache(\%usectioncache,$hashid,$section,'usection');  
     }  
         }  
     }  
     return &do_cache(\%usectioncache,$hashid,'-1','usection');  
 }  
   
 # ------------------------------------- Read an entry from a user's environment  # ------------------------------------- Read an entry from a user's environment
   
 sub userenvironment {  sub userenvironment {
Line 4142  sub EXT { Line 4115  sub EXT {
  $section=$ENV{'request.course.sec'};   $section=$ENV{'request.course.sec'};
     } else {      } else {
  if (! defined($usection)) {   if (! defined($usection)) {
     $section=&usection($udom,$uname,$courseid);      $section=&getsection($udom,$uname,$courseid);
  } else {   } else {
     $section = $usection;      $section = $usection;
  }   }
Line 5298  sub goodbye { Line 5271  sub goodbye {
    &logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache)));     &logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache)));
 #1.1 only  #1.1 only
    &logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache)));     &logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache)));
    &logthis(sprintf("%-20s is %s",'%usectioncache',scalar(%usectioncache)));     &logthis(sprintf("%-20s is %s",'%getsectioncache',scalar(%getsectioncache)));
    &logthis(sprintf("%-20s is %s",'%courseresversioncache',scalar(%courseresversioncache)));     &logthis(sprintf("%-20s is %s",'%courseresversioncache',scalar(%courseresversioncache)));
    &logthis(sprintf("%-20s is %s",'%resversioncache',scalar(%resversioncache)));     &logthis(sprintf("%-20s is %s",'%resversioncache',scalar(%resversioncache)));
    &flushcourselogs();     &flushcourselogs();
Line 5680  X<rolesinit()> Line 5653  X<rolesinit()>
 B<rolesinit($udom,$username,$authhost)>: get user privileges  B<rolesinit($udom,$username,$authhost)>: get user privileges
   
 =item *  =item *
 X<usection()>  X<getsection()>
 B<usection($udom,$uname,$cname)>: finds the section of student in the  B<getsection($udom,$uname,$cname)>: finds the section of student in the
 course $cname, return section name/number or '' for "not in course"  course $cname, return section name/number or '' for "not in course"
 and '-1' for "no section"  and '-1' for "no section"
   
Removed from v.1.550  
changed lines
  Added in v.1.551

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