loncom/interface/loncommon.pm - diff

Return to loncommon.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.145 and 1.167

version 1.145, 2003/11/08 01:45:26	version 1.167, 2003/12/29 21:17:00
Line 25	Line 25
#	#
# http://www.lon-capa.org/	# http://www.lon-capa.org/
#	#
# YEAR=2001
# 2/13-12/7 Guy Albertelli
# 12/21 Gerd Kortemeyer
# 12/25,12/28 Gerd Kortemeyer
# YEAR=2002
# 1/4 Gerd Kortemeyer
# 6/24,7/2 H. K. Ng

# Makes a table out of the previous attempts	# Makes a table out of the previous attempts
# Inputs result_from_symbread, user, domain, course_id	# Inputs result_from_symbread, user, domain, course_id
Line 73 use HTML::Entities;	Line 66 use HTML::Entities;

my $readit;	my $readit;

=pod	##
	## Global Variables
=head1 Global Variables	##

=cut

# ----------------------------------------------- Filetypes/Languages/Copyright	# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;	my %language;
Line 111 BEGIN {	Line 102 BEGIN {
unless ($readit) {	unless ($readit) {
# ------------------------------------------------------------------- languages	# ------------------------------------------------------------------- languages
{	{
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.	my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/language.tab');	'/language.tab';
if ($fh) {	if ( open(my $fh,"<$langtabfile") ) {
while (<$fh>) {	while (<$fh>) {
next if /^\#/;	next if /^\#/;
chomp;	chomp;
my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_));	my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_));
$language{$key}=$val.' - '.$enc;	$language{$key}=$val.' - '.$enc;
if ($sup) {	if ($sup) {
$supported_language{$key}=$sup;	$supported_language{$key}=$sup;
}	}
}	}
}	close($fh);
	}
}	}
# ------------------------------------------------------------------ copyrights	# ------------------------------------------------------------------ copyrights
{	{
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.	my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/copyright.tab');	'/copyright.tab';
if ($fh) {	if ( open (my $fh,"<$copyrightfile") ) {
while (<$fh>) {	while (<$fh>) {
next if /^\#/;	next if /^\#/;
chomp;	chomp;
my ($key,$val)=(split(/\s+/,$_,2));	my ($key,$val)=(split(/\s+/,$_,2));
$cprtag{$key}=$val;	$cprtag{$key}=$val;
}	}
}	close($fh);
	}
}	}

# -------------------------------------------------------------- domain designs	# -------------------------------------------------------------- domain designs
Line 147 BEGIN {	Line 140 BEGIN {
while ($filename=readdir(DIR)) {	while ($filename=readdir(DIR)) {
my ($domain)=($filename=~/^(\w+)\./);	my ($domain)=($filename=~/^(\w+)\./);
{	{
my $fh=Apache::File->new($designdir.'/'.$filename);	my $designfile = $designdir.'/'.$filename;
if ($fh) {	if ( open (my $fh,"<$designfile") ) {
while (<$fh>) {	while (<$fh>) {
next if /^\#/;	next if /^\#/;
chomp;	chomp;
my ($key,$val)=(split(/\=/,$_));	my ($key,$val)=(split(/\=/,$_));
if ($val) { $designhash{$domain.'.'.$key}=$val; }	if ($val) { $designhash{$domain.'.'.$key}=$val; }
}	}
}	close($fh);
	}
}	}

}	}
Line 164 BEGIN {	Line 158 BEGIN {

# ------------------------------------------------------------- file categories	# ------------------------------------------------------------- file categories
{	{
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.	my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filecategories.tab');	'/filecategories.tab';
if ($fh) {	if ( open (my $fh,"<$categoryfile") ) {
while (<$fh>) {	while (<$fh>) {
next if /^\#/;	next if /^\#/;
chomp;	chomp;
my ($extension,$category)=(split(/\s+/,$_,2));	my ($extension,$category)=(split(/\s+/,$_,2));
push @{$category_extensions{lc($category)}},$extension;	push @{$category_extensions{lc($category)}},$extension;
}	}
}	close($fh);
	}

}	}
# ------------------------------------------------------------------ file types	# ------------------------------------------------------------------ file types
{	{
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.	my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filetypes.tab');	'/filetypes.tab';
if ($fh) {	if ( open (my $fh,"<$typesfile") ) {
while (<$fh>) {	while (<$fh>) {
next if (/^\#/);	next if (/^\#/);
chomp;	chomp;
my ($ending,$emb,$descr)=split(/\s+/,$_,3);	my ($ending,$emb,$descr)=split(/\s+/,$_,3);
if ($descr ne '') {	if ($descr ne '') {
$fe{$ending}=lc($emb);	$fe{$ending}=lc($emb);
$fd{$ending}=$descr;	$fd{$ending}=$descr;
}	}
}	}
}	close($fh);
	}
}	}
&Apache::lonnet::logthis(	&Apache::lonnet::logthis(
"<font color=yellow>INFO: Read file types</font>");	"<font color=yellow>INFO: Read file types</font>");
Line 204 BEGIN {	Line 201 BEGIN {

=pod	=pod

=head1 General Subroutines

=over 4

=head1 HTML and Javascript Functions	=head1 HTML and Javascript Functions

=over 4	=over 4
Line 219 containing javascript with two functions	Line 212 containing javascript with two functions
C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>	C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
tags.	tags.

=over 4

=item * openbrowser(formname,elementname,only,omit) [javascript]	=item * openbrowser(formname,elementname,only,omit) [javascript]

inputs: formname, elementname, only, omit	inputs: formname, elementname, only, omit
Line 241 Inputs: formname, elementname	Line 232 Inputs: formname, elementname
formname and elementname specify the name of the html form and the name	formname and elementname specify the name of the html form and the name
of the element the selection from the search results will be placed in.	of the element the selection from the search results will be placed in.

=back

=cut	=cut

sub browser_and_searcher_javascript {	sub browser_and_searcher_javascript {
Line 565 sub help_open_topic {	Line 554 sub help_open_topic {
my $template = "";	my $template = "";
my $link;	my $link;

	$topic=~s/\W/\_/g;

if (!$stayOnPage)	if (!$stayOnPage)
{	{
$link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";	$link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
Line 771 sub select_form {	Line 762 sub select_form {
return $selectform;	return $selectform;
}	}

	sub gradeleveldescription {
	my $gradelevel=shift;
	my %gradelevels=(0 => 'Not specified',
	1 => 'Grade 1',
	2 => 'Grade 2',
	3 => 'Grade 3',
	4 => 'Grade 4',
	5 => 'Grade 5',
	6 => 'Grade 6',
	7 => 'Grade 7',
	8 => 'Grade 8',
	9 => 'Grade 9',
	10 => 'Grade 10',
	11 => 'Grade 11',
	12 => 'Grade 12',
	13 => 'Grade 13',
	14 => '100 Level',
	15 => '200 Level',
	16 => '300 Level',
	17 => '400 Level',
	18 => 'Graduate Level');
	return &mt($gradelevels{$gradelevel});
	}

	sub select_level_form {
	my ($deflevel,$name)=@_;
	unless ($deflevel) { $deflevel=0; }
	my $selectform = "<select name=\"$name\" size=\"1\">\n";
	for (my $i=0; $i<=18; $i++) {
	$selectform.="<option value=\"$i\" ".
	($i==$deflevel ? 'selected' : '').
	">".&gradeleveldescription($i)."</option>\n";
	}
	$selectform.="</select>";
	return $selectform;
	}

#-------------------------------------------	#-------------------------------------------

Line 887 Outputs:	Line 914 Outputs:

=back	=back

	=back

=cut	=cut

###############################################################	###############################################################
Line 925 sub decode_user_agent {	Line 954 sub decode_user_agent {
$clientunicode,$clientos,);	$clientunicode,$clientos,);
}	}

=pod

=back

=cut

###############################################################	###############################################################
## Authentication changing form generation subroutines ##	## Authentication changing form generation subroutines ##
###############################################################	###############################################################
Line 971 See loncreateuser.pm for invocation and	Line 994 See loncreateuser.pm for invocation and

=back	=back

	=back

=cut	=cut

#-------------------------------------------	#-------------------------------------------
Line 998 END	Line 1023 END
$Javascript_toUpperCase = "";	$Javascript_toUpperCase = "";
}	}

	my $radioval = "'nochange'";
	my $argfield = 'null';
	if ( grep/^mode$/,(keys %in) ) {
	if ($in{'mode'} eq 'modifycourse') {
	if ( grep/^curr_authtype$/,(keys %in) ) {
	$radioval = "'$in{'curr_authtype'}'";
	}
	if ( grep/^curr_autharg$/,(keys %in) ) {
	unless ($in{'curr_autharg'} eq '') {
	$argfield = "'$in{'curr_autharg'}'";
	}
	}
	}
	}

$result.=<<"END";	$result.=<<"END";
var current = new Object();	var current = new Object();
current.radiovalue = 'nochange';	current.radiovalue = $radioval;
current.argfield = null;	current.argfield = $argfield;

function changed_radio(choice,currentform) {	function changed_radio(choice,currentform) {
var choicearg = choice + 'arg';	var choicearg = choice + 'arg';
Line 1088 sub authform_kerberos{	Line 1128 sub authform_kerberos{
kerb_def_auth => 'krb4',	kerb_def_auth => 'krb4',
@_,	@_,
);	);
my ($check4,$check5);	my ($check4,$check5,$krbarg);
if ($in{'kerb_def_auth'} eq 'krb5') {	if ($in{'kerb_def_auth'} eq 'krb5') {
$check5 = " checked=\"on\"";	$check5 = " checked=\"on\"";
} else {	} else {
$check4 = " checked=\"on\"";	$check4 = " checked=\"on\"";
}	}
	$krbarg = $in{'kerb_def_dom'};

	my $krbcheck = "";
	if ( grep/^curr_authtype$/,(keys %in) ) {
	if ($in{'curr_authtype'} =~ m/^krb/) {
	$krbcheck = " checked=\"on\"";
	if ( grep/^curr_autharg$/,(keys %in) ) {
	$krbarg = $in{'curr_autharg'};
	}
	}
	}

my $jscall = "javascript:changed_radio('krb',$in{'formname'});";	my $jscall = "javascript:changed_radio('krb',$in{'formname'});";
my $result .= &mt	my $result .= &mt
('[_1] Kerberos authenticated with domain [_2] '.	('[_1] Kerberos authenticated with domain [_2] '.
'[_3] Version 4 [_4] Version 5',	'[_3] Version 4 [_4] Version 5',
'<input type="radio" name="login" value="krb" '.	'<input type="radio" name="login" value="krb" '.
'onclick="'.$jscall.'" onchange="'.$jscall.'" />',	'onclick="'.$jscall.'" onchange="'.$jscall.'"'.$krbcheck.' />',
'<input type="text" size="10" name="krbarg" '.	'<input type="text" size="10" name="krbarg" '.
'value="'.$in{'kerb_def_dom'}.'" '.	'value="'.$krbarg.'" '.
'onchange="'.$jscall.'" />',	'onchange="'.$jscall.'" />',
'<input type="radio" name="krbver" value="4" '.$check4.' />',	'<input type="radio" name="krbver" value="4" '.$check4.' />',
'<input type="radio" name="krbver" value="5" '.$check5.' />');	'<input type="radio" name="krbver" value="5" '.$check5.' />');
Line 1114 sub authform_internal{	Line 1166 sub authform_internal{
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);

	my $intcheck = "";
	my $intarg = 'value=""';
	if ( grep/^curr_authtype$/,(keys %args) ) {
	if ($args{'curr_authtype'} eq 'int') {
	$intcheck = " checked=\"on\"";
	if ( grep/^curr_autharg$/,(keys %args) ) {
	$intarg = "value=\"$args{'curr_autharg'}\"";
	}
	}
	}

my $jscall = "javascript:changed_radio('int',$args{'formname'});";	my $jscall = "javascript:changed_radio('int',$args{'formname'});";
my $result.=&mt	my $result.=&mt
('[_1] Internally authenticated (with initial password [_2])',	('[_1] Internally authenticated (with initial password [_2])',
'<input type="radio" name="login" value="int" '.	'<input type="radio" name="login" value="int" '.$intcheck.
'onchange="'.$jscall.'" onclick="'.$jscall.'" />',	' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
'<input type="text" size="10" name="intarg" value="" '.	'<input type="text" size="10" name="intarg" '.$intarg.
'onchange="'.$jscall.'" />');	' onchange="'.$jscall.'" />');
return $result;	return $result;
}	}

Line 1130 sub authform_local{	Line 1194 sub authform_local{
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);

	my $loccheck = "";
	my $locarg = 'value=""';
	if ( grep/^curr_authtype$/,(keys %in) ) {
	if ($in{'curr_authtype'} eq 'loc') {
	$loccheck = " checked=\"on\"";
	if ( grep/^curr_autharg$/,(keys %in) ) {
	$locarg = "value=\"$in{'curr_autharg'}\"";
	}
	}
	}

my $jscall = "javascript:changed_radio('loc',$in{'formname'});";	my $jscall = "javascript:changed_radio('loc',$in{'formname'});";
my $result.=&mt('[_1] Local Authentication with arguement [_2]',	my $result.=&mt('[_1] Local Authentication with argument [_2]',
'<input type="radio" name="login" value="loc" '.	'<input type="radio" name="login" value="loc" '.$loccheck.
'onchange="'.$jscall.'" onclick="'.$jscall.'" />',	' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
'<input type="text" size="10" name="locarg" value="" '.	'<input type="text" size="10" name="locarg" '.$locarg.
'onchange="'.$jscall.'" />');	' onchange="'.$jscall.'" />');
return $result;	return $result;
}	}

Line 1155 sub authform_filesystem{	Line 1231 sub authform_filesystem{
return $result;	return $result;
}	}

=pod

=back

=cut

###############################################################	###############################################################
## Get Authentication Defaults for Domain ##	## Get Authentication Defaults for Domain ##
###############################################################	###############################################################
Line 1315 sub keyword {	Line 1385 sub keyword {

=item * get_related_words	=item * get_related_words

Look up a word in the thesaurus. Takes a scalar arguement and returns	Look up a word in the thesaurus. Takes a scalar argument and returns
an array of words. If the keyword is not in the thesaurus, an empty array	an array of words. If the keyword is not in the thesaurus, an empty array
will be returned. The order of the words returned is determined by the	will be returned. The order of the words returned is determined by the
database which holds them.	database which holds them.
Line 1451 sub noteswrapper {	Line 1521 sub noteswrapper {
# ------------------------------------------------------------- Aboutme Wrapper	# ------------------------------------------------------------- Aboutme Wrapper

sub aboutmewrapper {	sub aboutmewrapper {
my ($link,$username,$domain)=@_;	my ($link,$username,$domain,$target)=@_;
return "<a href='/adm/$domain/$username/aboutme'>$link</a>";	return "<a href='/adm/$domain/$username/aboutme'".
	($target?" target='$target'":'').">$link</a>";
}	}

# ------------------------------------------------------------ Syllabus Wrapper	# ------------------------------------------------------------ Syllabus Wrapper
Line 1530 returns description of a specified copyr	Line 1601 returns description of a specified copyr
=cut	=cut

sub copyrightdescription {	sub copyrightdescription {
return $cprtag{shift(@_)};	return &mt($cprtag{shift(@_)});
}	}

=pod	=pod
Line 1579 returns description for a specified file	Line 1650 returns description for a specified file
=cut	=cut

sub filedescription {	sub filedescription {
return $fd{lc(shift(@_))};	return &mt($fd{lc(shift(@_))});
}	}

=pod	=pod
Line 1593 extra formatting	Line 1664 extra formatting

sub filedescriptionex {	sub filedescriptionex {
my $ex=shift;	my $ex=shift;
return '.'.$ex.' '.$fd{lc($ex)};	return '.'.$ex.' '.&mt($fd{lc($ex)});
}	}

# End of .tab access	# End of .tab access
Line 1921 sub maketime {	Line 1992 sub maketime {
$th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));	$th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));
}	}


#########################################
#
# Retro-fixing of un-backward-compatible time format

sub unsqltime {
my $timestamp=shift;
if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
$timestamp=&maketime(
'year'=>$1,'month'=>$2,'day'=>$3,
'hours'=>$4,'minutes'=>$5,'seconds'=>$6);
}
return $timestamp;
}

#########################################	#########################################

sub findallcourses {	sub findallcourses {
Line 2007 sub domainlogo {	Line 2063 sub domainlogo {
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};	my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }	if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.	return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.
'/adm/lonDomLogos/'.$domain.'.gif" />';	'/adm/lonDomLogos/'.$domain.'.gif" alt="'.$domain.'" />';
} elsif(exists($Apache::lonnet::domaindescription{$domain})) {	} elsif(exists($Apache::lonnet::domaindescription{$domain})) {
return $Apache::lonnet::domaindescription{$domain};	return $Apache::lonnet::domaindescription{$domain};
} else {	} else {
Line 2118 sub bodytag {	Line 2174 sub bodytag {
my $sidebg=&designparm($function.'.sidebg',$domain);	my $sidebg=&designparm($function.'.sidebg',$domain);
# Accessibility font enhance	# Accessibility font enhance
unless ($addentries) { $addentries=''; }	unless ($addentries) { $addentries=''; }
	my $addstyle='';
if ($ENV{'browser.fontenhance'} eq 'on') {	if ($ENV{'browser.fontenhance'} eq 'on') {
$addentries.=' style="font-size: x-large"';	$addstyle=' font-size: x-large;';
}	}
# role and realm	# role and realm
my ($role,$realm)	my ($role,$realm)
Line 2137 sub bodytag {	Line 2194 sub bodytag {
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }	if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
# construct main body tag	# construct main body tag
my $bodytag = <<END;	my $bodytag = <<END;
	<style>
	h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
	a:focus { color: red; background: yellow }
	</style>
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"	<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
$addentries>	style="margin-top: 0px;$addstyle" $addentries>
END	END
my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.	my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
$lonhttpdPort.$img.'" />';	$lonhttpdPort.$img.'" alt="'.$function.'" />';
if ($bodyonly) {	if ($bodyonly) {
return $bodytag;	return $bodytag;
} elsif ($ENV{'browser.interface'} eq 'textual') {	} elsif ($ENV{'browser.interface'} eq 'textual') {
Line 2153 END	Line 2214 END
# No Remote	# No Remote
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',	return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
$forcereg).	$forcereg).
'<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td bgcolor="'.$tabbg.'"><font size="+3" color="'.$font.'"><b>'.$title.	'<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td bgcolor="'.$tabbg.'"><font face="Arial, Helvetica, sans-serif" size="+3" color="'.$font.'"><b>'.$title.
'</b></font></td></tr></table>';	'</b></font></td></tr></table>';
}	}

Line 2169 $upperleft</td>	Line 2230 $upperleft</td>
</tr>	</tr>
<tr>	<tr>
<td rowspan="3" bgcolor="$tabbg">	<td rowspan="3" bgcolor="$tabbg">
<font size="5"><b>$title</b></font>	<font size="5" face="Arial, Helvetica, sans-serif"><b>$title</b></font>
<td bgcolor="$tabbg" align="right">	<td bgcolor="$tabbg" align="right">
<font size="2">	<font size="2" face="Arial, Helvetica, sans-serif">
$ENV{'environment.firstname'}	$ENV{'environment.firstname'}
$ENV{'environment.middlename'}	$ENV{'environment.middlename'}
$ENV{'environment.lastname'}	$ENV{'environment.lastname'}
Line 2180 $upperleft</td>	Line 2241 $upperleft</td>
</td>	</td>
</tr>	</tr>
<tr><td bgcolor="$tabbg" align="right">	<tr><td bgcolor="$tabbg" align="right">
<font size="2">$role</font>	<font size="2" face="Arial, Helvetica, sans-serif">$role</font>
</td></tr>	</td></tr>
<tr>	<tr>
<td bgcolor="$tabbg" align="right"><font size="2">$realm</font> </td></tr>	<td bgcolor="$tabbg" align="right"><font size="2" face="Arial, Helvetica, sans-serif">$realm</font> </td></tr>
</table><br>	</table><br>
ENDBODY	ENDBODY
}	}
Line 2360 sub add_to_env {	Line 2421 sub add_to_env {

=pod	=pod

	=item * get_env_multiple($name)

	gets $name from the %ENV hash, it seemlessly handles the cases where multiple
	values may be defined and end up as an array ref.

	returns an array of values

	=cut

	sub get_env_multiple {
	my ($name) = @_;
	my @values;
	if (defined($ENV{$name})) {
	# exists is it an array
	if (ref($ENV{$name})) {
	@values=@{ $ENV{$name} };
	} else {
	$values[0]=$ENV{$name};
	}
	}
	return(@values);
	}


	=pod

=back	=back

=head1 CSV Upload/Handling functions	=head1 CSV Upload/Handling functions
Line 2384 sub upfile_store {	Line 2471 sub upfile_store {
my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.	my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
'_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;	'_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
{	{
my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').	my $datafile = $r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp');	'/tmp/'.$datatoken.'.tmp';
print $fh $ENV{'form.upfile'};	if ( open(my $fh,">$datafile") ) {
	print $fh $ENV{'form.upfile'};
	close($fh);
	}
}	}
return $datatoken;	return $datatoken;
}	}
Line 2405 sub load_tmp_file {	Line 2495 sub load_tmp_file {
my $r=shift;	my $r=shift;
my @studentdata=();	my @studentdata=();
{	{
my $fh;	my $studentfile = $r->dir_config('lonDaemons').
if ($fh=Apache::File->new($r->dir_config('lonDaemons').	'/tmp/'.$ENV{'form.datatoken'}.'.tmp';
'/tmp/'.$ENV{'form.datatoken'}.'.tmp')) {	if ( open(my $fh,"<$studentfile") ) {
@studentdata=<$fh>;	@studentdata=<$fh>;
}	close($fh);
	}
}	}
$ENV{'form.upfile'}=join('',@studentdata);	$ENV{'form.upfile'}=join('',@studentdata);
}	}
Line 2698 sub check_if_partid_hidden {	Line 2789 sub check_if_partid_hidden {

=pod	=pod

	=back

=head1 cgi-bin script and graphing routines	=head1 cgi-bin script and graphing routines

	=over 4

=item get_cgi_id	=item get_cgi_id

Inputs: none	Inputs: none
Line 2713 the routine &Apache::lonnet::transfer_pr	Line 2808 the routine &Apache::lonnet::transfer_pr

############################################################	############################################################
############################################################	############################################################
	my $uniq=0;
sub get_cgi_id {	sub get_cgi_id {
return (time.'_'.int(rand(1000)));	$uniq=($uniq+1)%100000;
	return (time.'_'.$uniq);
}	}

############################################################	############################################################
Line 3031 sub DrawXYYGraph {	Line 3127 sub DrawXYYGraph {

=pod	=pod

	=back

=head1 Statistics helper routines?	=head1 Statistics helper routines?

Bad place for them but what the hell.	Bad place for them but what the hell.

	=over 4

=item &chartlink	=item &chartlink

Returns a link to the chart for a specific student.	Returns a link to the chart for a specific student.
Line 3051 Inputs:	Line 3151 Inputs:

=back	=back

	=back

=cut	=cut

############################################################	############################################################
Line 3063 sub chartlink {	Line 3165 sub chartlink {
'">'.$linktext.'</a>';	'">'.$linktext.'</a>';
}	}

	#######################################################
	#######################################################

	=pod

	=head1 Course Environment Routines

	=over 4

	=item &restore_course_settings

	=item &store_course_settings

	Restores/Store indicated form parameters from the course environment.
	Will not overwrite existing values of the form parameters.

	Inputs:
	a scalar describing the data (e.g. 'chart', 'problem_analysis')

	a hash ref describing the data to be stored. For example:

	%Save_Parameters = ('Status' => 'scalar',
	'chartoutputmode' => 'scalar',
	'chartoutputdata' => 'scalar',
	'Section' => 'array',
	'StudentData' => 'array',
	'Maps' => 'array');

	Returns: both routines return nothing

	=cut

	#######################################################
	#######################################################
	sub store_course_settings {
	# save to the environment
	# appenv the same items, just to be safe
	my $courseid = $ENV{'request.course.id'};
	my $coursedom = $ENV{'course.'.$courseid.'.domain'};
	my ($prefix,$Settings) = @_;
	my %SaveHash;
	my %AppHash;
	while (my ($setting,$type) = each(%$Settings)) {
	my $basename = 'env.internal.'.$prefix.'.'.$setting;
	my $envname = 'course.'.$courseid.'.'.$basename;
	if (exists($ENV{'form.'.$setting})) {
	# Save this value away
	if ($type eq 'scalar' &&
	(! exists($ENV{$envname}) \|\|
	$ENV{$envname} ne $ENV{'form.'.$setting})) {
	$SaveHash{$basename} = $ENV{'form.'.$setting};
	$AppHash{$envname} = $ENV{'form.'.$setting};
	} elsif ($type eq 'array') {
	my $stored_form;
	if (ref($ENV{'form.'.$setting})) {
	$stored_form = join(',',
	map {
	&Apache::lonnet::escape($_);
	} sort(@{$ENV{'form.'.$setting}}));
	} else {
	$stored_form =
	&Apache::lonnet::escape($ENV{'form.'.$setting});
	}
	# Determine if the array contents are the same.
	if ($stored_form ne $ENV{$envname}) {
	$SaveHash{$basename} = $stored_form;
	$AppHash{$envname} = $stored_form;
	}
	}
	}
	}
	my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
	$coursedom,
	$ENV{'course.'.$courseid.'.num'});
	if ($put_result !~ /^(ok\|delayed)/) {
	&Apache::lonnet::logthis('unable to save form parameters, '.
	'got error:'.$put_result);
	}
	# Make sure these settings stick around in this session, too
	&Apache::lonnet::appenv(%AppHash);
	return;
	}

	sub restore_course_settings {
	my $courseid = $ENV{'request.course.id'};
	my ($prefix,$Settings) = @_;
	while (my ($setting,$type) = each(%$Settings)) {
	next if (exists($ENV{'form.'.$setting}));
	my $envname = 'course.'.$courseid.'.env.internal.'.$prefix.
	'.'.$setting;
	if (exists($ENV{$envname})) {
	if ($type eq 'scalar') {
	$ENV{'form.'.$setting} = $ENV{$envname};
	} elsif ($type eq 'array') {
	$ENV{'form.'.$setting} = [
	map {
	&Apache::lonnet::unescape($_);
	} split(',',$ENV{$envname})
	];
	}
	}
	}
	}

############################################################	############################################################
############################################################	############################################################

	sub propath {
	my ($udom,$uname)=@_;
	$udom=~s/\W//g;
	$uname=~s/\W//g;
	my $subdir=$uname.'__';
	$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
	my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
	return $proname;
	}

	sub icon {
	my ($file)=@_;
	my @file_ext = split(/\./,$file);
	my $curfext = $file_ext[-1];
	my $iconname="unknown.gif";
	my $embstyle = &Apache::loncommon::fileembstyle($curfext);
	# The unless conditional that follows is a bit of overkill
	$iconname = $curfext.".gif" unless
	(!defined($embstyle) \|\| $embstyle eq 'unk' \|\| $embstyle eq 'hdn');
	return $Apache::lonnet::perlvar{'lonIconsURL'}."/$iconname";
	}

=pod	=pod

=back	=back

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

Removed from v.1.145
changed lines
	Added in v.1.167