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

Diff for /loncom/lond between versions 1.488 and 1.489.2.1

version 1.488, 2012/04/11 01:07:18 version 1.489.2.1, 2012/05/02 00:30:19
Line 3248  sub dump_profile_database { Line 3248  sub dump_profile_database {
 #                               range       - optional range of entries  #                               range       - optional range of entries
 #                                             e.g., 10-20 would return the  #                                             e.g., 10-20 would return the
 #                                             10th to 19th items, etc.    #                                             10th to 19th items, etc.  
 #                               extra       - optional ref to hash of  
 #                                             additional args. currently  
 #                                             skipcheck is only key used.     
 #   $client                   - Channel open on the client.  #   $client                   - Channel open on the client.
 # Returns:  # Returns:
 #    1    - Continue processing.  #    1    - Continue processing.
Line 3263  sub dump_with_regexp { Line 3260  sub dump_with_regexp {
   
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$uname,$namespace,$regexp,$range,$extra)=split(/:/,$tail);      my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail);
     if (defined($regexp)) {      if (defined($regexp)) {
  $regexp=&unescape($regexp);   $regexp=&unescape($regexp);
     } else {      } else {
Line 3281  sub dump_with_regexp { Line 3278  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 $skipcheck;  
     if ($hashref) {      if ($hashref) {
         my $qresult='';          my $qresult='';
  my $count=0;   my $count=0;
 #  #
 # When dump is for roles.db, determine if LON-CAPA version checking is needed.  # When dump is for roles.db, determine if LON-CAPA version checking is needed.
 # Sessions on 2.10 and later will include skipcheck => 1 in extra args ref,  # Sessions on 2.10 and later do not require version checking, as that occurs
 # to indicate no version checking is needed (in this case, checking occurs  # on the server hosting the user session, when constructing the roles/courses
 # on the server hosting the user session, when constructing the roles/courses   
 # screen).  # screen).
 #   #
         if ($extra ne '') {          my $skipcheck;
             $extra = &Apache::lonnet::thaw_unescape($extra);  
             $skipcheck = $extra->{'skipcheck'};  
         }  
         my @ids = &Apache::lonnet::current_machine_ids();          my @ids = &Apache::lonnet::current_machine_ids();
         my (%homecourses,$major,$minor,$now);          my (%homecourses,$major,$minor,$now);
 #   #
 # If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA     # If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA
 # version on the server which requested the data. For LON-CAPA 2.9, the    # version on the server which requested the data. For LON-CAPA 2.9, the
 # client session will have sent its LON-CAPA version when initiating the  # client session will have sent its LON-CAPA version when initiating the
 # connection. For LON-CAPA 2.8 and older, the version is retrieved from  # connection. For LON-CAPA 2.8 and older, the version is retrieved from
 # the global %loncaparevs in lonnet.pm.  # the global %loncaparevs in lonnet.pm.
 #   # 
         if (($namespace eq 'roles') && (!$skipcheck)) {  # 
           if ($namespace eq 'roles') {
             my $loncaparev = $clientversion;              my $loncaparev = $clientversion;
             if ($loncaparev eq '') {              if ($loncaparev eq '') {
                 $loncaparev = $Apache::lonnet::loncaparevs{$clientname};                  $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
Line 3314  sub dump_with_regexp { Line 3307  sub dump_with_regexp {
                 $major = $1;                  $major = $1;
                 $minor = $2;                  $minor = $2;
             }              }
               if (($major > 2) || (($major == 2) && ($minor > 9))) {
                   $skipcheck = 1;
               }
             $now = time;              $now = time;
         }          }
  while (my ($key,$value) = each(%$hashref)) {   while (my ($key,$value) = each(%$hashref)) {
             if ($namespace eq 'roles') {              if (($namespace eq 'roles') && (!$skipcheck)) {
                 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 ($skipcheck) {                      my ($role,$roleend,$rolestart) = split(/\_/,$value);
                         my ($role,$roleend,$rolestart) = split(/\_/,$value);                      if (!$roleend || $roleend > $now) {
                         if (!$roleend || $roleend > $now) {  
 #  #
 # For active course roles, check that requesting server is running a LON-CAPA  # For active course roles, check that requesting server is running a LON-CAPA
 # version which meets any version requirements for the course. Do not include  # version which meets any version requirements for the course. Do not include
Line 3334  sub dump_with_regexp { Line 3329  sub dump_with_regexp {
 # homeserver is the current server, or whether it is a different server.  # homeserver is the current server, or whether it is a different server.
 # In both cases, the course's version requirement needs to be retrieved.  # In both cases, the course's version requirement needs to be retrieved.
 #   # 
                             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 3365  sub dump_with_regexp { Line 3359  sub dump_with_regexp {
 #  #
             if (($namespace eq 'roles') && (!$skipcheck)) {              if (($namespace eq 'roles') && (!$skipcheck)) {
                 if (keys(%homecourses) > 0) {                  if (keys(%homecourses) > 0) {
                     $qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count,                      $qresult .= &check_homecourses(\%homecourses,$regexp,$count,
                                                    $range,$start,$end,$major,$minor);                                                     $range,$start,$end,$major,$minor);
                 }                  }
             }              }
Line 7517  sub releasereqd_check { Line 7511  sub releasereqd_check {
         if (ref($ids) eq 'ARRAY') {          if (ref($ids) eq 'ARRAY') {
             if (grep(/^\Q$home\E$/,@{$ids})) {              if (grep(/^\Q$home\E$/,@{$ids})) {
                 if (ref($homecourses) eq 'HASH') {                  if (ref($homecourses) eq 'HASH') {
                     if (ref($homecourses->{$hashid}) eq 'ARRAY') {                      if (ref($homecourses->{$cdom}) eq 'HASH') {
                         push(@{$homecourses->{$hashid}},{$key=>$value});                          if (ref($homecourses->{$cdom}{$cnum}) eq 'HASH') {
                               if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
                                   push(@{$homecourses->{$cdom}{$cnum}},{$key=>$value});
                               } else {
                                   $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
                               }
                           } else {
                               $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
                           }
                     } else {                      } else {
                         $homecourses->{$hashid} = [{$key=>$value}];                          $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
                     }                      }
                 }                  }
                 return;                  return;
Line 7595  sub get_courseinfo_hash { Line 7597  sub get_courseinfo_hash {
 #   # 
   
 sub check_homecourses {  sub check_homecourses {
     my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_;      my ($homecourses,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
     my ($result,%addtocache);      my ($result,%addtocache);
     my $yesterday = time - 24*3600;       my $yesterday = time - 24*3600; 
     if (ref($homecourses) eq 'HASH') {      if (ref($homecourses) eq 'HASH') {
         my (%okcourses,%courseinfo,%recent);          my (%okcourses,%courseinfo,%recent);
         my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());          foreach my $domain (keys(%{$homecourses})) {
         if ($hashref) {              my $hashref = 
             while (my ($key,$value) = each(%$hashref)) {                  &tie_domain_hash($domain, "nohist_courseids", &GDBM_WRCREAT());
                 my $unesc_key = &unescape($key);              if (ref($hashref) eq 'HASH') {
                 if ($unesc_key =~ /^lasttime:(\w+)$/) {                  while (my ($key,$value) = each(%$hashref)) {
                     my $cid = $1;                      my $unesc_key = &unescape($key);
                     $cid =~ s/_/:/;                      if ($unesc_key =~ /^lasttime:(\w+)$/) {
                     if ($value > $yesterday ) {                          my $cid = $1;
                         $recent{$cid} = 1;                          $cid =~ s/_/:/;
                           if ($value > $yesterday ) {
                               $recent{$cid} = 1;
                           }
                           next;
                     }                      }
                     next;                      my $items = &Apache::lonnet::thaw_unescape($value);
                 }                      if (ref($items) eq 'HASH') {
                 my $items = &Apache::lonnet::thaw_unescape($value);                          my ($cdom,$cnum) = split(/_/,$unesc_key);
                 if (ref($items) eq 'HASH') {                          my $hashid = $cdom.':'.$cnum; 
                     my $hashid = $unesc_key;                          $courseinfo{$hashid} = $items;
                     $hashid =~ s/_/:/;                          if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
                     $courseinfo{$hashid} = $items;                              my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
                     if (ref($homecourses->{$hashid}) eq 'ARRAY') {                              if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
                         my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});                                 $okcourses{$hashid} = 1;
                         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 for $domain");
                   }
               } else {
                   &logthis("Failed to tie hash for nohist_courseids.db for $domain");
             }              }
             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(%recent)) {          foreach my $hashid (keys(%recent)) {
             my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);              my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
Line 7638  sub check_homecourses { Line 7642  sub check_homecourses {
                 &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);                  &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
             }              }
         }          }
         foreach my $hashid (keys(%{$homecourses})) {          foreach my $cdom (keys(%{$homecourses})) {
             next if ($recent{$hashid});              if (ref($homecourses->{$cdom}) eq 'HASH') {
             &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);                  foreach my $cnum (keys(%{$homecourses->{$cdom}})) {
                       my $hashid = $cdom.':'.$cnum;
                       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') {              my ($cdom,$cnum) = split(/:/,$hashid);
                 foreach my $role (@{$homecourses->{$hashid}}) {              if ((ref($homecourses->{$cdom}) eq 'HASH') &&  
                   (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY')) {
                   foreach my $role (@{$homecourses->{$cdom}{$cnum}}) {
                     if (ref($role) eq 'HASH') {                      if (ref($role) eq 'HASH') {
                         while (my ($key,$value) = each(%{$role})) {                          while (my ($key,$value) = each(%{$role})) {
                             if ($regexp eq '.') {                              if ($regexp eq '.') {
Removed from v.1.488  
changed lines
  Added in v.1.489.2.1

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