--- loncom/interface/lonparmset.pm 2005/06/17 18:11:42 1.224 +++ loncom/interface/lonparmset.pm 2005/06/18 17:23:25 1.229 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set parameters for assessments # -# $Id: lonparmset.pm,v 1.224 2005/06/17 18:11:42 www Exp $ +# $Id: lonparmset.pm,v 1.229 2005/06/18 17:23:25 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -260,6 +260,20 @@ sub rulescache { 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 ('','','','',''); + } +} + ################################################## ################################################## # @@ -291,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 @@ -460,11 +524,13 @@ sub plink { $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]}; } } - - + my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/); + &Apache::lonnet::logthis($marker.'-'.$parmname); + my ($hour,$min,$sec,$val)=&preset_defaults($parmname); + unless (defined($winvalue)) { $winvalue=$val; } return ''. + .$marker."','".$return."','".$call."','".$hour."','".$min."','".$sec."'".');">'. &valout($value,$type).''; } @@ -2590,32 +2656,46 @@ ENDDEFHEAD if ($env{'form.storerules'}) { my %newrules=(); my @delrules=(); - foreach (keys %env) { - if ($_=~/^form\.(\w+)\_action$/) { + my %triggers=(); + foreach my $key (keys(%env)) { + if ($key=~/^form\.(\w+)\_action$/) { my $tempkey=$1; - if ($env{$_}) { - $newrules{$tempkey.'_action'}=$env{$_}; + 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.'_hours'; - push @delrules,$tempkey.'_min'; - push @delrules,$tempkey.'_sec'; - push @delrules,$tempkey.'_value'; + 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('hours' => 'Hours', + my %lt=&Apache::lonlocal::texthash('days' => 'Days', + 'hours' => 'Hours', 'min' => 'Minutes', 'sec' => 'Seconds', 'yes' => 'Yes', @@ -2658,15 +2738,19 @@ ENDDEFHEAD } } $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'}