loncom/interface/lonparmset.pm - diff

Return to lonparmset.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonparmset.pm between versions 1.195 and 1.206

version 1.195, 2005/05/30 17:58:51	version 1.206, 2005/06/03 21:19:04
Line 62 use GDBM_File;	Line 62 use GDBM_File;
use Apache::lonhomework;	use Apache::lonhomework;
use Apache::lonxml;	use Apache::lonxml;
use Apache::lonlocal;	use Apache::lonlocal;
	use Apache::lonnavmaps;

my %courseopt;	# --- Caches local to lonparmset
my %useropt;
my %parmhash;

my @ids;	my $parmhashid;
my %symbp;	my %parmhash;
my %mapp;	my $symbsid;
my %typep;	my %symbs;
my %keyp;

my %maptitles;	# --- end local caches

##################################################	##################################################
##################################################	##################################################
Line 105 Returns: A list, the first item is the	Line 103 Returns: A list, the first item is the
=cut	=cut

##################################################	##################################################
##################################################
sub parmval {	sub parmval {
my ($what,$id,$def,$uname,$udom,$csec)=@_;	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();

	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
	my $useropt=&Apache::lonnet::get_userresdata($uname,$udom);
	my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);


my $result='';	my $result='';
my @outpar=();	my @outpar=();
# ----------------------------------------------------- Cascading lookup scheme	# ----------------------------------------------------- Cascading lookup scheme
	my $map=(&Apache::lonnet::decode_symb($symb))[0];

my $symbparm=$symbp{$id}.'.'.$what;	my $symbparm=$symb.'.'.$what;
my $mapparm=$mapp{$id}.'___(all).'.$what;	my $mapparm=$map.'___(all).'.$what;

my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;	my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;	my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
Line 127 sub parmval {	Line 140 sub parmval {

# --------------------------------------------------------- first, check course	# --------------------------------------------------------- first, check course

if (defined($courseopt{$courselevel})) {	if (defined($$courseopt{$courselevel})) {
$outpar[11]=$courseopt{$courselevel};	$outpar[11]=$$courseopt{$courselevel};
$result=11;	$result=11;
}	}

if (defined($courseopt{$courselevelm})) {	if (defined($$courseopt{$courselevelm})) {
$outpar[10]=$courseopt{$courselevelm};	$outpar[10]=$$courseopt{$courselevelm};
$result=10;	$result=10;
}	}

Line 146 sub parmval {	Line 159 sub parmval {
my $thisparm=$parmhash{$symbparm};	my $thisparm=$parmhash{$symbparm};
if (defined($thisparm)) { $outpar[8]=$thisparm; $result=8; }	if (defined($thisparm)) { $outpar[8]=$thisparm; $result=8; }

if (defined($courseopt{$courselevelr})) {	if (defined($$courseopt{$courselevelr})) {
$outpar[7]=$courseopt{$courselevelr};	$outpar[7]=$$courseopt{$courselevelr};
$result=7;	$result=7;
}	}

# ------------------------------------------------------ fourth, back to course	# ------------------------------------------------------ fourth, back to course
if (defined($csec)) {	if (defined($csec)) {
if (defined($courseopt{$seclevel})) {	if (defined($$courseopt{$seclevel})) {
$outpar[6]=$courseopt{$seclevel};	$outpar[6]=$$courseopt{$seclevel};
$result=6;	$result=6;
}	}
if (defined($courseopt{$seclevelm})) {	if (defined($$courseopt{$seclevelm})) {
$outpar[5]=$courseopt{$seclevelm};	$outpar[5]=$$courseopt{$seclevelm};
$result=5;	$result=5;
}	}

if (defined($courseopt{$seclevelr})) {	if (defined($$courseopt{$seclevelr})) {
$outpar[4]=$courseopt{$seclevelr};	$outpar[4]=$$courseopt{$seclevelr};
$result=4;	$result=4;
}	}
}	}
Line 171 sub parmval {	Line 184 sub parmval {
# ---------------------------------------------------------- fifth, check user	# ---------------------------------------------------------- fifth, check user

if (defined($uname)) {	if (defined($uname)) {
if (defined($useropt{$courselevel})) {	if (defined($$useropt{$courselevel})) {
$outpar[3]=$useropt{$courselevel};	$outpar[3]=$$useropt{$courselevel};
$result=3;	$result=3;
}	}

if (defined($useropt{$courselevelm})) {	if (defined($$useropt{$courselevelm})) {
$outpar[2]=$useropt{$courselevelm};	$outpar[2]=$$useropt{$courselevelm};
$result=2;	$result=2;
}	}

if (defined($useropt{$courselevelr})) {	if (defined($$useropt{$courselevelr})) {
$outpar[1]=$useropt{$courselevelr};	$outpar[1]=$$useropt{$courselevelr};
$result=1;	$result=1;
}	}
}	}
return ($result,@outpar);	return ($result,@outpar);
}	}

	sub resetparmhash {
	$parmhashid='';
	}

	sub cacheparmhash {
	if ($parmhashid eq $env{'request.course.fn'}) { return; }
	my %parmhashfile;
	if (tie(%parmhashfile,'GDBM_File',
	$env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
	%parmhash=%parmhashfile;
	untie %parmhashfile;
	$parmhashid=$env{'request.course.fn'};
	}
	}

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

##################################################	##################################################
##################################################	##################################################
#	#
# Store a parameter	# Store a parameter by ID
#	#
# Takes	# Takes
# - resource id	# - resource id
Line 206 sub parmval {	Line 256 sub parmval {

sub storeparm {	sub storeparm {
my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;	my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;
$spnam=~s/\_([^\_]+)$/\.$1/;	&storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec);
	}

	#
	# Store a parameter by symb
	#
	# Takes
	# - symb
	# - name of parameter
	# - level
	# - new value
	# - new type
	# - username
	# - userdomain

	sub storeparm_by_symb {
	# ---------------------------------------------------------- Get symb, map, etc
	my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;
# ---------------------------------------------------------- Construct prefixes	# ---------------------------------------------------------- Construct prefixes
	$spnam=~s/\_([^\_]+)$/\.$1/;
my $symbparm=$symbp{$sresid}.'.'.$spnam;	my $map=(&Apache::lonnet::decode_symb($symb))[0];
my $mapparm=$mapp{$sresid}.'___(all).'.$spnam;	my $symbparm=$symb.'.'.$spnam;
	my $mapparm=$map.'___(all).'.$spnam;

my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;	my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;	my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;	my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
Line 236 sub storeparm {	Line 304 sub storeparm {
if ($snum>3) {	if ($snum>3) {
# ---------------------------------------------------------------- Store Course	# ---------------------------------------------------------------- Store Course
#	#
	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
# Expire sheets	# Expire sheets
&Apache::lonnet::expirespread('','','studentcalc');	&Apache::lonnet::expirespread('','','studentcalc');
if (($snum==7) \|\| ($snum==4)) {	if (($snum==7) \|\| ($snum==4)) {
&Apache::lonnet::expirespread('','','assesscalc',$symbp{$sresid});	&Apache::lonnet::expirespread('','','assesscalc',$symb);
} elsif (($snum==8) \|\| ($snum==5)) {	} elsif (($snum==8) \|\| ($snum==5)) {
&Apache::lonnet::expirespread('','','assesscalc',$mapp{$sresid});	&Apache::lonnet::expirespread('','','assesscalc',$map);
} else {	} else {
&Apache::lonnet::expirespread('','','assesscalc');	&Apache::lonnet::expirespread('','','assesscalc');
}	}
# Store parameter	# Store parameter
if ($delete) {	if ($delete) {
$reply=&Apache::lonnet::del	$reply=&Apache::lonnet::del
('resourcedata',[keys(%storecontent)],	('resourcedata',[keys(%storecontent)],$cdom,$cnum);
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
} else {	} else {
$reply=&Apache::lonnet::cput	$reply=&Apache::lonnet::cput
('resourcedata',\%storecontent,	('resourcedata',\%storecontent,$cdom,$cnum);
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
}	}
	&Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
} else {	} else {
# ------------------------------------------------------------------ Store User	# ------------------------------------------------------------------ Store User
#	#
Line 264 sub storeparm {	Line 331 sub storeparm {
&Apache::lonnet::expirespread($uname,$udom,'studentcalc');	&Apache::lonnet::expirespread($uname,$udom,'studentcalc');
if ($snum==1) {	if ($snum==1) {
&Apache::lonnet::expirespread	&Apache::lonnet::expirespread
($uname,$udom,'assesscalc',$symbp{$sresid});	($uname,$udom,'assesscalc',$symb);
} elsif ($snum==2) {	} elsif ($snum==2) {
&Apache::lonnet::expirespread	&Apache::lonnet::expirespread
($uname,$udom,'assesscalc',$mapp{$sresid});	($uname,$udom,'assesscalc',$map);
} else {	} else {
&Apache::lonnet::expirespread($uname,$udom,'assesscalc');	&Apache::lonnet::expirespread($uname,$udom,'assesscalc');
}	}
Line 379 sub plink {	Line 446 sub plink {
&valout($value,$type).'</a><a name="'.$marker.'"></a>';	&valout($value,$type).'</a><a name="'.$marker.'"></a>';
}	}


sub startpage {	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','',	my $bodytag=&Apache::loncommon::bodytag('Set/Modify Course Parameters','',
'onUnload="pclose()"');	'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').' '.	my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
&Apache::loncommon::selectstudent_link('parmform','uname','udom');	&Apache::loncommon::selectstudent_link('parmform','uname','udom');
my $selscript=&Apache::loncommon::studentbrowser_javascript();	my $selscript=&Apache::loncommon::studentbrowser_javascript();
my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();	my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
my %lt=&Apache::lonlocal::texthash(	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",	'captm' => "Course Assessments Parameters - Table Mode",
'sg' => "Section/Group",	'sg' => "Section/Group",
'fu' => "For User",	'fu' => "For User",
'oi' => "or ID",	'oi' => "or ID",
'ad' => "at Domain"	'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();	my $html=&Apache::lonxml::xmlbegin();
$r->print(<<ENDHEAD);	$r->print(<<ENDHEAD);
$html	$html
Line 456 $selscript	Line 513 $selscript
</head>	</head>
$bodytag	$bodytag
$breadcrumbs	$breadcrumbs
$overallhelp
ENDHEAD	ENDHEAD

unless ($trimheader) {$r->print(<<ENDHEAD2);
<form method="post" action="/adm/parmset" name="envform">
<h4>$lt{'cep'}</h4>
<input type="submit" name="crsenv" value="$lt{'scep'}" />
</form>
<hr />
$assessparmhelp
<form method="post" action="/adm/helper/parameter.helper" name="helpform">
<h4>$lt{'caphm'}</h4>
<input type="submit" value="$lt{'smcap'}" />
</form>
<hr />
<form method="post" action="/adm/parmset" name="overview">
<h4>$lt{'capom'}</h4>
<input type="submit" name="overview" value="$lt{'mcap'}" />
</form>
<hr />
ENDHEAD2
}
my %sectionhash=();	my %sectionhash=();
my $sections='';	my $sections='';
if (&Apache::loncommon::get_sections(	if (&Apache::loncommon::get_sections(
Line 496 ENDHEAD2	Line 532 ENDHEAD2
<h4>$lt{'captm'}</h4>	<h4>$lt{'captm'}</h4>
ENDHEAD3	ENDHEAD3

if (!$have_assesments) {	if (!$have_assessments) {
$r->print('<font color="red">'.&mt('There are no assesment parameters in this course to set.').'</font><br />');	$r->print('<font color="red">'.&mt('There are no assessment parameters in this course to set.').'</font><br />');
} else {	} else {
$r->print(<<ENDHEAD);	$r->print(<<ENDHEAD);
<b>	<b>
Line 518 ENDHEAD	Line 554 ENDHEAD
}	}

sub print_row {	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)=@_;	$defbgtwo,$parmlev,$uname,$udom,$csec)=@_;
# get the values for the parameter in cascading order	# get the values for the parameter in cascading order
# empty levels will remain empty	# empty levels will remain empty
Line 540 sub print_row {	Line 576 sub print_row {
}	}
my $parm=$$display{$which};	my $parm=$$display{$which};

if ($parmlev eq 'full' \|\| $parmlev eq 'brief') {	if ($parmlev eq 'full') {
$r->print('<td bgcolor='.$defbgtwo.' align="center">'	$r->print('<td bgcolor='.$defbgtwo.' align="center">'
.$$part{$which}.'</td>');	.$$part{$which}.'</td>');
} else {	} else {
Line 575 sub print_row {	Line 611 sub print_row {

&print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);	&print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);

if ($parmlev eq 'brief') {	&print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
	&print_td($r,9,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
&print_td($r,7,$defbgone,$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,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);	if ($csec) {
}	&print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
if ($uname) {	&print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
&print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);	&print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
}	}
} else {	if ($uname) {
	&print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
&print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);	&print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
&print_td($r,9,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);	&print_td($r,1,$defbgone,$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);
}
} # end of $brief if/else
} # end of $parmlev if/else	} # end of $parmlev if/else

$r->print('<td bgcolor=#CCCCFF align="center">'.	$r->print('<td bgcolor=#CCCCFF align="center">'.
&valout($outpar[$result],$typeoutpar[$result]).'</td>');	&valout($outpar[$result],$typeoutpar[$result]).'</td>');

if ($parmlev eq 'full' \|\| $parmlev eq 'brief') {	if ($parmlev eq 'full') {
my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.	my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
'.'.$$name{$which},$symbp{$rid});	'.'.$$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];	my $sessionvaltype=$typeoutpar[$result];
if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; }	if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; }
$r->print('<td bgcolor=#999999 align="center"><font color=#FFFFFF>'.	$r->print('<td bgcolor=#999999 align="center"><font color=#FFFFFF>'.
Line 640 sub print_td {	Line 659 sub print_td {
$r->print('</td>'."\n");	$r->print('</td>'."\n");
}	}


=pod	=pod

=item B<extractResourceInformation>: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes.	=item B<extractResourceInformation>: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes.
Line 675 Input: See list below:	Line 695 Input: See list below:
=cut	=cut

sub extractResourceInformation {	sub extractResourceInformation {
my $bighash = shift;
my $ids = shift;	my $ids = shift;
my $typep = shift;	my $typep = shift;
my $keyp = shift;	my $keyp = shift;
Line 688 sub extractResourceInformation {	Line 707 sub extractResourceInformation {
my $mapp = shift;	my $mapp = shift;
my $symbp = shift;	my $symbp = shift;
my $maptitles=shift;	my $maptitles=shift;
	my $uris=shift;


foreach (keys %$bighash) {	my $navmap = Apache::lonnavmaps::navmap->new();
if ($_=~/^src\_(\d+)\.(\d+)$/) {	my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
# there are no resources in the 0 level	foreach my $resource (@allres) {
if ($1 eq '0') { next; }	my $id=$resource->id();
my $mapid=$1;	my ($mapid,$resid)=split(/\./,$id);
my $resid=$2;	if ($mapid eq '0') { next; }
my $id=$mapid.'.'.$resid;	$$ids[$#$ids+1]=$id;
my $srcf=$$bighash{$_};	my $srcf=$resource->src();
if (1) {	$srcf=~/\.(\w+)$/;
$srcf=~/\.(\w+)$/;	$$typep{$id}=$1;
$$ids[$#$ids+1]=$id;	$$keyp{$id}='';
$$typep{$id}=$1;	$$uris{$id}=$srcf;
$$keyp{$id}='';	foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {	if ($_=~/^parameter\_(.*)/) {
if ($_=~/^parameter\_(.*)/) {	my $key=$_;
my $key=$_;	my $allkey=$1;
my $allkey=$1;	$allkey=~s/\_/\./g;
$allkey=~s/\_/\./g;	if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq
if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq	'parm') {
'parm') {	next; #hide hidden things
next; #hide hidden things
}
my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
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);
}
if ($$keyp{$id}) {
$$keyp{$id}.=','.$key;
} else {
$$keyp{$id}=$key;
}
}
}	}
$$mapp{$id}=	my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
&Apache::lonnet::declutter($$bighash{'map_id_'.$mapid});	my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
$$mapp{$mapid}=$$mapp{$id};	my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
$$allmaps{$mapid}=$$mapp{$id};	my $parmdis = $display;
if ($mapid eq '1') {	$parmdis =~ s\|(\[Part.*)$\|\|g;
$$maptitles{$mapid}='Main Course Documents';	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);
	}
	if ($$keyp{$id}) {
	$$keyp{$id}.=','.$key;
} else {	} else {
$$maptitles{$mapid}=&Apache::lonnet::gettitle(&Apache::lonnet::clutter($$mapp{$id}));	$$keyp{$id}=$key;
}	}
$$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
$$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
$$symbp{$mapid}=$$mapp{$id}.'___(all)';
}	}
}	}
	$$mapp{$id}=
	&Apache::lonnet::declutter($resource->enclosing_map_src());
	$$mapp{$mapid}=$$mapp{$id};
	$$allmaps{$mapid}=$$mapp{$id};
	if ($mapid eq '1') {
	$$maptitles{$mapid}='Main Course Documents';
	} else {
	$$maptitles{$mapid}=&Apache::lonnet::gettitle(&Apache::lonnet::clutter($$mapp{$id}));
	}
	$$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
	$$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
	$$symbp{$mapid}=$$mapp{$id}.'___(all)';
}	}
}	}

Line 781 Variables used (guessed by Jeremy):	Line 799 Variables used (guessed by Jeremy):
sub assessparms {	sub assessparms {

my $r=shift;	my $r=shift;

	my @ids=();
	my %symbp=();
	my %mapp=();
	my %typep=();
	my %keyp=();
	my %uris=();
	my %maptitles=();

# -------------------------------------------------------- Variable declaration	# -------------------------------------------------------- Variable declaration
my %allkeys=();	my %allkeys=();
my %allmaps=();	my %allmaps=();
Line 801 sub assessparms {	Line 828 sub assessparms {
my %allparts;	my %allparts;

my %defp;	my %defp;
%courseopt=();
%useropt=();
my %bighash=();

@ids=();	@ids=();
%symbp=();	%symbp=();
Line 828 sub assessparms {	Line 852 sub assessparms {

my $pssymb='';	my $pssymb='';
my $parmlev='';	my $parmlev='';
my $trimheader='';
my $prevvisit=$env{'form.prevvisit'};	my $prevvisit=$env{'form.prevvisit'};

unless ($env{'form.parmlev'}) {	unless ($env{'form.parmlev'}) {
Line 847 sub assessparms {	Line 870 sub assessparms {
if (!@pscat) { @pscat=('all'); }	if (!@pscat) { @pscat=('all'); }
$pschp='';	$pschp='';
$parmlev = 'full';	$parmlev = 'full';
$trimheader='yes';
} elsif ($env{'form.symb'}) {	} elsif ($env{'form.symb'}) {
$pssymb=$env{'form.symb'};	$pssymb=$env{'form.symb'};
if (!@pscat) { @pscat=('all'); }	if (!@pscat) { @pscat=('all'); }
$pschp='';	$pschp='';
$parmlev = 'full';	$parmlev = 'full';
$trimheader='yes';
} else {	} else {
$env{'form.url'}='';	$env{'form.url'}='';
}	}
Line 905 sub assessparms {	Line 926 sub assessparms {
my $fcat=$env{'form.fcat'};	my $fcat=$env{'form.fcat'};
unless ($fcat) { $fcat=''; }	unless ($fcat) { $fcat=''; }

# ------------------------------------------------------------------- Tie hashs
if (!(tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
&GDBM_READER(),0640))) {
$r->print("Unable to access course data. (File $env{'request.course.fn'}.db not tieable)");
return ;
}
if (!(tie(%parmhash,'GDBM_File',
$env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640))) {
$r->print("Unable to access parameter data. (File $env{'request.course.fn'}_parms.db not tieable)");
return ;
}

# --------------------------------------------------------- Get all assessments	# --------------------------------------------------------- Get all assessments
&extractResourceInformation(\%bighash, \@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allkeys, \%allmaps, $fcat, \%defp, \%mapp, \%symbp,\%maptitles);	&extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allkeys, \%allmaps, $fcat, \%defp, \%mapp, \%symbp,\%maptitles,\%uris);

$mapp{'0.0'} = '';	$mapp{'0.0'} = '';
$symbp{'0.0'} = '';	$symbp{'0.0'} = '';

# ---------------------------------------------------------- Anything to store?	# ---------------------------------------------------------- Anything to store?
if ($env{'form.pres_marker'}) {	if ($env{'form.pres_marker'}) {
$message.=&storeparm(split(/\&/,$env{'form.pres_marker'}),	my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
$env{'form.pres_value'},	my @values=split(/\&\&\&/,$env{'form.pres_value'});
$env{'form.pres_type'},	my @types=split(/\&\&\&/,$env{'form.pres_type'});
$uname,$udom,$csec);	for (my $i=0;$i<=$#markers;$i++) {
	$message.=&storeparm(split(/\&/,$markers[$i]),
	$values[$i],
	$types[$i],
	$uname,$udom,$csec);
	}
# ---------------------------------------------------------------- Done storing	# ---------------------------------------------------------------- Done storing
$message.='<h3>'.&mt('Changes can take up to 10 minutes before being active for all students.').&Apache::loncommon::help_open_topic('Caching').'</h3>';	$message.='<h3>'.&mt('Changes can take up to 10 minutes before being active for all students.').&Apache::loncommon::help_open_topic('Caching').'</h3>';
}	}
# --------------------------------------------- Devalidate cache for this child
&Apache::lonnet::devalidatecourseresdata(
$env{'course.'.$env{'request.course.id'}.'.num'},
$env{'course.'.$env{'request.course.id'}.'.domain'});
#&Apache::lonnet::clear_EXT_cache_status();
# -------------------------------------------------------------- Get coursedata
%courseopt = &Apache::lonnet::dump
('resourcedata',
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
# --------------------------------------------------- Get userdata (if present)
if ($uname) {
%useropt=&Apache::lonnet::dump('resourcedata',$udom,$uname);
}

# ------------------------------------------------------------------- Sort this	# ------------------------------------------------------------------- Sort this

@ids=sort {	@ids=sort {
Line 965 sub assessparms {	Line 964 sub assessparms {
if ($psprt[0] eq "all" \|\| !@psprt) {@psprt = (keys %allparts);}	if ($psprt[0] eq "all" \|\| !@psprt) {@psprt = (keys %allparts);}
# ------------------------------------------------------------------ Start page	# ------------------------------------------------------------------ Start page

my $have_assesments=1;	&startpage($r,$id,$udom,$csec,$uname,scalar(keys(%allkeys)));
if (scalar(keys(%allkeys)) eq 0) { $have_assesments=0; }

$trimheader = 'yes';
&startpage($r,$id,$udom,$csec,$uname,$have_assesments,$trimheader);

if (!$have_assesments) {
untie(%bighash);
untie(%parmhash);
return '';
}
# if ($env{'form.url'}) {
# $r->print('<input type="hidden" value="'.$env{'form.url'}.
# '" name="url"><input type="hidden" name="command" value="set">');
# }
$r->print('<input type="hidden" value="true" name="prevvisit">');	$r->print('<input type="hidden" value="true" name="prevvisit">');

foreach ('tolerance','date_default','date_start','date_end',	foreach ('tolerance','date_default','date_start','date_end',
Line 1154 sub assessparms {	Line 1140 sub assessparms {
my $csuname=$env{'user.name'};	my $csuname=$env{'user.name'};
my $csudom=$env{'user.domain'};	my $csudom=$env{'user.domain'};

if ($parmlev eq 'full' \|\| $parmlev eq 'brief') {	if ($parmlev eq 'full') {
my $coursespan=$csec?8:5;	my $coursespan=$csec?8:5;
$r->print('<p><table border=2>');	$r->print('<p><table border=2>');
$r->print('<tr><td colspan=5></td>');	$r->print('<tr><td colspan=5></td>');
Line 1238 ENDTABLEHEADFOUR	Line 1224 ENDTABLEHEADFOUR
my %display=();	my %display=();
my %type= ();	my %type= ();
my %default=();	my %default=();
my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});	my $uri=&Apache::lonnet::declutter($uris{$rid});

foreach (split(/\,/,$keyp{$rid})) {	foreach (split(/\,/,$keyp{$rid})) {
my $tempkeyp = $_;	my $tempkeyp = $_;
Line 1291 ENDTABLEHEADFOUR	Line 1277 ENDTABLEHEADFOUR
undef $firstrow;	undef $firstrow;
}	}

&print_row($r,$_,\%part,\%name,$rid,\%default,	&print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default,
\%type,\%display,$defbgone,$defbgtwo,	\%type,\%display,$defbgone,$defbgtwo,
$parmlev,$uname,$udom,$csec);	$parmlev,$uname,$udom,$csec);
}	}
Line 1300 ENDTABLEHEADFOUR	Line 1286 ENDTABLEHEADFOUR
} # end foreach ids	} # end foreach ids
# -------------------------------------------------- End entry for one resource	# -------------------------------------------------- End entry for one resource
$r->print('</table>');	$r->print('</table>');
} # end of brief/full	} # end of full
#--------------------------------------------------- Entry for parm level map	#--------------------------------------------------- Entry for parm level map
if ($parmlev eq 'map') {	if ($parmlev eq 'map') {
my $defbgone = '"E0E099"';	my $defbgone = '"E0E099"';
Line 1337 ENDTABLEHEADFOUR	Line 1323 ENDTABLEHEADFOUR
# $r->print("$mapid:$map: $rid <br /> \n");	# $r->print("$mapid:$map: $rid <br /> \n");

if ($map eq $mapid) {	if ($map eq $mapid) {
my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});	my $uri=&Apache::lonnet::declutter($uris{$rid});
# $r->print("Keys: $keyp{$rid} <br />\n");	# $r->print("Keys: $keyp{$rid} <br />\n");

#--------------------------------------------------------------------	#--------------------------------------------------------------------
Line 1399 ENDMAPONE	Line 1385 ENDMAPONE

foreach (sort keys %name) {	foreach (sort keys %name) {
$r->print('<tr>');	$r->print('<tr>');
&print_row($r,$_,\%part,\%name,$mapid,\%default,	&print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
\%type,\%display,$defbgone,$defbgtwo,	\%type,\%display,$defbgone,$defbgtwo,
$parmlev,$uname,$udom,$csec);	$parmlev,$uname,$udom,$csec);
# $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");	# $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
Line 1425 ENDMAPONE	Line 1411 ENDMAPONE
foreach (@ids) {	foreach (@ids) {
my $rid = $_;	my $rid = $_;

my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});	my $uri=&Apache::lonnet::declutter($uris{$rid});

#--------------------------------------------------------------------	#--------------------------------------------------------------------
# @catmarker contains list of all possible parameters including part #s	# @catmarker contains list of all possible parameters including part #s
Line 1477 ENDMAPONE	Line 1463 ENDMAPONE

foreach (sort keys %name) {	foreach (sort keys %name) {
$r->print('<tr>');	$r->print('<tr>');
&print_row($r,$_,\%part,\%name,$mapid,\%default,	&print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
\%type,\%display,$defbgone,$defbgtwo,$parmlev,$uname,$udom,$csec);	\%type,\%display,$defbgone,$defbgtwo,$parmlev,$uname,$udom,$csec);
# $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");	# $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
}	}
Line 1485 ENDMAPONE	Line 1471 ENDMAPONE
} # end of $parmlev eq general	} # end of $parmlev eq general
}	}
$r->print('</form></body></html>');	$r->print('</form></body></html>');
untie(%bighash);
untie(%parmhash);
} # end sub assessparms	} # end sub assessparms


Line 1893 ENDOVER	Line 1877 ENDOVER
$r->print('<h2><font color="red">'.	$r->print('<h2><font color="red">'.
&mt('Error deleting parameters').'</font></h2>');	&mt('Error deleting parameters').'</font></h2>');
}	}
	&Apache::lonnet::devalidatecourseresdata($crs,$dom);
}	}
if ($putentries) {	if ($putentries) {
if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {	if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
Line 1901 ENDOVER	Line 1886 ENDOVER
$r->print('<h2><font color="red">'.	$r->print('<h2><font color="red">'.
&mt('Error storing parameters').'</font></h2>');	&mt('Error storing parameters').'</font></h2>');
}	}
	&Apache::lonnet::devalidatecourseresdata($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};
	}
	}
	}
}	}
# Read and display
my %resourcedata=&Apache::lonnet::dump('resourcedata',$dom,$crs);
my $oldsection='';	my $oldsection='';
my $oldrealm='';	my $oldrealm='';
my $oldpart='';	my $oldpart='';
my $pointer=0;	my $pointer=0;
$tableopen=0;	$tableopen=0;
my $foundkeys=0;	my $foundkeys=0;
foreach my $thiskey (sort keys %resourcedata) {	foreach my $thiskey (sort keys %{$resourcedata}) {
if ($resourcedata{$thiskey.'.type'}) {	if ($$resourcedata{$thiskey.'.type'}) {
	$r->print($thiskey);
my ($course,$middle,$part,$name)=	my ($course,$middle,$part,$name)=
($thiskey=~/^(\w+)\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);	($thiskey=~/^(\w+)\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
my $section=&mt('All Students');	my $section=&mt('All Students');
if ($middle=~/^\[(.*)\]\./) {	if ($middle=~/^\[(.*)\]\./) {
$section=&mt('Group/Section').': '.$1;	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/\.$//;
Line 1949 ENDOVER	Line 1959 ENDOVER
':</b></td><td><input type="checkbox" name="del_'.	':</b></td><td><input type="checkbox" name="del_'.
$thiskey.'" /></td><td>');	$thiskey.'" /></td><td>');
$foundkeys++;	$foundkeys++;
if ($resourcedata{$thiskey.'.type'}=~/^date/) {	if ($$resourcedata{$thiskey.'.type'}=~/^date/) {
my $jskey='key_'.$pointer;	my $jskey='key_'.$pointer;
$pointer++;	$pointer++;
$r->print(	$r->print(
&Apache::lonhtmlcommon::date_setter('overviewform',	&Apache::lonhtmlcommon::date_setter('overviewform',
$jskey,	$jskey,
$resourcedata{$thiskey}).	$$resourcedata{$thiskey}).
'<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'	'<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'
);	);
} else {	} else {
$r->print(	$r->print(
'<input type="text" name="set_'.$thiskey.'" value="'.	'<input type="text" name="set_'.$thiskey.'" value="'.
$resourcedata{$thiskey}.'">');	$$resourcedata{$thiskey}.'">');
}	}
$r->print('</td></tr>');	$r->print('</td></tr>');
}	}
Line 2096 ENDMAINFORMHEAD	Line 2106 ENDMAINFORMHEAD
my @menu =	my @menu =
(	(
{ text => 'Set Course Environment Parameters',	{ text => 'Set Course Environment Parameters',
help => 'Course_Setting_Parameters',	action => 'crsenv',
action => 'crsenv',
permission => $parm_permission,	permission => $parm_permission,
},	},
{ text => 'Set/Modify Course Assessment Parameters - Helper Mode',	{ text => 'Set/Modify Course Assessment Parameters - Helper Mode',
Line 2111 ENDMAINFORMHEAD	Line 2120 ENDMAINFORMHEAD
{ text => 'Set/Modify Course Assessment Parameters - Table Mode',	{ text => 'Set/Modify Course Assessment Parameters - Table Mode',
action => 'settable',	action => 'settable',
permission => $parm_permission,	permission => $parm_permission,
	help => 'Cascading_Parameters',
},	},
# { text => 'Set Parameter Default Preferences',	# { text => 'Set Parameter Default Preferences',
# help => 'Course_View_Class_List',	# help => 'Course_View_Class_List',
Line 2165 sub handler {	Line 2175 sub handler {
return OK;	return OK;
}	}
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['action','state']);	['action','state',
	'pres_marker',
# ----------------------------------------------------------- Clear out garbage	'pres_value',
	'pres_type',
%courseopt=();	'udom','uname']);
%useropt=();
%parmhash=();

@ids=();
%symbp=();
%mapp=();
%typep=();
%keyp=();

%maptitles=();

&Apache::lonhtmlcommon::clear_breadcrumbs();	&Apache::lonhtmlcommon::clear_breadcrumbs();
&Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",	&Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
text=>"Parameter Manager",	text=>"Parameter Manager",
faq=>9,	faq=>10,
bug=>'Instructor Interface'});	bug=>'Instructor Interface'});

# ----------------------------------------------------- Needs to be in a course	# ----------------------------------------------------- Needs to be in a course
my $parm_permission =	my $parm_permission =
(&Apache::lonnet::allowed('opa',$env{'request.course.id'}) \|\|	(&Apache::lonnet::allowed('opa',$env{'request.course.id'}) \|\|
Line 2197 sub handler {	Line 2199 sub handler {
&Apache::loncommon::content_type($r,'text/html');	&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;	$r->send_http_header;


	# id numbers can change on re-ordering of folders

	&resetsymbcache();

#	#
# Main switch on form.action and form.state, as appropriate	# Main switch on form.action and form.state, as appropriate
#	#
Line 2223 sub handler {	Line 2230 sub handler {
&overview($r);	&overview($r);
} elsif ($env{'form.action'} eq 'settable' && $parm_permission) {	} elsif ($env{'form.action'} eq 'settable' && $parm_permission) {
&Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',	&Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
text=>"Table Mode"});	text=>"Table Mode",
	help => 'Course_Setting_Parameters'});
&assessparms($r);	&assessparms($r);
}	}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.195
changed lines
	Added in v.1.206