--- loncom/interface/lonparmset.pm 2005/06/06 02:25:09 1.211 +++ loncom/interface/lonparmset.pm 2005/10/26 21:42:10 1.262 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set parameters for assessments # -# $Id: lonparmset.pm,v 1.211 2005/06/06 02:25:09 www Exp $ +# $Id: lonparmset.pm,v 1.262 2005/10/26 21:42:10 banghart Exp $ # # Copyright Michigan State University Board of Trustees # @@ -70,6 +70,8 @@ my $parmhashid; my %parmhash; my $symbsid; my %symbs; +my $rulesid; +my %rules; # --- end local caches @@ -240,6 +242,38 @@ sub symbcache { return $symbs{$id}; } +sub resetrulescache { + $rulesid=''; +} + +sub rulescache { + my $id=shift; + if ($rulesid ne $env{'request.course.id'}) { + %rules=(); + } + unless (defined($rules{$id})) { + my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $crs = $env{'course.'.$env{'request.course.id'}.'.num'}; + %rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs); + $rulesid=$env{'request.course.id'}; + } + return $rules{$id}; +} + +sub preset_defaults { + my $type=shift; + if (&rulescache($type.'_action') eq 'default') { +# yes, there is something + return (&rulescache($type.'_hours'), + &rulescache($type.'_min'), + &rulescache($type.'_sec'), + &rulescache($type.'_value')); + } else { +# nothing there or something else + return ('','','','',''); + } +} + ################################################## ################################################## # @@ -271,7 +305,57 @@ sub storeparm { # - username # - userdomain +my %recstack; sub storeparm_by_symb { + my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag)=@_; + unless ($recflag) { +# first time call + %recstack=(); + $recflag=1; + } +# store parameter + &storeparm_by_symb_inner + ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec); + my ($prefix,$parm)=($spnam=~/^(.*[\_\.])([^\_\.]+)$/); +# remember that this was set + $recstack{$parm}=1; +# what does this trigger? + foreach my $triggered (split(/\:/,&rulescache($parm.'_triggers'))) { +# don't backfire + unless ((!$triggered) || ($recstack{$triggered})) { + my $action=&rulescache($triggered.'_action'); + my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/); +# set triggered parameter on same level + my $newspnam=$prefix.$triggered; + my $newvalue=''; + my $active=1; + if ($action=~/^when\_setting/) { +# are there restrictions? + if (&rulescache($triggered.'_triggervalue')=~/\w/) { + $active=0; + foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) { + if (lc($possiblevalue) eq lc($nval)) { $active=1; } + } + } + $newvalue=&rulescache($triggered.'_value'); + } else { + my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec'); + if ($action=~/^later\_than/) { + $newvalue=$nval+$totalsecs; + } else { + $newvalue=$nval-$totalsecs; + } + } + if ($active) { + &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'), + $uname,$udom,$csec,$recflag); + } + } + } + return ''; +} + +sub storeparm_by_symb_inner { # ---------------------------------------------------------- Get symb, map, etc my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_; # ---------------------------------------------------------- Construct prefixes @@ -403,7 +487,7 @@ sub valout { $result.=$sec.' secs '; } $result=~s/\s+$//; - } elsif ($type=~/^date/) { + } elsif (&isdateparm($type)) { $result = localtime($value); } else { $result = $value; @@ -434,17 +518,18 @@ sub plink { my ($type,$dis,$value,$marker,$return,$call)=@_; my $winvalue=$value; unless ($winvalue) { - if ($type=~/^date/) { + if (&isdateparm($type)) { $winvalue=$env{'form.recent_'.$type}; } else { $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]}; } } - - + my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/); + my ($hour,$min,$sec,$val)=&preset_defaults($parmname); + unless (defined($winvalue)) { $winvalue=$val; } return ''. + .$marker."','".$return."','".$call."','".$hour."','".$min."','".$sec."'".');">'. &valout($value,$type).''; } @@ -544,7 +629,10 @@ sub print_row { } else { $parm=~s|\[.*\]\s||g; } - + my $automatic=&rulescache(($which=~/\_([^\_]+)$/)[0].'_triggers'); + if ($automatic) { + $parm.='
'.&mt('Automatically sets').' '.join(', ',split(/\:/,$automatic)).''; + } $r->print(''.$parm.''); my $thismarker=$which; @@ -742,6 +830,11 @@ sub extractResourceInformation { ################################################## ################################################## +sub isdateparm { + my $type=shift; + return (($type=~/^date/) && (!($type eq 'date_interval'))); +} + sub parmmenu { my ($r,$allparms,$pscat,$keyorder)=@_; my $tempkey; @@ -771,8 +864,18 @@ sub parmmenu { checkthis('duedate','pscat'); checkthis('opendate','pscat'); checkthis('answerdate','pscat'); - checkthis('interval','pscat'); - } + } + + function checkdisset() { + checkthis('discussend','pscat'); + checkthis('discusshide','pscat'); + } + + function checkcontdates() { + checkthis('contentopen','pscat'); + checkthis('contentclose','pscat'); + } + function checkvisi() { checkthis('hiddenresource','pscat'); @@ -801,12 +904,12 @@ ENDSCRIPT $r->print("\n"); my $cnt=0; foreach $tempkey (&keysindisplayorder($allparms,$keyorder)) { - $r->print("\n'); + $r->print('>'.$$allparms{$tempkey}.''); $cnt++; if ($cnt==3) { $r->print("\n"); @@ -815,14 +918,16 @@ ENDSCRIPT } $r->print(' '); $r->print('
print("\n
-Select All -Select Standard +Select All
+Select Common Only 		-Select Dates -Select Visibilities -Select Part Parameters +Add Problem Dates +Add Content Dates
+Add Discussion Settings +Add Visibilities
+Add Part Parameters 		-Unselect All +Unselect All
'); @@ -836,7 +941,9 @@ sub partmenu { $r->print('>'.&mt('All Parts').''); my %temphash=(); foreach (@{$psprt}) { $temphash{$_}=1; } - foreach my $tempkey (sort keys %{$allparts}) { + foreach my $tempkey (sort { + if ($a==$b) { return ($a cmp $b) } else { return ($a <=> $b); } + } keys(%{$allparts})) { unless ($tempkey =~ /\./) { $r->print('\n"); + } + $r->print("\n"); } - $r->print("\n"); } sub keysplit { @@ -978,6 +1067,18 @@ sub keysinorder { } (keys %{$name}); } +sub keysinorder_bytype { + my ($name,$keyorder)=@_; + return sort { + my $ta=(split('_',$a))[-1]; + my $tb=(split('_',$b))[-1]; + if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) { + return ($a cmp $b); + } + $$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb}; + } (keys %{$name}); +} + sub keysindisplayorder { my ($name,$keyorder)=@_; return sort { @@ -985,6 +1086,21 @@ sub keysindisplayorder { } (keys %{$name}); } +sub sortmenu { + my ($r,$sortorder)=@_; + $r->print('

'); +} + sub standardkeyorder { return ('parameter_0_opendate' => 1, 'parameter_0_duedate' => 2, @@ -1003,7 +1119,9 @@ sub standardkeyorder { 'parameter_0_ordered' => 15, 'parameter_0_tol' => 16, 'parameter_0_sig' => 17, - 'parameter_0_turnoffunit' => 18); + 'parameter_0_turnoffunit' => 18, + 'parameter_0_discussend' => 19, + 'parameter_0_discusshide' => 20); } ################################################## @@ -1061,7 +1179,7 @@ sub assessparms { my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'}; $alllevs{'Resource Level'}='full'; - $alllevs{'Map Level'}='map'; + $alllevs{'Map/Folder Level'}='map'; $alllevs{'Course Level'}='general'; my %allparms; @@ -1212,7 +1330,9 @@ sub assessparms { } else { my ($map,$id,$resource)=&Apache::lonnet::decode_symb($pssymb); $r->print(&mt('Specific Resource').": ".$resource. - ''); + ''. + '

'); } &usermenu($r,$uname,$id,$udom,$csec); @@ -1357,14 +1477,9 @@ ENDTABLEHEADFOUR $r->print(''); + '>'.$maptitles{$mapp{$rid}}.''); - $r->print(' / res / '); - $r->print(join(' / ', split(/\//,$mapp{$rid}))); - - $r->print(''); - - foreach (&keysinorder(\%name,\%keyorder)) { + foreach (&keysinorder_bytype(\%name,\%keyorder)) { unless ($firstrow) { $r->print(''); } else { @@ -1654,9 +1769,13 @@ sub crsenv { # # Let the user know we made the changes if ($name && defined($value)) { + 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); } my $put_result = &Apache::lonnet::put('environment', {$name=>$value},$dom,$crs); @@ -1673,6 +1792,18 @@ sub crsenv { $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'). + '.
'; + } } } # ------------------------- Re-init course environment entries for this session @@ -1779,8 +1910,8 @@ sub crsenv { 'anonymous_quiz' => ''.&mt('Anonymous quiz/exam').'
'. ' ('.&mt('yes').' '.&mt('to avoid print students names').' )', - 'default_enrollment_start_date' => ''.&mt('Default beginning date when enrolling students').'', - 'default_enrollment_end_date' => ''.&mt('Default ending date when enrolling students').'', + 'default_enrollment_start_date' => ''.&mt('Default beginning date for student access.').'', + 'default_enrollment_end_date' => ''.&mt('Default ending date for student access.').'', 'nothideprivileged' => ''.&mt('Privileged users that should not be hidden on staff listings').''. '
(user:domain,user:domain,...)', 'languages' => ''.&mt('Languages used').'', @@ -1790,6 +1921,9 @@ sub crsenv { 'disablesigfigs' => ''.&mt('Disable checking of Significant Figures').'
'. ' ('.&mt('"[_1]" to disable, anything else if not','yes').')', + 'disableexampointprint' + => ''.&mt('Disable automatically printing point values onto exams.').'
'. + ' ('.&mt('"[_1]" to disable, anything else if not','yes').')', 'tthoptions' => ''.&mt('Default set of options to pass to tth/m when converting tex').'' ); @@ -1816,10 +1950,11 @@ sub crsenv { 'default_enrollment_start_date', 'default_enrollment_end_date', 'tthoptions', - 'disablesigfigs' + 'disablesigfigs', + 'disableexampointprint' ); foreach my $parameter (sort(keys(%values))) { - unless ($parameter =~ m/^internal\./) { + unless (($parameter =~ m/^internal\./)||($parameter =~ m/^metadata\./)) { if (! $descriptions{$parameter}) { $descriptions{$parameter}=$parameter; push(@Display_Order,$parameter); @@ -1967,9 +2102,12 @@ sub storedata { } if ($cmd eq 'set') { my $data=$env{$_}; - if ($$olddata{$thiskey} ne $data) { + my $typeof=$env{'form.typeof_'.$thiskey}; + if ($$olddata{$thiskey} ne $data) { if ($tuname) { - if (&Apache::lonnet::put('resourcedata',{$tkey=>$data},$tudom,$tuname) eq 'ok') { + if (&Apache::lonnet::put('resourcedata',{$tkey=>$data, + $tkey.'.type' => $typeof}, + $tudom,$tuname) eq 'ok') { $r->print('
'.&mt('Stored modified parameter for').' '. &Apache::loncommon::plainname($tuname,$tudom)); } else { @@ -1979,7 +2117,8 @@ sub storedata { &Apache::lonnet::devalidateuserresdata($tuname,$tudom); } else { $newdata{$thiskey}=$data; - } + $newdata{$thiskey.'.type'}=$typeof; + } } } elsif ($cmd eq 'del') { if ($tuname) { @@ -1995,9 +2134,12 @@ sub storedata { } } 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},$tudom,$tuname) eq 'ok') { + if (&Apache::lonnet::put('resourcedata',{$tkey=>$data, + $tkey.'.type' => $typeof}, + $tudom,$tuname) eq 'ok') { $r->print('
'.&mt('Stored modified date for').' '.&Apache::loncommon::plainname($tuname,$tudom)); } else { $r->print('

'. @@ -2005,7 +2147,8 @@ sub storedata { } &Apache::lonnet::devalidateuserresdata($tuname,$tudom); } else { - $newdata{$thiskey}=$data; + $newdata{$thiskey}=$data; + $newdata{$thiskey.'.type'}=$typeof; } } } @@ -2026,7 +2169,7 @@ sub storedata { } if ($putentries) { if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') { - $r->print('

'.&mt('Stored [_1] parameter(s)

',$putentries)); + $r->print('

'.&mt('Stored [_1] parameter(s)',$putentries/2).'

'); } else { $r->print('

'. &mt('Error storing parameters').'

'); @@ -2041,7 +2184,7 @@ sub extractuser { } sub listdata { - my ($r,$resourcedata,$listdata)=@_; + my ($r,$resourcedata,$listdata,$sortorder)=@_; # Start list output my $oldsection=''; @@ -2050,7 +2193,41 @@ sub listdata { my $pointer=0; $tableopen=0; my $foundkeys=0; - foreach my $thiskey (sort keys %{$listdata}) { + my %keyorder=&standardkeyorder(); + foreach my $thiskey (sort { + 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); + } + } else { + $a cmp $b; + } + } keys %{$listdata}) { + if ($$listdata{$thiskey.'.type'}) { my $thistype=$$listdata{$thiskey.'.type'}; if ($$resourcedata{$thiskey.'.type'}) { @@ -2077,40 +2254,88 @@ sub listdata { my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle); $realm=''.&mt('Resource').': '.&Apache::lonnet::gettitle($middle).'
('.$url.' in '.$map.' id: '.$id.')'; } - if ($section ne $oldsection) { - $r->print(&tableend()."\n

$section

"); - $oldsection=$section; - $oldrealm=''; - } - if ($realm ne $oldrealm) { - $r->print(&tableend()."\n

$realm

"); - $oldrealm=$realm; - $oldpart=''; + if ($sortorder eq 'realmstudent') { + if ($realm ne $oldrealm) { + $r->print(&tableend()."\n

$realm

"); + $oldrealm=$realm; + $oldsection=''; + } + if ($section ne $oldsection) { + $r->print(&tableend()."\n

$section

"); + $oldsection=$section; + $oldpart=''; + } + } else { + if ($section ne $oldsection) { + $r->print(&tableend()."\n

$section

"); + $oldsection=$section; + $oldrealm=''; + } + if ($realm ne $oldrealm) { + $r->print(&tableend()."\n

$realm

"); + $oldrealm=$realm; + $oldpart=''; + } } if ($part ne $oldpart) { $r->print(&tableend(). - "\n

".&mt('Part').": $part

"); + "\n".&mt('Part').": $part"); $oldpart=$part; } # +# Preset defaults? +# + my ($hour,$min,$sec,$val)=('','','',''); + unless ($$resourcedata{$thiskey}) { + my ($parmname)=($thiskey=~/\.(\w+)$/); + ($hour,$min,$sec,$val)=&preset_defaults($parmname); + } + +# # Ready to print # $r->print(&tablestart().''.$name. ':'); $foundkeys++; - if ($thistype=~/^date/) { + if (&isdateparm($thistype)) { my $jskey='key_'.$pointer; $pointer++; $r->print( - &Apache::lonhtmlcommon::date_setter('overviewform', + &Apache::lonhtmlcommon::date_setter('parmform', $jskey, - $$resourcedata{$thiskey}). + $$resourcedata{$thiskey}, + '',1,'','',$hour,$min,$sec). '' ); + } elsif ($thistype eq 'string_yesno') { + my $showval; + if (defined($$resourcedata{$thiskey})) { + $showval=$$resourcedata{$thiskey}; + } else { + $showval=$val; + } + $r->print(' '); + $r->print(''); } else { + my $showval; + if (defined($$resourcedata{$thiskey})) { + $showval=$$resourcedata{$thiskey}; + } else { + $showval=$val; + } $r->print(''); + $showval.'">'); } $r->print(''); @@ -2122,8 +2347,7 @@ sub listdata { sub newoverview { my $r=shift; - my $bodytag=&Apache::loncommon::bodytag( - 'Set Course Assessment Parameters'); + my $bodytag=&Apache::loncommon::bodytag('Set Parameters'); my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $crs = $env{'course.'.$env{'request.course.id'}.'.num'}; my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Overview'); @@ -2152,7 +2376,7 @@ ENDOVER my %alllevs=(); $alllevs{'Resource Level'}='full'; - $alllevs{'Map Level'}='map'; + $alllevs{'Map/Folder Level'}='map'; $alllevs{'Course Level'}='general'; my $csec=$env{'form.csec'}; @@ -2201,8 +2425,14 @@ ENDOVER &partmenu($r,\%allparts,\@psprt); $r->print(''); §ionmenu($r,\@selected_sections); + $r->print(''); - + + my $sortorder=$env{'form.sortorder'}; + unless ($sortorder) { $sortorder='realmstudent'; } + &sortmenu($r,$sortorder); + + $r->print('

'); # Build the list data hash from the specified parms @@ -2212,35 +2442,40 @@ ENDOVER foreach my $cat (@pscat) { foreach my $section (@selected_sections) { foreach my $part (@psprt) { - my $newparmkey=$env{'request.course.id'}; + my $rootparmkey=$env{'request.course.id'}; if (($section ne 'all') && ($section ne 'none') && ($section)) { - $newparmkey.='.['.$section.']'; + $rootparmkey.='.['.$section.']'; } if ($parmlev eq 'general') { # course-level parameter + my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat; + $$listdata{$newparmkey}=1; + $$listdata{$newparmkey.'.type'}=$defkeytype{$cat}; } elsif ($parmlev eq 'map') { - foreach my $map (keys %allmaps) { - if (($pschp ne 'all') && ($pschp ne $map)) { next; } - $newparmkey.='.'.$allmaps{$map}.'.'.$part.'.'.$cat; +# map-level parameter + foreach my $mapid (keys %allmaps) { + if (($pschp ne 'all') && ($pschp ne $mapid)) { next; } + my $newparmkey=$rootparmkey.'.'.$allmaps{$mapid}.'___(all).'.$part.'.'.$cat; $$listdata{$newparmkey}=1; $$listdata{$newparmkey.'.type'}=$defkeytype{$cat}; } -# map-level parameter } else { # resource-level parameter - + foreach my $rid (@ids) { + my ($map,$resid,$url)=&Apache::lonnet::decode_symb($symbp{$rid}); + if (($pschp ne 'all') && ($allmaps{$pschp} ne $map)) { next; } + my $newparmkey=$rootparmkey.'.'.$symbp{$rid}.'.'.$part.'.'.$cat; + $$listdata{$newparmkey}=1; + $$listdata{$newparmkey.'.type'}=$defkeytype{$cat}; + } } } } } + if (($env{'form.store'}) || ($env{'form.dis'})) { - - $r->print(join("\n
",keys %{$listdata})); - - if ($env{'form.dis'}) { - - &storedata($r,$crs,$dom); + if ($env{'form.store'}) { &storedata($r,$crs,$dom); } # Read modified data @@ -2248,16 +2483,16 @@ ENDOVER # List data - &listdata($r,$resourcedata,$listdata); + &listdata($r,$resourcedata,$listdata,$sortorder); } $r->print(&tableend(). - '

'); + ((($env{'form.store'}) || ($env{'form.dis'}))?'

':''). + ''); } sub overview { my $r=shift; - my $bodytag=&Apache::loncommon::bodytag( - 'Modify Course Assessment Parameters'); + my $bodytag=&Apache::loncommon::bodytag('Modify Parameters'); my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $crs = $env{'course.'.$env{'request.course.id'}.'.num'}; my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Overview'); @@ -2269,7 +2504,7 @@ $html $bodytag $breadcrumbs -
+ ENDOVER # Store modified @@ -2279,9 +2514,14 @@ ENDOVER my $resourcedata=&readdata($crs,$dom); + + my $sortorder=$env{'form.sortorder'}; + unless ($sortorder) { $sortorder='realmstudent'; } + &sortmenu($r,$sortorder); + # List data - my $foundkeys=&listdata($r,$resourcedata,$resourcedata); + my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder); $r->print(&tableend().'

'. ($foundkeys?'':&mt('There are no parameters.')).'

'); @@ -2291,25 +2531,76 @@ ENDOVER ################################################## =pod - -=item change clone - + +=item check_cloners + +Checks if new users included in list of allowed cloners +are valid users. Replaces supplied list with +cleaned list containing only users with valid usernames +and domains. + +Inputs: $clonelist, $oldcloner +where $clonelist is ref to array of requested cloners, +and $oldcloner is ref to array of currently allowed +cloners. + +Returns: string - comma separated list of requested +cloners (username:domain) who do not exist in system. + +=item change_clone + Modifies the list of courses a user can clone (stored -in the user's environemnt.db file), called when a +in the user's environment.db file), called when a change is made to the list of users allowed to clone a course. - + Inputs: $action,$cloner where $action is add or drop, and $cloner is identity of user for whom cloning ability is to be changed in course. - -Returns: =cut ################################################## ################################################## +sub extract_cloners { + my ($clonelist,$allowclone) = @_; + if ($clonelist =~ /,/) { + @{$allowclone} = split/,/,$clonelist; + } else { + $$allowclone[0] = $clonelist; + } +} + + +sub check_cloners { + my ($clonelist,$oldcloner) = @_; + my ($clean_clonelist,$disallowed); + my @allowclone = (); + &extract_cloners($$clonelist,\@allowclone); + foreach my $currclone (@allowclone) { + if (!grep/^$currclone$/,@$oldcloner) { + my ($uname,$udom) = split/:/,$currclone; + if ($uname && $udom) { + if (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') { + $disallowed .= $currclone.','; + } else { + $clean_clonelist .= $currclone.','; + } + } + } else { + $clean_clonelist .= $currclone.','; + } + } + if ($disallowed) { + $disallowed =~ s/,$//; + } + if ($clean_clonelist) { + $clean_clonelist =~ s/,$//; + } + $$clonelist = $clean_clonelist; + return $disallowed; +} sub change_clone { my ($clonelist,$oldcloner) = @_; @@ -2319,12 +2610,8 @@ sub change_clone { my $clone_crs = $cnum.':'.$cdom; if ($cnum && $cdom) { - my @allowclone = (); - if ($clonelist =~ /,/) { - @allowclone = split/,/,$clonelist; - } else { - $allowclone[0] = $clonelist; - } + my @allowclone; + &extract_cloners($clonelist,\@allowclone); foreach my $currclone (@allowclone) { if (!grep/^$currclone$/,@$oldcloner) { ($uname,$udom) = split/:/,$currclone; @@ -2415,28 +2702,31 @@ ENDMAINFORMHEAD action => 'crsenv', permission => $parm_permission, }, - { text => 'Set/Modify Course Assessment Parameters - Helper Mode', + { text => 'Set Portfolio Metadata', + action => 'setrestrictmeta', + permission => $parm_permission, + }, + { text => 'Set/Modify Resource Parameters - Helper Mode', url => '/adm/helper/parameter.helper', permission => $parm_permission, }, - { text => 'Modify Course Assessment Parameters - Overview Mode', + { text => 'Modify Resource Parameters - Overview Mode', action => 'setoverview', permission => $parm_permission, }, - { text => 'Set Course Assessment Parameters - Overview Mode', + { text => 'Set Resource Parameters - Overview Mode', action => 'newoverview', permission => $parm_permission, }, - { text => 'Set/Modify Course Assessment Parameters - Table Mode', + { text => 'Set/Modify Resource Parameters - Table Mode', action => 'settable', permission => $parm_permission, help => 'Cascading_Parameters', }, -# { text => 'Set Parameter Default Preferences', -# help => 'Course_View_Class_List', -# action => 'setdefaults', -# permission => $parm_permission, -# }, + { text => 'Set Parameter Setting Default Actions', + action => 'setdefaults', + permission => $parm_permission, + }, ); my $menu_html = ''; foreach my $menu_item (@menu) { @@ -2459,9 +2749,259 @@ ENDMAINFORMHEAD $r->print($menu_html); return; } +### Set portfolio metadata +sub output_row { + my ($r, $field_name, $field_text) = @_; + my $output; + my $options=$env{'course.'.$env{'request.course.id'}.'.'.$field_name.'.options'}; + my $values=$env{'course.'.$env{'request.course.id'}.'.'.$field_name.'.values'}; + my $checked; + unless (defined($options)) { + $options = 'active,stuadd'; + $values = ''; + } + $output.=''.$field_text.':'; + $output.='
'; + if ($options =~ m/active/) { + $checked = ' checked="checked" '; + } else { + $checked = ' '; + } + $output.='     '; + $output.='Show to student
'; + if ($options =~ m/onlyone/) { + $checked = ' checked="checked" '; + } else { + $checked = ' '; + } + $output.='     '; + $output.='Student may select only one choice
'; + if ($options =~ m/stuadd/) { + $checked = ' checked="checked" '; + } else { + $checked = ' '; + } + $output.='     '; + $output.='Student may type choices
'; + return ($output); +} + +sub setrestrictmeta { + my ($r)=@_; + my $next_meta; + my $output; + my $item_num; + my $put_result; + $r->print(&Apache::lonxml::xmlbegin()); + $r->print(' + LON-CAPA Restrict Metadata + '); + $r->print(&Apache::loncommon::bodytag('Restrict Metadata')); + $r->print(&Apache::lonhtmlcommon::breadcrumbs(undef, + 'Restrict Metadata')); + my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $crs = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $key_base = $env{'course.'.$env{'request.course.id'}.'.'}; + my $save_field = ''; + if ($env{'form.restrictmeta'}) { + foreach my $field (sort(keys(%env))) { + if ($field=~m/^form.(.+)_(.+)$/) { + my $options; + my $meta_field = $1; + my $meta_key = $2; + if ($save_field ne $meta_field) { + $save_field = $meta_field; + if ($env{'form.'.$meta_field.'_stuadd'}) { + $options.='stuadd,'; + } + if ($env{'form.'.$meta_field.'_onlyone'}) { + $options.='onlyone,'; + } + if ($env{'form.'.$meta_field.'_active'}) { + $options.='active,'; + } + my $name = $save_field; + $put_result = &Apache::lonnet::put('environment', + {'metadata.'.$meta_field.'.options'=>$options, + 'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'}, + },$dom,$crs); + } + } + } + } + &Apache::lonnet::coursedescription($env{'request.course.id'}); + my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio'); + foreach my $field (sort(keys(%metadata_fields))) { + $output.= &output_row($r, $field, $metadata_fields{$field}); + } + $r->print(< +

+ $output + + +ENDenv + $r->print(' + '); + return 'ok'; +} +################################################## +sub defaultsetter { + my $r=shift; + my $bodytag=&Apache::loncommon::bodytag('Parameter Setting Default Actions'); + my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $crs = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Defaults'); + my $html=&Apache::lonxml::xmlbegin(); + $r->print(< +LON-CAPA Parameters + +$bodytag +$breadcrumbs +

+ENDDEFHEAD + my @ids=(); + my %typep=(); + my %keyp=(); + my %allparms=(); + my %allparts=(); + my %allmaps=(); + my %mapp=(); + my %symbp=(); + my %maptitles=(); + my %uris=(); + my %keyorder=&standardkeyorder(); + my %defkeytype=(); - + &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps, + \%mapp, \%symbp,\%maptitles,\%uris, + \%keyorder,\%defkeytype); + if ($env{'form.storerules'}) { + my %newrules=(); + my @delrules=(); + my %triggers=(); + foreach my $key (keys(%env)) { + if ($key=~/^form\.(\w+)\_action$/) { + my $tempkey=$1; + my $action=$env{$key}; + if ($action) { + $newrules{$tempkey.'_action'}=$action; + if ($action ne 'default') { + my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/); + $triggers{$whichparm}.=$tempkey.':'; + } + $newrules{$tempkey.'_type'}=$defkeytype{$tempkey}; + if (&isdateparm($defkeytype{$tempkey})) { + $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'}; + $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'}; + $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'}; + $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'}; + } else { + $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'}; + $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'}; + } + } else { + push(@delrules,$tempkey.'_action'); + push(@delrules,$tempkey.'_type'); + push(@delrules,$tempkey.'_hours'); + push(@delrules,$tempkey.'_min'); + push(@delrules,$tempkey.'_sec'); + push(@delrules,$tempkey.'_value'); + } + } + } + foreach my $key (keys %allparms) { + $newrules{$key.'_triggers'}=$triggers{$key}; + } + &Apache::lonnet::put('parmdefactions',\%newrules,$dom,$crs); + &Apache::lonnet::del('parmdefactions',\@delrules,$dom,$crs); + &resetrulescache(); + } + my %lt=&Apache::lonlocal::texthash('days' => 'Days', + 'hours' => 'Hours', + 'min' => 'Minutes', + 'sec' => 'Seconds', + 'yes' => 'Yes', + 'no' => 'No'); + my @standardoptions=('','default'); + my @standarddisplay=('',&mt('Default value when manually setting')); + my @dateoptions=('','default'); + my @datedisplay=('',&mt('Default value when manually setting')); + foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) { + unless ($tempkey) { next; } + push @standardoptions,'when_setting_'.$tempkey; + push @standarddisplay,&mt('Automatically set when setting ').$tempkey; + if (&isdateparm($defkeytype{$tempkey})) { + push @dateoptions,'later_than_'.$tempkey; + push @datedisplay,&mt('Automatically set later than ').$tempkey; + push @dateoptions,'earlier_than_'.$tempkey; + push @datedisplay,&mt('Automatically set earlier than ').$tempkey; + } + } +$r->print(&mt('Manual setting rules apply to all interfaces.').'
'. + &mt('Automatic setting rules apply to table mode interfaces only.')); + $r->print("\n'); + foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) { + unless ($tempkey) { next; } + $r->print("\n'); + } + $r->print("
".&mt('Rule for parameter').''. + &mt('Action').''.&mt('Value').'
".$allparms{$tempkey}."\n
(".$tempkey.')		'); + my $action=&rulescache($tempkey.'_action'); + $r->print(''); + unless (&isdateparm($defkeytype{$tempkey})) { + $r->print("\n
".&mt('Triggering value(s) of other parameter (optional, comma-separated):'). + ''); + } + $r->print("\n		\n"); + + if (&isdateparm($defkeytype{$tempkey})) { + my $days=&rulescache($tempkey.'_days'); + my $hours=&rulescache($tempkey.'_hours'); + my $min=&rulescache($tempkey.'_min'); + my $sec=&rulescache($tempkey.'_sec'); + $r->print(<$lt{'days'}
+$lt{'hours'}
+$lt{'min'}
+$lt{'sec'} +ENDINPUTDATE + } elsif ($defkeytype{$tempkey} eq 'string_yesno') { + my $yeschecked=''; + my $nochecked=''; + if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked='checked="checked"'; } + if (&rulescache($tempkey.'_value') eq 'no') { $nochecked='checked="checked"'; } + + $r->print(< $lt{'yes'}
+ +ENDYESNO + } else { + $r->print(''); + } + $r->print('
\n
\n\n"); + return; +} ################################################## ################################################## @@ -2475,7 +3015,9 @@ Main handler. Calls &assessparms and &c =cut ################################################## ################################################## - use Data::Dumper; +# use Data::Dumper; + + sub handler { my $r=shift; @@ -2489,7 +3031,7 @@ sub handler { 'pres_marker', 'pres_value', 'pres_type', - 'udom','uname']); + 'udom','uname','symb','serial']); &Apache::lonhtmlcommon::clear_breadcrumbs(); @@ -2531,18 +3073,24 @@ sub handler { } elsif ($env{'form.action'} eq 'crsenv' && $parm_permission) { &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=crsenv', text=>"Course Environment"}); - $r->print(&Apache::lonhtmlcommon::breadcrumbs(undef, - 'Edit Course Environment')); &crsenv($r); } elsif ($env{'form.action'} eq 'setoverview' && $parm_permission) { &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview', text=>"Overview Mode"}); &overview($r); + } elsif ($env{'form.action'} eq 'setrestrictmeta' && $parm_permission) { + &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta', + text=>"Restrict Metadata"}); + &setrestrictmeta($r); } elsif ($env{'form.action'} eq 'newoverview' && $parm_permission) { &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview', text=>"Overview Mode"}); &newoverview($r); - } elsif ($env{'form.action'} eq 'settable' && $parm_permission) { + } elsif ($env{'form.action'} eq 'setdefaults' && $parm_permission) { + &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults', + text=>"Set Defaults"}); + &defaultsetter($r); + } elsif ($env{'form.action'} eq 'settable' && $parm_permission) { &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable', text=>"Table Mode", help => 'Course_Setting_Parameters'});