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

Diff for /loncom/lond between versions 1.381 and 1.383

version 1.381, 2007/09/12 20:29:13 version 1.383, 2007/10/03 19:57:23
Line 53  use File::Find; Line 53  use File::Find;
 use LONCAPA::lonlocal;  use LONCAPA::lonlocal;
 use LONCAPA::lonssl;  use LONCAPA::lonssl;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
   use Apache::lonnet;
   
 my $DEBUG = 0;       # Non zero to enable debug log entries.  my $DEBUG = 0;       # Non zero to enable debug log entries.
   
Line 2095  sub rename_user_file_handler { Line 2096  sub rename_user_file_handler {
 &register_handler("renameuserfile", \&rename_user_file_handler, 0,1,0);  &register_handler("renameuserfile", \&rename_user_file_handler, 0,1,0);
   
 #  #
   #  Checks if the specified user has an active session on the server
   #  return ok if so, not_found if not
   #
   # Parameters:
   #   cmd      - The request keyword that dispatched to tus.
   #   tail     - The tail of the request (colon separated parameters).
   #   client   - Filehandle open on the client.
   # Return:
   #    1.
   sub user_has_session_handler {
       my ($cmd, $tail, $client) = @_;
   
       my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail));
       
       &logthis("Looking for $udom $uname");
       opendir(DIR,$perlvar{'lonIDsDir'});
       my $filename;
       while ($filename=readdir(DIR)) {
    last if ($filename=~/^\Q$uname\E_\d+_\Q$udom\E_/);
       }
       if ($filename) {
    &Reply($client, "ok\n", "$cmd:$tail");
       } else {
    &Failure($client, "not_found\n", "$cmd:$tail");
       }
       return 1;
   
   }
   &register_handler("userhassession", \&user_has_session_handler, 0,1,0);
   
   #
 #  Authenticate access to a user file by checking that the token the user's   #  Authenticate access to a user file by checking that the token the user's 
 #  passed also exists in their session file  #  passed also exists in their session file
 #  #
Line 3273  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;
             my @current_items = split(/:/,$hashref->{$key},-1);              if (ref($hashref) eq 'HASH') {
             shift(@current_items); # remove description                  my @items = ('description','inst_code','owner','type');
             pop(@current_items);   # remove last access                  my @new_items = split(/:/,$courseinfo,-1);
             my $numcurrent = scalar(@current_items);                  for (my $i=0; $i<@new_items; $i++) {
             if ($numcurrent > 3) {                      $hashref->{$key}{$items[$i]} = $new_items[$i];
                 $numcurrent = 3;                  }
             }                  $hashref->{$key}{'lasttime'} = $now;
             my @new_items = split(/:/,$courseinfo,-1);              } else {
             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 3303  sub put_course_id_handler { Line 3344  sub put_course_id_handler {
  ." tie(GDBM) Failed ".   ." tie(GDBM) Failed ".
  "while attempting courseidput\n", $userinput);   "while attempting courseidput\n", $userinput);
     }      }
       
   
     return 1;      return 1;
 }  }
 &register_handler("courseidput", \&put_course_id_handler, 0, 1, 0);  &register_handler("courseidput", \&put_course_id_handler, 0, 1, 0);
   
   sub put_course_id_hash_handler {
       my ($cmd, $tail, $client) = @_;
       my $userinput = "$cmd:$tail";
       my ($udom, $what) = split(/:/, $tail,2);
       chomp($what);
       my $now=time;
       my @pairs=split(/\&/,$what);
       my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT(),
                                      "P", $what);
       if ($hashref) {
           foreach my $pair (@pairs) {
               my ($key,$value)=split(/=/,$pair);
               $hashref->{$key} = $value;
           }
           if (&untie_domain_hash($hashref)) {
               &Reply($client, "ok\n", $userinput);
           } else {
               &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
                        "while attempting courseidputhash\n", $userinput);
           }
       } else {
           &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
                     "while attempting courseidputhash\n", $userinput);
       }
       return 1;
   }
   &register_handler("courseidputhash", \&put_course_id_hash_handler, 0, 1, 0);
   
 #  Retrieves the value of a course id resource keyword pattern  #  Retrieves the value of a course id resource keyword pattern
 #  defined since a starting date.  Both the starting date and the  #  defined since a starting date.  Both the starting date and the
 #  keyword pattern are optional.  If the starting date is not supplied it  #  keyword pattern are optional.  If the starting date is not supplied it
Line 3346  sub dump_course_id_handler { Line 3414  sub dump_course_id_handler {
     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) =split(/:/,$tail);          $typefilter,$regexp_ok,$as_hash) =split(/:/,$tail);
     if (defined($description)) {      if (defined($description)) {
  $description=&unescape($description);   $description=&unescape($description);
     } else {      } else {
Line 3391  sub dump_course_id_handler { Line 3459  sub dump_course_id_handler {
     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,$value) = each(%$hashref)) {   while (my ($key,$rawvalue) = each(%$hashref)) {
     my ($descr,$lasttime,$inst_code,$owner,$type);      my ($descr,$lasttime,$inst_code,$owner,$type);
             my @courseitems = split(/:/,$value);              my $value = &Apache::lonnet::thaw_unescape($rawvalue);
             $lasttime = pop(@courseitems);              if (ref($value) eq 'HASH') {
     ($descr,$inst_code,$owner,$type)=@courseitems;                  $descr = $value->{'description'};
                   $inst_code = $value->{'inst_code'};
                   $owner = $value->{'owner'};
                   $type = $value->{'type'};
                   $lasttime = $value->{'lasttime'};
               } else {
                   my @courseitems = split(/:/,$rawvalue);
                   $lasttime = pop(@courseitems);
           ($descr,$inst_code,$owner,$type)=@courseitems;
               }
     if ($lasttime<$since) { next; }      if ($lasttime<$since) { next; }
             my $match = 1;              my $match = 1;
     unless ($description eq '.') {      unless ($description eq '.') {
Line 3451  sub dump_course_id_handler { Line 3528  sub dump_course_id_handler {
                     }                      }
                 }                  }
             }              }
               my $unescapeCourse = &unescape($key);
             unless ($coursefilter eq '.' || !defined($coursefilter)) {              unless ($coursefilter eq '.' || !defined($coursefilter)) {
                 my $unescapeCourse = &unescape($key);                  my $unescapeCourse = &unescape($key);
                 unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) {                  unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) {
Line 3463  sub dump_course_id_handler { Line 3541  sub dump_course_id_handler {
                     if ($typefilter ne 'Course') {                      if ($typefilter ne 'Course') {
                         $match = 0;                          $match = 0;
                     }                      }
                 } else {                   } else {
                     unless (eval('$unescapeType=~/^\Q$typefilter\E$/')) {                      unless (eval('$unescapeType=~/^\Q$typefilter\E$/')) {
                         $match = 0;                          $match = 0;
                     }                      }
                 }                  }
             }              }
             if ($match == 1) {              if ($match == 1) {
                 $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';                  if ($as_hash) {
                       $qresult.=$key.'='.$rawvalue.'&'; 
                   } else {
                       $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';
                   }
             }              }
  }   }
  if (&untie_domain_hash($hashref)) {   if (&untie_domain_hash($hashref)) {
Line 3484  sub dump_course_id_handler { Line 3566  sub dump_course_id_handler {
  &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".   &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
  "while attempting courseiddump\n", $userinput);   "while attempting courseiddump\n", $userinput);
     }      }
   
   
     return 1;      return 1;
 }  }
 &register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);  &register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);
Line 4304  sub validate_course_section_handler { Line 4384  sub validate_course_section_handler {
 sub validate_class_access_handler {  sub validate_class_access_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my ($inst_class,$courseowner,$cdom) = split(/:/, $tail);      my ($inst_class,$ownerlist,$cdom) = split(/:/, $tail);
     $courseowner = &unescape($courseowner);      $ownerlist = &unescape($ownerlist);
       my @owners = split(/,/,&unescape($ownerlist));
     my $outcome;      my $outcome;
     eval {      eval {
  local($SIG{__DIE__})='DEFAULT';   local($SIG{__DIE__})='DEFAULT';
  $outcome=&localenroll::check_section($inst_class,$courseowner,$cdom);   $outcome=&localenroll::check_section($inst_class,\@owners,$cdom);
     };      };
     &Reply($client,"$outcome\n", $userinput);      &Reply($client,"$outcome\n", $userinput);
   
Removed from v.1.381  
changed lines
  Added in v.1.383

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