--- loncom/lond 2007/09/29 04:03:39 1.382 +++ loncom/lond 2007/10/03 19:57:23 1.383 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.382 2007/09/29 04:03:39 albertel Exp $ +# $Id: lond,v 1.383 2007/10/03 19:57:23 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,13 +53,14 @@ use File::Find; use LONCAPA::lonlocal; use LONCAPA::lonssl; use Fcntl qw(:flock); +use Apache::lonnet; my $DEBUG = 0; # Non zero to enable debug log entries. my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.382 $'; #' stupid emacs +my $VERSION='$Revision: 1.383 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -3304,23 +3305,32 @@ sub put_course_id_handler { foreach my $pair (@pairs) { my ($key,$courseinfo) = split(/=/,$pair,2); $courseinfo =~ s/=/:/g; - my @current_items = split(/:/,$hashref->{$key},-1); - shift(@current_items); # remove description - pop(@current_items); # remove last access - my $numcurrent = scalar(@current_items); - 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]; + if (ref($hashref) eq 'HASH') { + my @items = ('description','inst_code','owner','type'); + my @new_items = split(/:/,$courseinfo,-1); + for (my $i=0; $i<@new_items; $i++) { + $hashref->{$key}{$items[$i]} = $new_items[$i]; + } + $hashref->{$key}{'lasttime'} = $now; + } else { + my @current_items = split(/:/,$hashref->{$key},-1); + shift(@current_items); # remove description + pop(@current_items); # remove last access + my $numcurrent = scalar(@current_items); + 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)) { &Reply( $client, "ok\n", $userinput); @@ -3334,12 +3344,39 @@ sub put_course_id_handler { ." tie(GDBM) Failed ". "while attempting courseidput\n", $userinput); } - return 1; } ®ister_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; +} +®ister_handler("courseidputhash", \&put_course_id_hash_handler, 0, 1, 0); + # Retrieves the value of a course id resource keyword pattern # defined since a starting date. Both the starting date and the # keyword pattern are optional. If the starting date is not supplied it @@ -3377,7 +3414,7 @@ sub dump_course_id_handler { my $userinput = "$cmd:$tail"; my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, - $typefilter,$regexp_ok) =split(/:/,$tail); + $typefilter,$regexp_ok,$as_hash) =split(/:/,$tail); if (defined($description)) { $description=&unescape($description); } else { @@ -3422,11 +3459,20 @@ sub dump_course_id_handler { my $qresult=''; my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); if ($hashref) { - while (my ($key,$value) = each(%$hashref)) { + while (my ($key,$rawvalue) = each(%$hashref)) { my ($descr,$lasttime,$inst_code,$owner,$type); - my @courseitems = split(/:/,$value); - $lasttime = pop(@courseitems); - ($descr,$inst_code,$owner,$type)=@courseitems; + my $value = &Apache::lonnet::thaw_unescape($rawvalue); + if (ref($value) eq 'HASH') { + $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; } my $match = 1; unless ($description eq '.') { @@ -3482,6 +3528,7 @@ sub dump_course_id_handler { } } } + my $unescapeCourse = &unescape($key); unless ($coursefilter eq '.' || !defined($coursefilter)) { my $unescapeCourse = &unescape($key); unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) { @@ -3494,14 +3541,18 @@ sub dump_course_id_handler { if ($typefilter ne 'Course') { $match = 0; } - } else { + } else { unless (eval('$unescapeType=~/^\Q$typefilter\E$/')) { $match = 0; } } } 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)) { @@ -3515,8 +3566,6 @@ sub dump_course_id_handler { &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". "while attempting courseiddump\n", $userinput); } - - return 1; } ®ister_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0); @@ -4335,12 +4384,13 @@ sub validate_course_section_handler { sub validate_class_access_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; - my ($inst_class,$courseowner,$cdom) = split(/:/, $tail); - $courseowner = &unescape($courseowner); + my ($inst_class,$ownerlist,$cdom) = split(/:/, $tail); + $ownerlist = &unescape($ownerlist); + my @owners = split(/,/,&unescape($ownerlist)); my $outcome; eval { 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);