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

Diff for /loncom/lond between versions 1.383 and 1.384

version 1.383, 2007/10/03 19:57:23 version 1.384, 2007/10/06 04:32:23
Line 3305  sub put_course_id_handler { Line 3305  sub put_course_id_handler {
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
             my ($key,$courseinfo) = split(/=/,$pair,2);              my ($key,$courseinfo) = split(/=/,$pair,2);
             $courseinfo =~ s/=/:/g;              $courseinfo =~ s/=/:/g;
             if (ref($hashref) eq 'HASH') {              if (defined($hashref->{$key})) {
                 my @items = ('description','inst_code','owner','type');                  my $value = &Apache::lonnet::thaw_unescape($hashref->{$key});
                 my @new_items = split(/:/,$courseinfo,-1);                  if (ref($value) eq 'HASH') {
                 for (my $i=0; $i<@new_items; $i++) {                      my @items = ('description','inst_code','owner','type');
                     $hashref->{$key}{$items[$i]} = $new_items[$i];                      my @new_items = split(/:/,$courseinfo,-1);
                 }                      my %storehash; 
                 $hashref->{$key}{'lasttime'} = $now;                      for (my $i=0; $i<@new_items; $i++) {
             } else {                          $storehash{$items[$i]} = $new_items[$i];
                 my @current_items = split(/:/,$hashref->{$key},-1);                      }
                 shift(@current_items); # remove description                      $hashref->{$key} = 
                 pop(@current_items);   # remove last access                          &Apache::lonnet::freeze_escape(\%storehash);
                 my $numcurrent = scalar(@current_items);                      my $unesc_key = &unescape($key);
                 if ($numcurrent > 3) {                      $hashref->{&escape('lasttime:'.$unesc_key)} = $now;
                     $numcurrent = 3;                      next;
                 }                  }
                 my @new_items = split(/:/,$courseinfo,-1);              }
                 my $numnew = scalar(@new_items);              my @current_items = split(/:/,$hashref->{$key},-1);
                 if ($numcurrent > 0) {              shift(@current_items); # remove description
                     if ($numnew <= $numcurrent) { # flushcourselogs() from pre 2.2               pop(@current_items);   # remove last access
                         for (my $j=$numcurrent-$numnew; $j>=0; $j--) {              my $numcurrent = scalar(@current_items);
                             $courseinfo .= ':'.$current_items[$numcurrent-$j-1];              if ($numcurrent > 3) {
                         }                  $numcurrent = 3;
               }
               my @new_items = split(/:/,$courseinfo,-1);
               my $numnew = scalar(@new_items);
               if ($numcurrent > 0) {
                   if ($numnew <= $numcurrent) { # flushcourselogs() from pre 2.2 
                       for (my $j=$numcurrent-$numnew; $j>=0; $j--) {
                           $courseinfo .= ':'.$current_items[$numcurrent-$j-1];
                     }                      }
                 }                  }
                 $hashref->{$key}=$courseinfo.':'.$now;  
             }              }
               $hashref->{$key}=$courseinfo.':'.$now;
  }   }
  if (&untie_domain_hash($hashref)) {   if (&untie_domain_hash($hashref)) {
     &Reply( $client, "ok\n", $userinput);      &Reply( $client, "ok\n", $userinput);
Line 3352  sub put_course_id_handler { Line 3359  sub put_course_id_handler {
 sub put_course_id_hash_handler {  sub put_course_id_hash_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my ($udom, $what) = split(/:/, $tail,2);      my ($udom,$mode,$what) = split(/:/, $tail,3);
     chomp($what);      chomp($what);
     my $now=time;      my $now=time;
     my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
     my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT(),      my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
                                    "P", $what);  
     if ($hashref) {      if ($hashref) {
         foreach my $pair (@pairs) {          foreach my $pair (@pairs) {
             my ($key,$value)=split(/=/,$pair);              my ($key,$value)=split(/=/,$pair);
             $hashref->{$key} = $value;              my $unesc_key = &unescape($key);
               if ($mode ne 'timeonly') {
                   if (!defined($hashref->{&escape('lasttime:'.$unesc_key)})) {
                       my $curritems = &Apache::lonnet::thaw_unescape($key); 
                       if (ref($curritems) ne 'HASH') {
                           my @current_items = split(/:/,$hashref->{$key},-1);
                           my $lasttime = pop(@current_items);
                           $hashref->{&escape('lasttime:'.$unesc_key)} = $lasttime;
                       } else {
                           $hashref->{&escape('lasttime:'.$unesc_key)} = '';
                       }
                   } 
                   $hashref->{$key} = $value;
               }
               if ($mode ne 'notime') {
                   $hashref->{&escape('lasttime:'.$unesc_key)} = $now;
               }
         }          }
         if (&untie_domain_hash($hashref)) {          if (&untie_domain_hash($hashref)) {
             &Reply($client, "ok\n", $userinput);              &Reply($client, "ok\n", $userinput);
Line 3403  sub put_course_id_hash_handler { Line 3425  sub put_course_id_hash_handler {
 #                            owner matches the supplied username and/or domain  #                            owner matches the supplied username and/or domain
 #                            will be returned. Pre-2.2.0 legacy entries from   #                            will be returned. Pre-2.2.0 legacy entries from 
 #                            nohist_courseiddump will only contain usernames.  #                            nohist_courseiddump will only contain usernames.
   #                 type     - optional parameter for selection 
   #                 regexp_ok - if true, allow the supplied institutional code
   #                            filter to behave as a regular expression.  
   #                 rtn_as_hash - whether to return the information available for
   #                            each matched item as a frozen hash of all 
   #                            key, value pairs in the item's hash, or as a 
   #                            colon-separated list of (in order) description,
   #                            institutional code, and course owner.
   #    
 #     $client  - The socket open on the client.  #     $client  - The socket open on the client.
 # Returns:  # Returns:
 #    1     - Continue processing.  #    1     - Continue processing.
Line 3410  sub put_course_id_hash_handler { Line 3441  sub put_course_id_hash_handler {
 #   a reply is written to $client.  #   a reply is written to $client.
 sub dump_course_id_handler {  sub dump_course_id_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
   
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,      my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
         $typefilter,$regexp_ok,$as_hash) =split(/:/,$tail);          $typefilter,$regexp_ok,$rtn_as_hash) =split(/:/,$tail);
     if (defined($description)) {      if (defined($description)) {
  $description=&unescape($description);   $description=&unescape($description);
     } else {      } else {
Line 3454  sub dump_course_id_handler { Line 3484  sub dump_course_id_handler {
     if (defined($regexp_ok)) {      if (defined($regexp_ok)) {
         $regexp_ok=&unescape($regexp_ok);          $regexp_ok=&unescape($regexp_ok);
     }      }
       my $unpack = 1;
     unless (defined($since)) { $since=0; }      if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && 
           $typefilter eq '.') {
           $unpack = 0;
       }
       if (!defined($since)) { $since=0; }
     my $qresult='';      my $qresult='';
     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,$rawvalue) = each(%$hashref)) {   while (my ($key,$value) = each(%$hashref)) {
     my ($descr,$lasttime,$inst_code,$owner,$type);              my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,%unesc_val);
             my $value = &Apache::lonnet::thaw_unescape($rawvalue);              $unesc_key = &unescape($key);
             if (ref($value) eq 'HASH') {              if ($unesc_key =~ /^lasttime:/) {
                 $descr = $value->{'description'};                  next;
                 $inst_code = $value->{'inst_code'};  
                 $owner = $value->{'owner'};  
                 $type = $value->{'type'};  
                 $lasttime = $value->{'lasttime'};  
             } else {              } else {
                 my @courseitems = split(/:/,$rawvalue);                  $lasttime_key = &escape('lasttime:'.$unesc_key);
               }
               if ($hashref->{$lasttime_key} ne '') {
                   $lasttime = $hashref->{$lasttime_key};
                   next if ($lasttime<$since);
               }
               my $items = &Apache::lonnet::thaw_unescape($value);
               if (ref($items) eq 'HASH') {
                   $is_hash =  1;
                   if ($unpack || !$rtn_as_hash) {
                       $unesc_val{'descr'} = $items->{'description'};
                       $unesc_val{'inst_code'} = $items->{'inst_code'};
                       $unesc_val{'owner'} = $items->{'owner'};
                       $unesc_val{'type'} = $items->{'type'};
                   }
               } else {
                   $is_hash =  0;
                   my @courseitems = split(/:/,&unescape($value));
                 $lasttime = pop(@courseitems);                  $lasttime = pop(@courseitems);
         ($descr,$inst_code,$owner,$type)=@courseitems;                  next if ($lasttime<$since);
           ($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems;
             }              }
     if ($lasttime<$since) { next; }  
             my $match = 1;              my $match = 1;
     unless ($description eq '.') {      if ($description ne '.') {
  my $unescapeDescr = &unescape($descr);                  if (!$is_hash) {
  unless (eval('$unescapeDescr=~/\Q$description\E/i')) {                      $unesc_val{'descr'} = &unescape($val{'descr'});
                   }
                   if (eval{$unesc_val{'descr'} !~ /\Q$description\E/i}) {
                     $match = 0;                      $match = 0;
  }                  }
             }              }
             unless ($instcodefilter eq '.' || !defined($instcodefilter)) {              if ($instcodefilter ne '.') {
                 my $unescapeInstcode = &unescape($inst_code);                  if (!$is_hash) {
                       $unesc_val{'inst_code'} = &unescape($val{'inst_code'});
                   }
                 if ($regexp_ok) {                  if ($regexp_ok) {
                     unless (eval('$unescapeInstcode=~/$instcodefilter/')) {                      if (eval{$unesc_val{'inst_code'} !~ /$instcodefilter/}) {
                         $match = 0;                          $match = 0;
                     }                      }
                 } else {                  } else {
                     unless (eval('$unescapeInstcode=~/\Q$instcodefilter\E/i')) {                      if (eval{$unesc_val{'inst_code'} !~ /\Q$instcodefilter\E/i}) {
                         $match = 0;                          $match = 0;
                     }                      }
                 }                  }
     }      }
             unless ($ownerfilter eq '.' || !defined($ownerfilter)) {              if ($ownerfilter ne '.') {
                 my $unescapeOwner = &unescape($owner);                  if (!$is_hash) {
                       $unesc_val{'owner'} = &unescape($val{'owner'});
                   }
                 if (($ownerunamefilter ne '') && ($ownerdomfilter ne '')) {                  if (($ownerunamefilter ne '') && ($ownerdomfilter ne '')) {
                     if ($unescapeOwner =~ /:/) {                      if ($unesc_val{'owner'} =~ /:/) {
                         if (eval('$unescapeOwner !~                           if (eval{$unesc_val{'owner'} !~ 
                              /\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i')) {                               /\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i}) {
                             $match = 0;                              $match = 0;
                         }                           } 
                     } else {                      } else {
                         if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {                          if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
                             $match = 0;                              $match = 0;
                         }                          }
                     }                      }
                 } elsif ($ownerunamefilter ne '') {                  } elsif ($ownerunamefilter ne '') {
                     if ($unescapeOwner =~ /:/) {                      if ($unesc_val{'owner'} =~ /:/) {
                         if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E:[^:]+$/i')) {                          if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E:[^:]+$/i}) {
                              $match = 0;                               $match = 0;
                         }                          }
                     } else {                      } else {
                         if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {                          if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
                             $match = 0;                              $match = 0;
                         }                          }
                     }                      }
                 } elsif ($ownerdomfilter ne '') {                  } elsif ($ownerdomfilter ne '') {
                     if ($unescapeOwner =~ /:/) {                      if ($unesc_val{'owner'} =~ /:/) {
                         if (eval('$unescapeOwner!~/^[^:]+:\Q$ownerdomfilter\E/')) {                          if (eval{$unesc_val{'owner'} !~ /^[^:]+:\Q$ownerdomfilter\E/}) {
                              $match = 0;                               $match = 0;
                         }                          }
                     } else {                      } else {
Line 3528  sub dump_course_id_handler { Line 3581  sub dump_course_id_handler {
                     }                      }
                 }                  }
             }              }
             my $unescapeCourse = &unescape($key);              if ($coursefilter ne '.') {
             unless ($coursefilter eq '.' || !defined($coursefilter)) {                  if (eval{$unesc_key !~ /^$udom(_)\Q$coursefilter\E$/}) {
                 my $unescapeCourse = &unescape($key);  
                 unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) {  
                     $match = 0;                      $match = 0;
                 }                  }
             }              }
             unless ($typefilter eq '.' || !defined($typefilter)) {              if ($typefilter ne '.') {
                 my $unescapeType = &unescape($type);                  if (!$is_hash) {
                 if ($type eq '') {                      $unesc_val{'type'} = &unescape($val{'type'});
                   }
                   if ($unesc_val{'type'} eq '') {
                     if ($typefilter ne 'Course') {                      if ($typefilter ne 'Course') {
                         $match = 0;                          $match = 0;
                     }                      }
                 } else {                  } else {
                     unless (eval('$unescapeType=~/^\Q$typefilter\E$/')) {                      if (eval{$unesc_val{'type'} !~ /^\Q$typefilter\E$/}) {
                         $match = 0;                          $match = 0;
                     }                      }
                 }                  }
             }              }
             if ($match == 1) {              if ($match == 1) {
                 if ($as_hash) {                  if ($rtn_as_hash) {
                     $qresult.=$key.'='.$rawvalue.'&';                       if ($is_hash) {
                           $qresult.=$key.'='.$value.'&';
                       } else {
                           my %rtnhash = ( 'description' => &escape($val{'descr'}),
                                           'inst_code' => &escape($val{'inst_code'}),
                                           'owner'     => &escape($val{'owner'}),
                                           'type'      => &escape($val{'type'}),
                                         );
                           my $items = &Apache::lonnet::freeze_escape(\%rtnhash);
                           $qresult.=$key.'='.$items.'&';
                       }
                 } else {                  } else {
                     $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';                      if ($is_hash) {
                           $qresult .= $key.'='.&escape($unesc_val{'descr'}).':'.
                                       &escape($unesc_val{'inst_code'}).':'.
                                       &escape($unesc_val{'owner'}).'&';
                       } else {
                           $qresult .= $key.'='.$val{'descr'}.':'.$val{'inst_code'}.
                                       ':'.$val{'owner'}.'&';
                       }
                 }                  }
             }              }
  }   }
Line 4385  sub validate_class_access_handler { Line 4455  sub validate_class_access_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my ($inst_class,$ownerlist,$cdom) = split(/:/, $tail);      my ($inst_class,$ownerlist,$cdom) = split(/:/, $tail);
     $ownerlist = &unescape($ownerlist);  
     my @owners = split(/,/,&unescape($ownerlist));      my @owners = split(/,/,&unescape($ownerlist));
     my $outcome;      my $outcome;
     eval {      eval {
Removed from v.1.383  
changed lines
  Added in v.1.384

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