--- loncom/interface/lonparmset.pm 2007/08/24 21:31:41 1.377 +++ loncom/interface/lonparmset.pm 2008/01/24 23:23:55 1.390 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set parameters for assessments # -# $Id: lonparmset.pm,v 1.377 2007/08/24 21:31:41 www Exp $ +# $Id: lonparmset.pm,v 1.390 2008/01/24 23:23:55 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -577,6 +577,7 @@ sub valout { &date_sanity_info($value); } else { $result = $value; + $result = &HTML::Entities::encode($result,'"<>&'); } } return $result; @@ -613,10 +614,16 @@ sub plink { my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/); my ($hour,$min,$sec,$val)=&preset_defaults($parmname); unless (defined($winvalue)) { $winvalue=$val; } + my $valout = &valout($value,$type,1); + foreach my $item (\$type, \$dis, \$winvalue, \$marker, \$return, \$call, + \$hour, \$min, \$sec) { + $$item = &HTML::Entities::encode($$item,'"<>&'); + $$item =~ s/\'/\\\'/g; + } return '
'. ''. - &valout($value,$type,1).'
'; + $valout.''; } sub page_js { @@ -1594,7 +1601,8 @@ sub assessparms { foreach ('tolerance','date_default','date_start','date_end', 'date_interval','int','float','string') { $r->print(''); + &HTML::Entities::encode($env{'form.recent_'.$_},'"&<>'). + '" name="recent_'.$_.'" />'); } if (!$pssymb) { @@ -2101,13 +2109,13 @@ sub crsenv { # # Let the user know we made the changes if ($name && defined($value)) { - my $failed_cloners; + my %failed_cloners; if ($name eq 'cloners') { $value =~ s/\s//g; $value =~ s/^,//; $value =~ s/,$//; # check requested clones are valid users. - $failed_cloners = &check_cloners(\$value,\@oldcloner); + %failed_cloners = &check_cloners(\$value,\@oldcloner); } my $put_result = &Apache::lonnet::put('environment', {$name=>$value},$dom,$crs); @@ -2116,25 +2124,52 @@ sub crsenv { if ($name eq 'cloners') { &change_clone($value,\@oldcloner); } - # Flush the course logs so course description is immediately updated + # Update environment and nohist_courseids.db if ($name eq 'description' && defined($value)) { - &Apache::lonnet::flushcourselogs(); + my %crsinfo = + &Apache::lonnet::courseiddump($dom,'.',1,'.','.', + $crs,undef,undef,'Course'); + &Apache::lonnet::appenv('course.'.$env{'request.course.id'}.'.description' => $value); + if (ref($crsinfo{$env{'request.course.id'}}) eq 'HASH') { + $crsinfo{$env{'request.course.id'}}{'description'} = $value; + my $chome = &Apache::lonnet::homeserver($crs,$dom); + my $putresult = + &Apache::lonnet::courseidput($dom,\%crsinfo, + $chome,'notime'); + } } } else { $setoutput.=&mt('Unable to set').' '.$name.' '.&mt('to'). ' '.$value.' '.&mt('due to').' '.$put_result.'.
'; } - if (($name eq 'cloners') && ($failed_cloners)) { - $setoutput.= &mt('Unable to include').' - '.$failed_cloners.', '. - &mt('reason').' - '.&mt('LON-CAPA user(s) do(es) not exist'). - '.
'.&mt('Please '). - ' '. - &mt('add the user(s)').', '. - &mt('and then return to the '). - ''. - &mt('Course Parameters page').' '. - &mt('to add the new user(s) to the list of possible cloners'). - '.
'; + if (($name eq 'cloners') && (keys(%failed_cloners) > 0)) { + $setoutput.= &mt('Unable to include').': '; + my @fails; + my $num = 0; + if (defined($failed_cloners{'format'})) { + $fails[$num] .= ''.$failed_cloners{'format'}. + ', '.&mt('reason').' - '. + &mt('Invalid format'); + $num ++; + } + if (defined($failed_cloners{'domain'})) { + $fails[$num] .= ''.$failed_cloners{'domain'}. + ', '.&mt('reason').' - '. + &mt('Domain does not exist'); + $num ++; + } + if (defined($failed_cloners{'newuser'})) { + $fails[$num] .= ''.$failed_cloners{'newuser'}. ', '.&mt('reason').' - '. + &mt('LON-CAPA user(s) do(es) not exist.'). + '.
'.&mt('Please '). + ' '. + &mt('add the user(s)').', '. + &mt('and then return to the '). + ''. + &mt('Course Parameters page').' '. + &mt('to add the new user(s) to the list of possible cloners'); + } + $setoutput .= join(';  ',@fails).'.
'; } } } @@ -2165,7 +2200,9 @@ sub crsenv { 'courseid' => ''.&mt('Course ID or number'). '
'. '('.&mt('internal').', '.&mt('optional').')', - 'cloners' => ''.&mt('Users allowed to clone course').'
(user:domain,user:domain)
'.&mt('Users with active Course Coordinator role in the course automatically have the right to clone it, and can be omitted from list.'), + 'cloners' => ''.&mt('Users allowed to clone course').'
(user:domain,user:domain,*:domain)
'.&mt('Users with active Course Coordinator role in course are permitted to clone and need not be included.
+Use *:domain to allow course to be cloned by anyone in the specified domain.
+Use * to allow unrestricted cloning in all domains.'), 'grading' => ''.&mt('Grading').'
'. '"standard", "external", or "spreadsheet" '.&Apache::loncommon::help_open_topic('GradingOptions'), 'task_grading' => ''.&mt('Bridge Task Grading').'
'. @@ -2466,16 +2503,28 @@ sub storedata { if ($tuname) { $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./; } - if ($cmd eq 'set') { - my $data=$env{$_}; - my $typeof=$env{'form.typeof_'.$thiskey}; - if ($$olddata{$thiskey} ne $data) { + if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') { + my ($data, $typeof, $text); + if ($cmd eq 'set') { + $data=$env{$_}; + $typeof=$env{'form.typeof_'.$thiskey}; + $text = &mt('Saved modified parameter for'); + } elsif ($cmd eq 'datepointer') { + $data=&Apache::lonhtmlcommon::get_date_from_form($env{$_}); + $typeof=$env{'form.typeof_'.$thiskey}; + $text = &mt('Saved modified date for'); + } elsif ($cmd eq 'dateinterval') { + $data=&get_date_interval_from_form($thiskey); + $typeof=$env{'form.typeof_'.$thiskey}; + $text = &mt('Saved modified date for'); + } + if (defined($data) and $$olddata{$thiskey} ne $data) { if ($tuname) { if (&Apache::lonnet::put('resourcedata',{$tkey=>$data, $tkey.'.type' => $typeof}, $tudom,$tuname) eq 'ok') { &log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom); - $r->print('
'.&mt('Saved modified parameter for').' '. + $r->print('
'.$text.' '. &Apache::loncommon::plainname($tuname,$tudom)); } else { $r->print('
'. @@ -2500,26 +2549,6 @@ sub storedata { } else { push (@deldata,$thiskey,$thiskey.'.type'); } - } elsif ($cmd eq 'datepointer') { - my $data=&Apache::lonhtmlcommon::get_date_from_form($env{$_}); - my $typeof=$env{'form.typeof_'.$thiskey}; - if (defined($data) and $$olddata{$thiskey} ne $data) { - if ($tuname) { - if (&Apache::lonnet::put('resourcedata',{$tkey=>$data, - $tkey.'.type' => $typeof}, - $tudom,$tuname) eq 'ok') { - &log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom); - $r->print('
'.&mt('Saved modified date for').' '.&Apache::loncommon::plainname($tuname,$tudom)); - } else { - $r->print('
'. - &mt('Error saving parameters').'
'); - } - &Apache::lonnet::devalidateuserresdata($tuname,$tudom); - } else { - $newdata{$thiskey}=$data; - $newdata{$thiskey.'.type'}=$typeof; - } - } } } } @@ -2555,6 +2584,26 @@ sub extractuser { return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./); } +sub parse_listdata_key { + my ($key,$listdata) = @_; + # split into student/section affected, and + # the realm (folder/resource part and parameter + my ($student,$realm) = + ($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/); + # if course wide student would be undefined + if (!defined($student)) { + ($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/); + } + # strip off the .type if it's not the Question type parameter + if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) { + $realm=~s/\.type//; + } + # split into resource+part and parameter name + my ($res, $parm) = ($realm=~/^(.*)\.(.*)$/); + ($res, my $part) = ($res =~/^(.*)\.(.*)$/); + return ($student,$res,$part,$parm); +} + sub listdata { my ($r,$resourcedata,$listdata,$sortorder)=@_; # Start list output @@ -2566,40 +2615,48 @@ sub listdata { $tableopen=0; my $foundkeys=0; my %keyorder=&standardkeyorder(); + foreach my $thiskey (sort { + my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata); + my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata); + + # get the numerical order for the param + $aparm=$keyorder{'parameter_0_'.$aparm}; + $bparm=$keyorder{'parameter_0_'.$bparm}; + + my $result=0; + if ($sortorder eq 'realmstudent') { - my ($astudent,$arealm)=($a=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)\.[^\.]+$/); - my ($bstudent,$brealm)=($b=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)\.[^\.]+$/); - if (!defined($astudent)) { - ($arealm)=($a=~/^\Q$env{'request.course.id'}\E\.(.+)$/); - } - if (!defined($bstudent)) { - ($brealm)=($b=~/^\Q$env{'request.course.id'}\E\.(.+)$/); - } - $arealm=~s/\.type//; - my ($ares, $aparm) = ($arealm=~/^(.*)\.(.*)$/); - $aparm=$keyorder{'parameter_0_'.$aparm}; - $brealm=~s/\.type//; - my ($bres, $bparm) = ($brealm=~/^(.*)\.(.*)$/); - $bparm=$keyorder{'parameter_0_'.$bparm}; - if ($ares eq $bres) { - if (defined($aparm) && defined($bparm)) { - ($aparm <=> $bparm); - } elsif (defined($aparm)) { - -1; - } elsif (defined($bparm)) { - 1; - } else { - ($arealm cmp $brealm) || ($astudent cmp $bstudent); - } - } else { - ($arealm cmp $brealm) || ($astudent cmp $bstudent); + if ($ares ne $bres ) { + $result = ($ares cmp $bres); + } elsif ($astudent ne $bstudent) { + $result = ($astudent cmp $bstudent); + } elsif ($apart ne $bpart ) { + $result = ($apart cmp $bpart); } } else { - $a cmp $b; + if ($astudent ne $bstudent) { + $result = ($astudent cmp $bstudent); + } elsif ($ares ne $bres ) { + $result = ($ares cmp $bres); + } elsif ($apart ne $bpart ) { + $result = ($apart cmp $bpart); + } + } + + if (!$result) { + if (defined($aparm) && defined($bparm)) { + $result = ($aparm <=> $bparm); + } elsif (defined($aparm)) { + $result = -1; + } elsif (defined($bparm)) { + $result = 1; + } } + + $result; } keys %{$listdata}) { - + if ($$listdata{$thiskey.'.type'}) { my $thistype=$$listdata{$thiskey.'.type'}; if ($$resourcedata{$thiskey.'.type'}) { @@ -2672,32 +2729,18 @@ sub listdata { $$resourcedata{$thiskey}, '',1,'',''). ''. +(($$resourcedata{$thiskey}!=0)?''. +&mt('Shift all dates based on this date').'':''). &date_sanity_info($$resourcedata{$thiskey}) ); - } elsif ($thistype eq 'string_yesno') { - my $showval; - if (defined($$resourcedata{$thiskey})) { - $showval=$$resourcedata{$thiskey}; - } - $r->print(' '); - $r->print(''); + } elsif ($thistype eq 'date_interval') { + $r->print(&date_interval_selector($thiskey, + $$resourcedata{$thiskey})); + } elsif ($thistype =~ m/^string/) { + $r->print(&string_selector($thistype,$thiskey, + $$resourcedata{$thiskey})); } else { - my $showval; - if (defined($$resourcedata{$thiskey})) { - $showval=$$resourcedata{$thiskey}; - } - $r->print(''); + $r->print(&default_selector($thiskey,$$resourcedata{$thiskey})); } $r->print(''); @@ -2707,6 +2750,109 @@ sub listdata { return $foundkeys; } + +sub date_interval_selector { + my ($thiskey, $showval) = @_; + my $result; + foreach my $which (['days', 86400, 31], + ['hours', 3600, 23], + ['minutes', 60, 59], + ['seconds', 1, 59]) { + my ($name, $factor, $max) = @{ $which }; + my $amount = int($showval/$factor); + $showval %= $factor; + my %select = ((map {$_ => $_} (0..$max)), + 'select_form_order' => [0..$max]); + $result .= &Apache::loncommon::select_form($amount,$name.'_'.$thiskey, + %select); + $result .= ' '.&mt($name); + } + $result .= ''; + return $result; + +} + +sub get_date_interval_from_form { + my ($key) = @_; + my $seconds = 0; + foreach my $which (['days', 86400], + ['hours', 3600], + ['minutes', 60], + ['seconds', 1]) { + my ($name, $factor) = @{ $which }; + if (defined($env{'form.'.$name.'_'.$key})) { + $seconds += $env{'form.'.$name.'_'.$key} * $factor; + } + } + return $seconds; +} + + +sub default_selector { + my ($thiskey, $showval) = @_; + return ''; +} + +my %strings = + ( + 'string_yesno' + => [[ 'yes', 'Yes' ], + [ 'no', 'No' ]], + 'string_problemstatus' + => [[ 'yes', 'Yes' ], + [ 'answer', 'Yes, and show correct answer if they exceed the maxium number of tries.' ], + [ 'no', 'No, don\'t show correct/incorrect feedback.' ], + [ 'no_feedback_ever', 'No, show no feedback at all.' ]], + ); + + +sub string_selector { + my ($thistype, $thiskey, $showval) = @_; + + if (!exists($strings{$thistype})) { + return &default_selector($thiskey,$showval); + } + + my $result; + foreach my $possibilities (@{ $strings{$thistype} }) { + my ($name, $description) = @{ $possibilities }; + $result .= '