[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.456 and 1.463

version 1.456, 2010/09/26 01:50:28 version 1.463, 2010/11/02 10:51:46
Line 1121  sub establish_key_handler { Line 1121  sub establish_key_handler {
 sub load_handler {  sub load_handler {
     my ($cmd, $tail, $replyfd) = @_;      my ($cmd, $tail, $replyfd) = @_;
   
   
   
    # Get the load average from /proc/loadavg and calculate it as a percentage of     # Get the load average from /proc/loadavg and calculate it as a percentage of
    # the allowed load limit as set by the perl global variable lonLoadLim     # the allowed load limit as set by the perl global variable lonLoadLim
   
Line 3198  sub dump_with_regexp { Line 3200  sub dump_with_regexp {
                     my $cdom = $1;                      my $cdom = $1;
                     my $cnum = $2;                      my $cnum = $2;
                     unless ($skipcheck) {                      unless ($skipcheck) {
                         next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,$minor,                          my ($role,$end,$start) = split(/\_/,$value);
                                                         $now,\%homecourses,\@ids));                          if (!$end || $end > $now) {
                               next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
                                                               $minor,\%homecourses,\@ids));
                           }
                     }                      }
                 }                  }
             }              }
Line 4275  sub put_domain_handler { Line 4280  sub put_domain_handler {
 sub get_domain_handler {  sub get_domain_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
   
   
     my $userinput = "$client:$tail";      my $userinput = "$client:$tail";
   
     my ($udom,$namespace,$what)=split(/:/,$tail,3);      my ($udom,$namespace,$what)=split(/:/,$tail,3);
Line 4419  sub get_id_handler { Line 4425  sub get_id_handler {
 sub put_dcmail_handler {  sub put_dcmail_handler {
     my ($cmd,$tail,$client) = @_;      my ($cmd,$tail,$client) = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
                                                                                   
   
     my ($udom,$what)=split(/:/,$tail);      my ($udom,$what)=split(/:/,$tail);
     chomp($what);      chomp($what);
     my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT());      my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT());
Line 6230  sub logstatus { Line 6237  sub logstatus {
 sub initnewstatus {  sub initnewstatus {
     my $docdir=$perlvar{'lonDocRoot'};      my $docdir=$perlvar{'lonDocRoot'};
     my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt");      my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt");
     my $now=time;      my $now=time();
     my $local=localtime($now);      my $local=localtime($now);
     print $fh "LOND status $local - parent $$\n\n";      print $fh "LOND status $local - parent $$\n\n";
     opendir(DIR,"$docdir/lon-status/londchld");      opendir(DIR,"$docdir/lon-status/londchld");
Line 6380  sub make_new_child { Line 6387  sub make_new_child {
             or die "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
         $children{$pid} = $clientip;          $children{$pid} = $clientip;
         &status('Started child '.$pid);          &status('Started child '.$pid);
    close($client);
         return;          return;
     } else {      } else {
         # Child can *not* return from this subroutine.          # Child can *not* return from this subroutine.
Line 7300  sub get_usersession_config { Line 7308  sub get_usersession_config {
 }  }
   
 sub releasereqd_check {  sub releasereqd_check {
     my ($cnum,$cdom,$key,$value,$major,$minor,$now,$homecourses,$ids) = @_;      my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;
     my $home = &Apache::lonnet::homeserver($cnum,$cdom);      my $home = &Apache::lonnet::homeserver($cnum,$cdom);
     return if ($home eq 'no_host');      return if ($home eq 'no_host');
     my ($reqdmajor,$reqdminor,$displayrole);      my ($reqdmajor,$reqdminor,$displayrole);
Line 7314  sub releasereqd_check { Line 7322  sub releasereqd_check {
             return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));              return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
         }          }
     }      }
     my ($role,$end,$start) = split(/_/,$value);      my $hashid = $cdom.':'.$cnum;
     if (!$end || $end > $now) {      my ($courseinfo,$cached) =
         my $hashid = $cdom.':'.$cnum;          &Apache::lonnet::is_cached_new('courseinfo',$hashid);
         my ($courseinfo,$cached) =      if (defined($cached)) {
             &Apache::lonnet::is_cached_new('courseinfo',$hashid);          if (ref($courseinfo) eq 'HASH') {
         if (defined($cached)) {              if (exists($courseinfo->{'releaserequired'})) {
             if (ref($courseinfo) eq 'HASH') {                  my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                 if (exists($courseinfo->{'releaserequired'})) {                  return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
                     my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});  
                     return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));  
                 }  
             }              }
         } else {          }
             if (ref($ids) eq 'ARRAY') {      } else {
                 if (grep(/^\Q$home\E$/,@{$ids})) {          if (ref($ids) eq 'ARRAY') {
                     if (ref($homecourses) eq 'HASH') {              if (grep(/^\Q$home\E$/,@{$ids})) {
                         if (ref($homecourses->{$hashid}) eq 'ARRAY') {                  if (ref($homecourses) eq 'HASH') {
                             push(@{$homecourses->{$hashid}},{$key=>$value});                      if (ref($homecourses->{$hashid}) eq 'ARRAY') {
                         } else {                          push(@{$homecourses->{$hashid}},{$key=>$value});
                             $homecourses->{$hashid} = [{$key=>$value}];                      } else {
                         }                          $homecourses->{$hashid} = [{$key=>$value}];
                     }                      }
                     return;  
                 }                  }
                   return;
             }              }
             my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);          }
             if (ref($courseinfo) eq 'HASH') {          my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
                 if (exists($courseinfo->{'releaserequired'})) {          if (ref($courseinfo) eq 'HASH') {
                     my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});              if (exists($courseinfo->{'releaserequired'})) {
                     return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));                  my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                 }                  return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
             }              }
         }          }
     }      }
Line 7364  sub get_courseinfo_hash { Line 7369  sub get_courseinfo_hash {
 sub check_homecourses {  sub check_homecourses {
     my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_;      my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
     my ($result,%addtocache);      my ($result,%addtocache);
       my $yesterday = time - 24*3600; 
     if (ref($homecourses) eq 'HASH') {      if (ref($homecourses) eq 'HASH') {
         my %okcourses;          my (%okcourses,%courseinfo,%recent);
         my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());          my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
         if ($hashref) {          if ($hashref) {
             while (my ($key,$value) = each(%$hashref)) {              while (my ($key,$value) = each(%$hashref)) {
                 my $unesc_key = &unescape($key);                  my $unesc_key = &unescape($key);
                 next if ($unesc_key =~ /^lasttime:/);                  if ($unesc_key =~ /^lasttime:(\w+)$/) {
                       my $cid = $1;
                       $cid =~ s/_/:/;
                       if ($value > $yesterday ) {
                           $recent{$cid} = 1;
                       }
                       next;
                   }
                 my $items = &Apache::lonnet::thaw_unescape($value);                  my $items = &Apache::lonnet::thaw_unescape($value);
                 if (ref($items) eq 'HASH') {                  if (ref($items) eq 'HASH') {
                     my $hashid = $unesc_key;                      my $hashid = $unesc_key;
                     $hashid =~ s/_/:/;                      $hashid =~ s/_/:/;
                     &Apache::lonnet::do_cache_new('courseinfo',$hashid,$items,600);                      $courseinfo{$hashid} = $items;
                     if (ref($homecourses->{$hashid}) eq 'ARRAY') {                      if (ref($homecourses->{$hashid}) eq 'ARRAY') {
                         my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});                          my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
                         if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {                          if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
Line 7391  sub check_homecourses { Line 7404  sub check_homecourses {
             &logthis('Failed to tie hash for nohist_courseids.db');              &logthis('Failed to tie hash for nohist_courseids.db');
             return;              return;
         }          }
           foreach my $hashid (keys(%recent)) {
               &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
           }
           foreach my $hashid (keys(%{$homecourses})) {
               next if ($recent{$hashid});
               &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
           }
         foreach my $hashid (keys(%okcourses)) {          foreach my $hashid (keys(%okcourses)) {
             if (ref($homecourses->{$hashid}) eq 'ARRAY') {              if (ref($homecourses->{$hashid}) eq 'ARRAY') {
                 foreach my $role (@{$homecourses->{$hashid}}) {                  foreach my $role (@{$homecourses->{$hashid}}) {
Removed from v.1.456  
changed lines
  Added in v.1.463

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