--- 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