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

Diff for /loncom/lond between versions 1.457 and 1.462

version 1.457, 2010/09/26 14:27:56 version 1.462, 2010/11/02 10:20:35
Line 53  use LONCAPA::lonssl; Line 53  use LONCAPA::lonssl;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use Apache::lonnet;  use Apache::lonnet;
   
 my $DEBUG = 0;       # Non zero to enable debug log entries.  my $DEBUG = 1;       # Non zero to enable debug log entries.
   
 my $status='';  my $status='';
 my $lastlog='';  my $lastlog='';
Line 3202  sub dump_with_regexp { Line 3202  sub dump_with_regexp {
                         if (!$end || $end > $now) {                          if (!$end || $end > $now) {
                             next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,                              next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
                                                             $minor,\%homecourses,\@ids));                                                              $minor,\%homecourses,\@ids));
                           }
                     }                      }
                 }                  }
             }              }
Line 4277  sub put_domain_handler { Line 4278  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 6232  sub logstatus { Line 6234  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 6382  sub make_new_child { Line 6384  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 7363  sub get_courseinfo_hash { Line 7366  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 7390  sub check_homecourses { Line 7401  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.457  
changed lines
  Added in v.1.462

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