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

Diff for /loncom/lond between versions 1.449 and 1.452

version 1.449, 2010/07/22 22:08:06 version 1.452, 2010/08/18 19:25:09
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 3144  sub dump_with_regexp { Line 3148  sub dump_with_regexp {
   
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail);      my ($udom,$uname,$namespace,$regexp,$range,$extra)=split(/:/,$tail);
     if (defined($regexp)) {      if (defined($regexp)) {
  $regexp=&unescape($regexp);   $regexp=&unescape($regexp);
     } else {      } else {
Line 3162  sub dump_with_regexp { Line 3166  sub dump_with_regexp {
     }      }
     my $hashref = &tie_user_hash($udom, $uname, $namespace,      my $hashref = &tie_user_hash($udom, $uname, $namespace,
  &GDBM_READER());   &GDBM_READER());
       my $clientcheckrole;
     if ($hashref) {      if ($hashref) {
         my $qresult='';          my $qresult='';
  my $count=0;   my $count=0;
           if ($extra ne '') {
               $extra = &Apache::lonnet::thaw_unescape($extra);
               $clientcheckrole = $extra->{'clientcheckrole'};
           }
           my @ids = &Apache::lonnet::current_machine_ids();
  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_community)_(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;
                     if ($clientversion =~ /^\'?(\d+)\.(\d+)/) {                      unless ($clientcheckrole) {
                         my $major = $1;                          my $home = &Apache::lonnet::homeserver($cnum,$cdom);
                         my $minor = $2;                          my $loncaparev = $clientversion;
                         next if (($major < 2) || (($major == 2) && ($minor < 9)));                          if ($loncaparev eq '') {
                     } else {                              $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
                         my $homeserver = &Apache::lonnet::homeserver($cnum,$cdom);                          }
                         next unless ($currenthostid eq $homeserver);                          my ($major,$minor);
                           if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
                               $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 7268  sub get_usersession_config { Line 7300  sub get_usersession_config {
         }          }
     }      }
     return;      return;
   }
   
   sub get_courseinfo_hash {
       my ($cnum,$cdom,$home) = @_;
       my $hashid = $cdom.':'.$cnum;
       my ($courseinfo,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
       if (defined($cached)) {
           return $courseinfo;
       } 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;
 }  }
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
Removed from v.1.449  
changed lines
  Added in v.1.452

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