version 1.380.2.1, 2007/09/29 04:05:29
|
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 3304 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 3334 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; |
} |
} |
®ister_handler("courseidput", \&put_course_id_handler, 0, 1, 0); |
®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 |
# 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 3377 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 3422 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 3482 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 3494 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 3515 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; |
} |
} |
®ister_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0); |
®ister_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0); |
Line 4335 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); |
|
|
Line 4514 sub get_institutional_defaults_handler {
|
Line 4564 sub get_institutional_defaults_handler {
|
®ister_handler("autoinstcodedefaults", |
®ister_handler("autoinstcodedefaults", |
\&get_institutional_defaults_handler,0,1,0); |
\&get_institutional_defaults_handler,0,1,0); |
|
|
|
sub get_institutional_user_rules { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my $dom = &unescape($tail); |
|
my (%rules_hash,@rules_order); |
|
my $outcome; |
|
eval { |
|
local($SIG{__DIE__})='DEFAULT'; |
|
$outcome = &localenroll::username_rules($dom,\%rules_hash,\@rules_order); |
|
}; |
|
if (!$@) { |
|
if ($outcome eq 'ok') { |
|
my $result; |
|
foreach my $key (keys(%rules_hash)) { |
|
$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&'; |
|
} |
|
$result =~ s/\&$//; |
|
$result .= ':'; |
|
if (@rules_order > 0) { |
|
foreach my $item (@rules_order) { |
|
$result .= &escape($item).'&'; |
|
} |
|
} |
|
$result =~ s/\&$//; |
|
&Reply($client,$result."\n",$userinput); |
|
} else { |
|
&Reply($client,"error\n", $userinput); |
|
} |
|
} else { |
|
&Failure($client,"unknown_cmd\n",$userinput); |
|
} |
|
} |
|
®ister_handler("instuserrules",\&get_institutional_user_rules,0,1,0); |
|
|
|
|
|
sub institutional_username_check { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my %rulecheck; |
|
my $outcome; |
|
my ($udom,$uname,@rules) = split(/:/,$tail); |
|
$udom = &unescape($udom); |
|
$uname = &unescape($uname); |
|
@rules = map {&unescape($_);} (@rules); |
|
eval { |
|
local($SIG{__DIE__})='DEFAULT'; |
|
$outcome = &localenroll::username_check($udom,$uname,\@rules,\%rulecheck); |
|
}; |
|
if (!$@) { |
|
if ($outcome eq 'ok') { |
|
my $result=''; |
|
foreach my $key (keys(%rulecheck)) { |
|
$result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&'; |
|
} |
|
&Reply($client,$result."\n",$userinput); |
|
} else { |
|
&Reply($client,"error\n", $userinput); |
|
} |
|
} else { |
|
&Failure($client,"unknown_cmd\n",$userinput); |
|
} |
|
} |
|
®ister_handler("instrulecheck",\&institutional_username_check,0,1,0); |
|
|
|
|
# Get domain specific conditions for import of student photographs to a course |
# Get domain specific conditions for import of student photographs to a course |
# |
# |