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

Diff for /loncom/lond between versions 1.450 and 1.454

version 1.450, 2010/07/26 21:52:10 version 1.454, 2010/08/22 19:28:26
Line 1789  sub authenticate_handler { Line 1789  sub authenticate_handler {
         unless ($clientcancheckhost) {          unless ($clientcancheckhost) {
             my $uprimary_id = &Apache::lonnet::domain($udom,'primary');              my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
             my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);              my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
             my @intdoms = &Apache::lonnet::get_internet_names($clientname);                my @intdoms;
               my $internet_names = &Apache::lonnet::get_internet_names($clientname);
               if (ref($internet_names) eq 'ARRAY') {
                   @intdoms = @{$internet_names};
               }
             unless ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {              unless ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
                 my ($remote,$hosted);                  my ($remote,$hosted);
                 my $remotesession = &get_usersession_config($udom,'remotesession');                  my $remotesession = &get_usersession_config($udom,'remotesession');
Line 3171  sub dump_with_regexp { Line 3175  sub dump_with_regexp {
             $clientcheckrole = $extra->{'clientcheckrole'};              $clientcheckrole = $extra->{'clientcheckrole'};
         }          }
         my @ids = &Apache::lonnet::current_machine_ids();          my @ids = &Apache::lonnet::current_machine_ids();
           my (%homecourses,$major,$minor,$now);
           if (($namespace eq 'roles') && (!$clientcheckrole)) {
               my $loncaparev = $clientversion;
               if ($loncaparev eq '') {
                   $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
               }
               if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
                   $major = $1;
                   $minor = $2;
               }
               $now = time;
           }
  while (my ($key,$value) = each(%$hashref)) {   while (my ($key,$value) = each(%$hashref)) {
             if ($namespace eq 'roles') {              if ($namespace eq 'roles') {
                 if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)_(cc|co|in|ta|ep|ad|st|cr)}) {                  if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
                     my $cdom = $1;                      my $cdom = $1;
                     my $cnum = $2;                      my $cnum = $2;
                     unless ($clientcheckrole) {                      unless ($clientcheckrole) {
                         my $home = &Apache::lonnet::homeserver($cnum,$cdom);                          next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,$minor,
                         my $loncaparev = $clientversion;                                                          $now,\%homecourses,\@ids));
                         if ($loncaparev eq '') {  
                             $loncaparev = $Apache::lonnet::loncaparevs{$clientname};  
                         }  
                         my ($major,$minor);  
                         if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\d.\-]+\'?/) {  
                             $major = $1;  
                             $minor = $2;  
                         }  
                         if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_community)_(co|in|ta|ep|ad|st|cr)}) {  
                             if ($major eq '' && $minor eq '') {  
                                 next unless (($home ne 'no_host') && grep(/^\Q$home\E$/,@ids));  
                             }  
                         }  
                         unless ($home eq 'no_host') {  
                             my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);  
                             if (ref($courseinfo) eq 'HASH') {  
                                 if (exists($courseinfo->{'releaserequired'})) {  
                                     my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});  
                                     if ($reqdmajor ne '' && $reqdminor ne '') {  
                                         next if (($major eq '' && $minor eq '') ||  
                                                  ($major < $reqdmajor) ||   
                                                  (($major == $reqdmajor) && ($minor < $reqdminor)));  
                                     }  
                                 }  
                             }  
                         }  
                     }                      }
                 }                  }
             }              }
Line 3224  sub dump_with_regexp { Line 3214  sub dump_with_regexp {
     }      }
  }   }
  if (&untie_user_hash($hashref)) {   if (&untie_user_hash($hashref)) {
               if (($namespace eq 'roles') && (!$clientcheckrole)) {
                   if (keys(%homecourses) > 0) {
                       $qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count,
                                                      $range,$start,$end,$major,$minor);
                   }
               }
     chop($qresult);      chop($qresult);
     &Reply($client, \$qresult, $userinput);      &Reply($client, \$qresult, $userinput);
  } else {   } else {
Line 4682  sub tmp_put_handler { Line 4678  sub tmp_put_handler {
     }      }
     my ($id,$store);      my ($id,$store);
     $tmpsnum++;      $tmpsnum++;
     if ($context eq 'resetpw') {      if (($context eq 'resetpw') || ($context eq 'createaccount')) {
         $id = &md5_hex(&md5_hex(time.{}.rand().$$));          $id = &md5_hex(&md5_hex(time.{}.rand().$$));
     } else {      } else {
         $id = $$.'_'.$clientip.'_'.$tmpsnum;          $id = $$.'_'.$clientip.'_'.$tmpsnum;
Line 7298  sub get_usersession_config { Line 7294  sub get_usersession_config {
     return;      return;
 }  }
   
   sub releasereqd_check {
       my ($cnum,$cdom,$key,$value,$major,$minor,$now,$homecourses,$ids) = @_;
       my $home = &Apache::lonnet::homeserver($cnum,$cdom);
       return if ($home eq 'no_host');
       my ($reqdmajor,$reqdminor,$displayrole);
       if ($cnum =~ /$LONCAPA::match_community/) {
           if ($major eq '' && $minor eq '') {
               return unless ((ref($ids) eq 'ARRAY') && 
                              (grep(/^\Q$home\E$/,@{$ids})));
           } else {
               $reqdmajor = 2;
               $reqdminor = 9;
               return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
           }
       }
       my ($role,$end,$start) = split(/_/,$value);
       if (!$end || $end > $now) {
           my $hashid = $cdom.':'.$cnum;
           my ($courseinfo,$cached) =
               &Apache::lonnet::is_cached_new('courseinfo',$hashid);
           if (defined($cached)) {
               if (ref($courseinfo) eq 'HASH') {
                   if (exists($courseinfo->{'releaserequired'})) {
                       my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                       return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
                   }
               }
           } else {
               if (ref($ids) eq 'ARRAY') {
                   if (grep(/^\Q$home\E$/,@{$ids})) {
                       if (ref($homecourses) eq 'HASH') {
                           if (ref($homecourses->{$hashid}) eq 'ARRAY') {
                               push(@{$homecourses->{$hashid}},{$key=>$value});
                           } else {
                               $homecourses->{$hashid} = [{$key=>$value}];
                           }
                       }
                       return;
                   }
               }
               my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
               if (ref($courseinfo) eq 'HASH') {
                   if (exists($courseinfo->{'releaserequired'})) {
                       my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                       return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
                   }
               }
           }
       }
       return 1;
   }
   
 sub get_courseinfo_hash {  sub get_courseinfo_hash {
     my ($cnum,$cdom,$home) = @_;      my ($cnum,$cdom,$home) = @_;
     my $hashid = $cdom.':'.$cnum;      my $hashid = $cdom.':'.$cnum;
     my ($courseinfo,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);      my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
     if (defined($cached)) {      if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
         return $courseinfo;          return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);
     } else {  
         my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');  
         if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {  
             return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);  
         }  
     }      }
     return;      return;
 }  }
   
   sub check_homecourses {
       my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
       my ($result,%addtocache);
       if (ref($homecourses) eq 'HASH') {
           my %okcourses;
           my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
           if ($hashref) {
               while (my ($key,$value) = each(%$hashref)) {
                   my $unesc_key = &unescape($key);
                   next if ($unesc_key =~ /^lasttime:/);
                   my $items = &Apache::lonnet::thaw_unescape($value);
                   if (ref($items) eq 'HASH') {
                       my $hashid = $unesc_key;
                       $hashid =~ s/_/:/;
                       &Apache::lonnet::do_cache_new('courseinfo',$hashid,$items,600);
                       if (ref($homecourses->{$hashid}) eq 'ARRAY') {
                           my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
                           if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
                               $okcourses{$hashid} = 1;
                           }
                       }
                   }
               }
               unless (&untie_domain_hash($hashref)) {
                   &logthis('Failed to untie tied hash for nohist_courseids.db');
               }
           } else {
               &logthis('Failed to tie hash for nohist_courseids.db');
               return;
           }
           foreach my $hashid (keys(%okcourses)) {
               if (ref($homecourses->{$hashid}) eq 'ARRAY') {
                   foreach my $role (@{$homecourses->{$hashid}}) {
                       if (ref($role) eq 'HASH') {
                           while (my ($key,$value) = each(%{$role})) {
                               if ($regexp eq '.') {
                                   $count++;
                                   if (defined($range) && $count >= $end)   { last; }
                                   if (defined($range) && $count <  $start) { next; }
                                   $result.=$key.'='.$value.'&';
                               } else {
                                   my $unescapeKey = &unescape($key);
                                   if (eval('$unescapeKey=~/$regexp/')) {
                                       $count++;
                                       if (defined($range) && $count >= $end)   { last; }
                                       if (defined($range) && $count <  $start) { next; }
                                       $result.="$key=$value&";
                                   }
                               }
                           }
                       }
                   }
               }
           }
       }
       return $result;
   }
   
   sub useable_role {
       my ($reqdmajor,$reqdminor,$major,$minor) = @_; 
       if ($reqdmajor ne '' && $reqdminor ne '') {
           return if (($major eq '' && $minor eq '') ||
                      ($major < $reqdmajor) ||
                      (($major == $reqdmajor) && ($minor < $reqdminor)));
       }
       return 1;
   }
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
 =head1 NAME  =head1 NAME
Removed from v.1.450  
changed lines
  Added in v.1.454

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