--- loncom/interface/lonparmset.pm 2005/06/03 15:47:29 1.204
+++ loncom/interface/lonparmset.pm 2005/11/17 20:04:05 1.267
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
-# $Id: lonparmset.pm,v 1.204 2005/06/03 15:47:29 www Exp $
+# $Id: lonparmset.pm,v 1.267 2005/11/17 20:04:05 albertel 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,59 @@ 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);
+# don't do anything if parameter was reset
+ unless ($nval) { return; }
+ 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 +489,7 @@ sub valout {
$result.=$sec.' secs ';
}
$result=~s/\s+$//;
- } elsif ($type=~/^date/) {
+ } elsif (&isdateparm($type)) {
$result = localtime($value);
} else {
$result = $value;
@@ -434,35 +520,29 @@ 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).'';
}
sub startpage {
- my ($r,$id,$udom,$csec,$uname,$have_assessments)=@_;
+ my $r=shift;
my $bodytag=&Apache::loncommon::bodytag('Set/Modify Course Parameters','',
'onUnload="pclose()"');
my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Table Mode Parameter Setting');
- my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
- &Apache::loncommon::selectstudent_link('parmform','uname','udom');
my $selscript=&Apache::loncommon::studentbrowser_javascript();
my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
- my %lt=&Apache::lonlocal::texthash(
- 'captm' => "Course Assessments Parameters - Table Mode",
- 'sg' => "Section/Group",
- 'fu' => "For User",
- 'oi' => "or ID",
- 'ad' => "at Domain"
- );
my $html=&Apache::lonxml::xmlbegin();
$r->print(<
$bodytag
$breadcrumbs
-ENDHEAD
- my %sectionhash=();
- my $sections='';
- if (&Apache::loncommon::get_sections(
- $env{'course.'.$env{'request.course.id'}.'.domain'},
- $env{'course.'.$env{'request.course.id'}.'.num'},
- \%sectionhash)) {
- $sections=$lt{'sg'}.': ';
- }
- $r->print(<
-
$lt{'captm'}
-ENDHEAD3
-
- if (!$have_assessments) {
- $r->print(''.&mt('There are no assessment parameters in this course to set.').' ');
- } else {
- $r->print(<
-$sections
-
-$lt{'fu'}
-
-$lt{'oi'}
-
-$lt{'ad'}
-$chooseopt
-
+
ENDHEAD
- }
}
+
sub print_row {
my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
$defbgtwo,$parmlev,$uname,$udom,$csec)=@_;
@@ -582,7 +631,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;
@@ -635,11 +687,6 @@ sub print_row {
if ($parmlev eq 'full') {
my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
'.'.$$name{$which},$$symbp{$rid});
-
-# this doesn't seem to work, and I don't think is correct
-# my $sessionvaltype=&Apache::lonnet::EXT('resource.'.$$part{$which}.
-# '.'.$$name{$which}.'.type',$symbp{$rid});
-# this seems to work
my $sessionvaltype=$typeoutpar[$result];
if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; }
$r->print('
'.
@@ -705,15 +752,15 @@ sub extractResourceInformation {
my $keyp = shift;
my $allparms = shift;
my $allparts = shift;
- my $allkeys = shift;
my $allmaps = shift;
- my $fcat = shift;
- my $defp = shift;
my $mapp = shift;
my $symbp = shift;
my $maptitles=shift;
my $uris=shift;
+ my $keyorder=shift;
+ my $defkeytype=shift;
+ my $keyordercnt=100;
my $navmap = Apache::lonnavmaps::navmap->new();
my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
@@ -730,30 +777,40 @@ sub extractResourceInformation {
foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
if ($_=~/^parameter\_(.*)/) {
my $key=$_;
- my $allkey=$1;
- $allkey=~s/\_/\./g;
- if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq
- 'parm') {
- next; #hide hidden things
+# Hidden parameters
+ if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 'parm') {
+ next;
}
my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
+#
+# allparms is a hash of parameter names
+#
my $parmdis = $display;
- $parmdis =~ s|(\[Part.*)$||g;
- my $partkey = $part;
- $partkey =~ tr|_|.|;
- $$allparms{$name} = $parmdis;
- $$allparts{$part} = "[Part $part]";
- $$allkeys{$allkey}=$display;
- if ($allkey eq $fcat) {
- $$defp{$id}= &Apache::lonnet::metadata($srcf,$key);
- }
+ $parmdis =~ s/\[Part.*$//g;
+ $$allparms{$name}=$parmdis;
+ $$defkeytype{$name}=&Apache::lonnet::metadata($srcf,$key.'.type');
+#
+# allparts is a hash of all parts
+#
+ $$allparts{$part} = "Part: $part";
+#
+# Remember all keys going with this resource
+#
if ($$keyp{$id}) {
$$keyp{$id}.=','.$key;
} else {
$$keyp{$id}=$key;
}
+#
+# Put in order
+#
+ unless ($$keyorder{$key}) {
+ $$keyorder{$key}=$keyordercnt;
+ $keyordercnt++;
+ }
+
}
}
$$mapp{$id}=
@@ -771,6 +828,304 @@ sub extractResourceInformation {
}
}
+
+##################################################
+##################################################
+
+sub isdateparm {
+ my $type=shift;
+ return (($type=~/^date/) && (!($type eq 'date_interval')));
+}
+
+sub parmmenu {
+ my ($r,$allparms,$pscat,$keyorder)=@_;
+ my $tempkey;
+ $r->print(<
+ function checkall(value, checkName) {
+ for (i=0; i
+ENDSCRIPT
+ $r->print();
+ $r->print("\n
');
} else {
@@ -1333,7 +1544,7 @@ ENDTABLEHEADFOUR
# When storing information, store as part 0
# When requesting information, request from full part
#-------------------------------------------------------------------
- foreach (split(/\,/,$keyp{$rid})) {
+ foreach (&keysplit($keyp{$rid})) {
my $tempkeyp = $_;
my $fullkeyp = $tempkeyp;
$tempkeyp =~ s/_\w+_/_0_/;
@@ -1362,10 +1573,7 @@ Set Defaults for All Resources in $folde
Specifically for
ENDMAPONE
if ($uname) {
- my %name=&Apache::lonnet::userenvironment($udom,$uname,
- ('firstname','middlename','lastname','generation', 'id'));
- my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
- .$name{'lastname'}.' '.$name{'generation'};
+ my $person=&Apache::loncommon::plainname($uname,$udom);
$r->print(&mt("User")." $uname \($person\) ".
&mt('in')." \n");
} else {
@@ -1383,12 +1591,11 @@ ENDMAPONE
$r->print('