--- loncom/interface/lonparmset.pm 2005/06/02 16:35:32 1.200 +++ loncom/interface/lonparmset.pm 2005/06/04 15:26:13 1.207 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set parameters for assessments # -# $Id: lonparmset.pm,v 1.200 2005/06/02 16:35:32 www Exp $ +# $Id: lonparmset.pm,v 1.207 2005/06/04 15:26:13 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -68,20 +68,11 @@ use Apache::lonnavmaps; my $parmhashid; my %parmhash; +my $symbsid; +my %symbs; # --- end local caches -# -# FIXME: get rid of items below -# -my @ids; -my %symbp; -my %mapp; -my %typep; -my %keyp; -my %uris; -my %maptitles; - ################################################## ################################################## @@ -112,9 +103,13 @@ Returns: A list, the first item is the =cut ################################################## -################################################## sub parmval { my ($what,$id,$def,$uname,$udom,$csec)=@_; + return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec); +} + +sub parmval_by_symb { + my ($what,$symb,$def,$uname,$udom,$csec)=@_; # load caches &cacheparmhash(); @@ -128,9 +123,10 @@ sub parmval { my $result=''; my @outpar=(); # ----------------------------------------------------- Cascading lookup scheme + my $map=(&Apache::lonnet::decode_symb($symb))[0]; - my $symbparm=$symbp{$id}.'.'.$what; - my $mapparm=$mapp{$id}.'___(all).'.$what; + my $symbparm=$symb.'.'.$what; + my $mapparm=$map.'___(all).'.$what; my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what; my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm; @@ -180,8 +176,7 @@ sub parmval { } if (defined($$courseopt{$seclevelr})) { - $outpar[4]=$$courseopt -{$seclevelr}; + $outpar[4]=$$courseopt{$seclevelr}; $result=4; } } @@ -222,6 +217,29 @@ sub cacheparmhash { } } +sub resetsymbcache { + $symbsid=''; +} + +sub symbcache { + my $id=shift; + if ($symbsid ne $env{'request.course.id'}) { + %symbs=(); + } + unless ($symbs{$id}) { + my $navmap = Apache::lonnavmaps::navmap->new(); + if ($id=~/\./) { + my $resource=$navmap->getById($id); + $symbs{$id}=$resource->symb(); + } else { + my $resource=$navmap->getByMapPc($id); + $symbs{$id}=&Apache::lonnet::declutter($resource->src()); + } + $symbsid=$env{'request.course.id'}; + } + return $symbs{$id}; +} + ################################################## ################################################## # @@ -238,14 +256,7 @@ sub cacheparmhash { sub storeparm { my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_; - my $navmap = Apache::lonnavmaps::navmap->new(); - if ($sresid=~/\./) { - my $resource=$navmap->getById($sresid); - &storeparm_by_symb($resource->symb(),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec); - } else { - my $resource=$navmap->getByMapPc($sresid); - &storeparm_by_symb(&Apache::lonnet::declutter($resource->src()),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec); - } + &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec); } # @@ -435,33 +446,23 @@ sub plink { &valout($value,$type).''; } - sub startpage { - my ($r,$id,$udom,$csec,$uname,$have_assesments,$trimheader)=@_; + my ($r,$id,$udom,$csec,$uname,$have_assessments)=@_; my $bodytag=&Apache::loncommon::bodytag('Set/Modify Course Parameters','', 'onUnload="pclose()"'); - my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Table'); + 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( - 'cep' => "Course Environment Parameters", - 'scep' => "Set Course Environment Parameters", - 'smcap' => "Set/Modify Course Assessment Parameter", - 'mcap' => "Modify Course Assessment Parameters", - 'caphm' => "Course Assessment Parameter - Helper Mode", - 'capom' => "Course Assessment Parameters - Overview Mode", 'captm' => "Course Assessments Parameters - Table Mode", 'sg' => "Section/Group", 'fu' => "For User", 'oi' => "or ID", 'ad' => "at Domain" ); - my $overallhelp= - &Apache::loncommon::help_open_menu('','Setting Parameters','Course_Setting_Parameters','',10,'Instructor Interface'); - my $assessparmhelp=&Apache::loncommon::help_open_topic("Cascading_Parameters","Assessment Parameters"); my $html=&Apache::lonxml::xmlbegin(); $r->print(< $bodytag $breadcrumbs -$overallhelp ENDHEAD - - unless ($trimheader) {$r->print(< -

$lt{'cep'}

- - -
-$assessparmhelp -
-

$lt{'caphm'}

- -
-
-
-

$lt{'capom'}

- -
-
-ENDHEAD2 - } my %sectionhash=(); my $sections=''; if (&Apache::loncommon::get_sections( @@ -552,8 +532,8 @@ ENDHEAD2

$lt{'captm'}

ENDHEAD3 - if (!$have_assesments) { - $r->print(''.&mt('There are no assesment parameters in this course to set.').'
'); + if (!$have_assessments) { + $r->print(''.&mt('There are no assessment parameters in this course to set.').'
'); } else { $r->print(< @@ -574,7 +554,7 @@ ENDHEAD } sub print_row { - my ($r,$which,$part,$name,$rid,$default,$defaulttype,$display,$defbgone, + my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone, $defbgtwo,$parmlev,$uname,$udom,$csec)=@_; # get the values for the parameter in cascading order # empty levels will remain empty @@ -596,7 +576,7 @@ sub print_row { } my $parm=$$display{$which}; - if ($parmlev eq 'full' || $parmlev eq 'brief') { + if ($parmlev eq 'full') { $r->print('' .$$part{$which}.''); } else { @@ -631,47 +611,30 @@ sub print_row { &print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - if ($parmlev eq 'brief') { - - &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - - if ($csec) { - &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - } - if ($uname) { - &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - } - } else { - - &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,9,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,8,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,9,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,8,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + + if ($csec) { + &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + } + if ($uname) { + &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); + } - if ($csec) { - &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - } - if ($uname) { - &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); - } - } # end of $brief if/else } # end of $parmlev if/else $r->print(''. &valout($outpar[$result],$typeoutpar[$result]).''); - if ($parmlev eq 'full' || $parmlev eq 'brief') { + 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 + '.'.$$name{$which},$$symbp{$rid}); my $sessionvaltype=$typeoutpar[$result]; if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; } $r->print(''. @@ -696,6 +659,7 @@ sub print_td { $r->print(''."\n"); } + =pod =item B: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes. @@ -835,6 +799,15 @@ Variables used (guessed by Jeremy): sub assessparms { my $r=shift; + + my @ids=(); + my %symbp=(); + my %mapp=(); + my %typep=(); + my %keyp=(); + my %uris=(); + my %maptitles=(); + # -------------------------------------------------------- Variable declaration my %allkeys=(); my %allmaps=(); @@ -879,7 +852,6 @@ sub assessparms { my $pssymb=''; my $parmlev=''; - my $trimheader=''; my $prevvisit=$env{'form.prevvisit'}; unless ($env{'form.parmlev'}) { @@ -898,13 +870,11 @@ sub assessparms { if (!@pscat) { @pscat=('all'); } $pschp=''; $parmlev = 'full'; - $trimheader='yes'; } elsif ($env{'form.symb'}) { $pssymb=$env{'form.symb'}; if (!@pscat) { @pscat=('all'); } $pschp=''; $parmlev = 'full'; - $trimheader='yes'; } else { $env{'form.url'}=''; } @@ -964,10 +934,15 @@ sub assessparms { # ---------------------------------------------------------- Anything to store? if ($env{'form.pres_marker'}) { - $message.=&storeparm(split(/\&/,$env{'form.pres_marker'}), - $env{'form.pres_value'}, - $env{'form.pres_type'}, - $uname,$udom,$csec); + my @markers=split(/\&\&\&/,$env{'form.pres_marker'}); + my @values=split(/\&\&\&/,$env{'form.pres_value'}); + my @types=split(/\&\&\&/,$env{'form.pres_type'}); + for (my $i=0;$i<=$#markers;$i++) { + $message.=&storeparm(split(/\&/,$markers[$i]), + $values[$i], + $types[$i], + $uname,$udom,$csec); + } # ---------------------------------------------------------------- Done storing $message.='

'.&mt('Changes can take up to 10 minutes before being active for all students.').&Apache::loncommon::help_open_topic('Caching').'

'; } @@ -989,16 +964,8 @@ sub assessparms { if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);} # ------------------------------------------------------------------ Start page - my $have_assesments=1; - if (scalar(keys(%allkeys)) eq 0) { $have_assesments=0; } + &startpage($r,$id,$udom,$csec,$uname,scalar(keys(%allkeys))); - $trimheader = 'yes'; - &startpage($r,$id,$udom,$csec,$uname,$have_assesments,$trimheader); - -# if ($env{'form.url'}) { -# $r->print(''); -# } $r->print(''); foreach ('tolerance','date_default','date_start','date_end', @@ -1173,7 +1140,7 @@ sub assessparms { my $csuname=$env{'user.name'}; my $csudom=$env{'user.domain'}; - if ($parmlev eq 'full' || $parmlev eq 'brief') { + if ($parmlev eq 'full') { my $coursespan=$csec?8:5; $r->print('

'); $r->print(''); @@ -1310,7 +1277,7 @@ ENDTABLEHEADFOUR undef $firstrow; } - &print_row($r,$_,\%part,\%name,$rid,\%default, + &print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default, \%type,\%display,$defbgone,$defbgtwo, $parmlev,$uname,$udom,$csec); } @@ -1319,7 +1286,7 @@ ENDTABLEHEADFOUR } # end foreach ids # -------------------------------------------------- End entry for one resource $r->print('
'); - } # end of brief/full + } # end of full #--------------------------------------------------- Entry for parm level map if ($parmlev eq 'map') { my $defbgone = '"E0E099"'; @@ -1418,7 +1385,7 @@ ENDMAPONE foreach (sort keys %name) { $r->print(''); - &print_row($r,$_,\%part,\%name,$mapid,\%default, + &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default, \%type,\%display,$defbgone,$defbgtwo, $parmlev,$uname,$udom,$csec); # $r->print("resource.$part{$_}.$name{$_},$symbp{$mapid}\n"); @@ -1496,7 +1463,7 @@ ENDMAPONE foreach (sort keys %name) { $r->print(''); - &print_row($r,$_,\%part,\%name,$mapid,\%default, + &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default, \%type,\%display,$defbgone,$defbgtwo,$parmlev,$uname,$udom,$csec); # $r->print("resource.$part{$_}.$name{$_},$symbp{$mapid}\n"); } @@ -1838,7 +1805,8 @@ $output ENDenv } ################################################## - +# Overview mode +################################################## my $tableopen; sub tablestart { @@ -1860,6 +1828,35 @@ sub tableend { } } +sub readdata { + my ($crs,$dom)=@_; +# Read coursedata + my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom); +# Read userdata + + my $classlist=&Apache::loncoursedata::get_classlist(); + foreach (keys %$classlist) { + # the following undefs are for 'domain', and 'username' respectively. + if ($_=~/^(\w+)\:(\w+)$/) { + my ($tuname,$tudom)=($1,$2); + my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom); + foreach my $userkey (keys %{$useropt}) { + if ($userkey=~/^$env{'request.course.id'}/) { + my $newkey=$userkey; + $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./; + $$resourcedata{$newkey}=$$useropt{$userkey}; + } + } + } + } + return $resourcedata; +} + +sub extractuser { + my $key=shift; + return ($key=~/^$env{'request.course.id'}.\[useropt\:(\w+)\:(\w+)\]\./); +} + sub overview { my $r=shift; my $bodytag=&Apache::loncommon::bodytag( @@ -1879,7 +1876,9 @@ $breadcrumbs ENDOVER # Setting - my %olddata=&Apache::lonnet::dump('resourcedata',$dom,$crs); +# Set userlevel immediately +# Do an intermediate store of course level + my $olddata=&readdata($crs,$dom); my %newdata=(); undef %newdata; my @deldata=(); @@ -1888,18 +1887,58 @@ ENDOVER if ($_=~/^form\.([a-z]+)\_(.+)$/) { my $cmd=$1; my $thiskey=$2; + my ($tuname,$tudom)=&extractuser($thiskey); + my $tkey=$thiskey; + if ($tuname) { + $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./; + } if ($cmd eq 'set') { my $data=$env{$_}; - if ($olddata{$thiskey} ne $data) { $newdata{$thiskey}=$data; } + if ($$olddata{$thiskey} ne $data) { + if ($tuname) { + if (&Apache::lonnet::put('resourcedata',{$tkey=>$data},$tudom,$tuname) eq 'ok') { + $r->print('
'.&mt('Stored modified parameter for').' '. + &Apache::loncommon::plainname($tuname,$tudom)); + } else { + $r->print('

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

'); + } + &Apache::lonnet::devalidateuserresdata($tuname,$tudom); + } else { + $newdata{$thiskey}=$data; + } + } } elsif ($cmd eq 'del') { - push (@deldata,$thiskey); + if ($tuname) { + if (&Apache::lonnet::del('resourcedata',[$tkey],$tudom,$tuname) eq 'ok') { + $r->print('
'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom)); + } else { + $r->print('

'. + &mt('Error deleting parameters').'

'); + } + &Apache::lonnet::devalidateuserresdata($tuname,$tudom); + } else { + push (@deldata,$thiskey); + } } elsif ($cmd eq 'datepointer') { my $data=&Apache::lonhtmlcommon::get_date_from_form($env{$_}); - if (defined($data) and $olddata{$thiskey} ne $data) { $newdata{$thiskey}=$data; } + if (defined($data) and $$olddata{$thiskey} ne $data) { + if ($tuname) { + if (&Apache::lonnet::put('resourcedata',{$tkey=>$data},$tudom,$tuname) eq 'ok') { + $r->print('
'.&mt('Stored modified date for').' '.&Apache::loncommon::plainname($tuname,$tudom)); + } else { + $r->print('

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

'); + } + &Apache::lonnet::devalidateuserresdata($tuname,$tudom); + } else { + $newdata{$thiskey}=$data; + } + } } } } -# Store +# Store all course level my $delentries=$#deldata+1; my @newdatakeys=keys %newdata; my $putentries=$#newdatakeys+1; @@ -1910,6 +1949,7 @@ ENDOVER $r->print('

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

'); } + &Apache::lonnet::devalidatecourseresdata($crs,$dom); } if ($putentries) { if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') { @@ -1918,25 +1958,36 @@ ENDOVER $r->print('

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

'); } + &Apache::lonnet::devalidatecourseresdata($crs,$dom); } -# Read and display - my %resourcedata=&Apache::lonnet::dump('resourcedata',$dom,$crs); +# Read modified data + + my $resourcedata=&readdata($crs,$dom); + +# Start list output + my $oldsection=''; my $oldrealm=''; my $oldpart=''; my $pointer=0; $tableopen=0; my $foundkeys=0; - foreach my $thiskey (sort keys %resourcedata) { - if ($resourcedata{$thiskey.'.type'}) { - my ($course,$middle,$part,$name)= - ($thiskey=~/^(\w+)\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/); + foreach my $thiskey (sort keys %{$resourcedata}) { + if ($$resourcedata{$thiskey.'.type'}) { + my ($middle,$part,$name)= + ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/); my $section=&mt('All Students'); - if ($middle=~/^\[(.*)\]\./) { - $section=&mt('Group/Section').': '.$1; - $middle=~s/^\[(.*)\]\.//; + if ($middle=~/^\[(.*)\]/) { + my $issection=$1; + if ($issection=~/^useropt\:(\w+)\:(\w+)/) { + $section=&mt('User').": ".&Apache::loncommon::plainname($1,$2); + } else { + $section=&mt('Group/Section').': '.$issection; + } + $middle=~s/^\[(.*)\]//; } - $middle=~s/\.$//; + $middle=~s/\.+$//; + $middle=~s/^\.+//; my $realm=''.&mt('All Resources').''; if ($middle=~/^(.+)\_\_\_\(all\)$/) { $realm=''.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).'
('.$1.')'; @@ -1966,19 +2017,19 @@ ENDOVER ':'); $foundkeys++; - if ($resourcedata{$thiskey.'.type'}=~/^date/) { + if ($$resourcedata{$thiskey.'.type'}=~/^date/) { my $jskey='key_'.$pointer; $pointer++; $r->print( &Apache::lonhtmlcommon::date_setter('overviewform', $jskey, - $resourcedata{$thiskey}). + $$resourcedata{$thiskey}). '' ); } else { $r->print( ''); + $$resourcedata{$thiskey}.'">'); } $r->print(''); } @@ -2113,8 +2164,7 @@ ENDMAINFORMHEAD my @menu = ( { text => 'Set Course Environment Parameters', - help => 'Course_Setting_Parameters', - action => 'crsenv', + action => 'crsenv', permission => $parm_permission, }, { text => 'Set/Modify Course Assessment Parameters - Helper Mode', @@ -2128,6 +2178,7 @@ ENDMAINFORMHEAD { text => 'Set/Modify Course Assessment Parameters - Table Mode', action => 'settable', permission => $parm_permission, + help => 'Cascading_Parameters', }, # { text => 'Set Parameter Default Preferences', # help => 'Course_View_Class_List', @@ -2182,24 +2233,19 @@ sub handler { return OK; } &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, - ['action','state']); - -# ----------------------------------------------------------- Clear out garbage + ['action','state', + 'pres_marker', + 'pres_value', + 'pres_type', + 'udom','uname']); - @ids=(); - %symbp=(); - %mapp=(); - %typep=(); - %keyp=(); - - %maptitles=(); - &Apache::lonhtmlcommon::clear_breadcrumbs(); &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset", text=>"Parameter Manager", - faq=>9, + faq=>10, bug=>'Instructor Interface'}); + # ----------------------------------------------------- Needs to be in a course my $parm_permission = (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) || @@ -2211,6 +2257,11 @@ sub handler { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; + + # id numbers can change on re-ordering of folders + + &resetsymbcache(); + # # Main switch on form.action and form.state, as appropriate # @@ -2237,7 +2288,8 @@ sub handler { &overview($r); } elsif ($env{'form.action'} eq 'settable' && $parm_permission) { &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable', - text=>"Table Mode"}); + text=>"Table Mode", + help => 'Course_Setting_Parameters'}); &assessparms($r); }