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.147 and 1.169

version 1.147, 2003/11/10 01:59:55	version 1.169, 2004/01/02 19:23:47
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 735 sub get_domains {	Line 726 sub get_domains {
my @domains;	my @domains;
my %seen;	my %seen;
foreach (sort values(%Apache::lonnet::hostdom)) {	foreach (sort values(%Apache::lonnet::hostdom)) {
push (@domains,$_) unless $seen{$_}++;	push (@domains,$_) unless $seen{$_}++;
}	}
return @domains;	return @domains;
}	}

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

	sub domain_select {
	my ($name,$value,$multiple)=@_;
	my %domains=map {
	$_ => $_.' '.$Apache::lonnet::domaindescription{$_}
	} &get_domains;
	if ($multiple) {
	$domains{''}=&mt('Any domain');
	return &multiple_select_form($name,$value,%domains);
	} else {
	return &select_form($name,$value,%domains);
	}
	}

	sub multiple_select_form {
	my ($name,$value,%hash)=@_;
	my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
	my $output='';
	my $size =(scalar keys %hash<4?scalar keys %hash:4);
	$output.="\n<select name='$name' size='$size' multiple='1'>";
	foreach (sort keys %hash) {
	$output.="<option name='$_'".
	($selected{$_}?' selected="1"' :'').">$hash{$_}</option>\n";
	}
	$output.="</select>\n";
	return $output;
	}

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

=pod	=pod
Line 771 sub select_form {	Line 791 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 943 Outputs:

=back	=back

	=back

=cut	=cut

###############################################################	###############################################################
Line 925 sub decode_user_agent {	Line 983 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 1023 See loncreateuser.pm for invocation and

=back	=back

	=back

=cut	=cut

#-------------------------------------------	#-------------------------------------------
Line 998 END	Line 1052 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 1157 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 1195 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 1223 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 1260 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 1414 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 1550 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 1630 returns description of a specified copyr
=cut	=cut

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

=pod	=pod
Line 1570 sub fileembstyle {	Line 1670 sub fileembstyle {
return $fe{lc(shift(@_))};	return $fe{lc(shift(@_))};
}	}


	sub filecategoryselect {
	my ($name,$value)=@_;
	return &select_form($name,$value,
	'' => &mt('Any category'),
	map { $_,$_ } sort(keys(%category_extensions)));
	}

=pod	=pod

=item * filedescription()	=item * filedescription()
Line 1579 returns description for a specified file	Line 1687 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 1701 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 2029 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 2100 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 2140 sub bodytag {	Line 2233 sub bodytag {
my $bodytag = <<END;	my $bodytag = <<END;
<style>	<style>
h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }	h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
a:hover { color: black; background: yellow }
a:focus { color: red; background: yellow }	a:focus { color: red; background: yellow }
</style>	</style>
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"	<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
style="border-color: $tabbg; border-width: 4px; border-style: solid; padding: 4px;$addstyle" $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 2159 END	Line 2251 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 2189 $upperleft</td>	Line 2281 $upperleft</td>
<font size="2" face="Arial, Helvetica, sans-serif">$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 2366 sub add_to_env {	Line 2458 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 2390 sub upfile_store {	Line 2508 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 2411 sub load_tmp_file {	Line 2532 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 2704 sub check_if_partid_hidden {	Line 2826 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 2719 the routine &Apache::lonnet::transfer_pr	Line 2845 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 3037 sub DrawXYYGraph {	Line 3164 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 3057 Inputs:	Line 3188 Inputs:

=back	=back

	=back

=cut	=cut

############################################################	############################################################
Line 3069 sub chartlink {	Line 3202 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 $curfext = (split(/\./,$file))[-1];
	my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
	my $embstyle = &Apache::loncommon::fileembstyle($curfext);
	if (!(!defined($embstyle) \|\| $embstyle eq 'unk' \|\| $embstyle eq 'hdn')) {
	if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
	$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
	$curfext.".gif") {
	$iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
	$curfext.".gif";
	}
	}
	return $iconname;
	}

=pod	=pod

=back	=back

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

Removed from v.1.147
changed lines
	Added in v.1.169