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.142 and 1.190

version 1.142, 2003/11/04 19:01:01	version 1.190, 2004/04/30 23:04:53
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 91 my %category_extensions;	Line 82 my %category_extensions;
my %designhash;	my %designhash;

# ---------------------------------------------- Thesaurus variables	# ---------------------------------------------- Thesaurus variables
	#
# FIXME: I don't think it's necessary to document these things;	# %Keywords:
# they're privately used - Jeremy	# A hash used by &keyword to determine if a word is considered a keyword.
	# $thesaurus_db_file
=pod	# Scalar containing the full path to the thesaurus database.

=over 4

=item * %Keywords

A hash used by &keyword to determine if a word is considered a keyword.

=item * $thesaurus_db_file

Scalar containing the full path to the thesaurus database.

=back

=cut

my %Keywords;	my %Keywords;
my $thesaurus_db_file;	my $thesaurus_db_file;

# ----------------------------------------------------------------------- BEGIN	#
	# Initialize values from language.tab, copyright.tab, filetypes.tab,
# FIXME: I don't think this needs to be documented, it prepares	# thesaurus.tab, and filecategories.tab.
# private data structures - Jeremy	#
=pod

=head1 General Subroutines

=over 4

=item * BEGIN()

Initialize values from language.tab, copyright.tab, filetypes.tab,
thesaurus.tab, and filecategories.tab.

=back

=cut

# ----------------------------------------------------------------------- BEGIN

BEGIN {	BEGIN {
# Variable initialization	# Variable initialization
$thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";	$thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
Line 142 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 178 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 195 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 246 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 256 formname and elementname indicate the na	Line 220 formname and elementname indicate the na
the element that the results of the browsing selection are to be placed in.	the element that the results of the browsing selection are to be placed in.

Specifying 'only' will restrict the browser to displaying only files	Specifying 'only' will restrict the browser to displaying only files
with the given extension. Can be a comma seperated list.	with the given extension. Can be a comma separated list.

Specifying 'omit' will restrict the browser to NOT displaying files	Specifying 'omit' will restrict the browser to NOT displaying files
with the given extension. Can be a comma seperated list.	with the given extension. Can be a comma separated list.

=item * opensearcher(formname, elementname) [javascript]	=item * opensearcher(formname, elementname) [javascript]

Line 268 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 {
	my $resurl=&lastresurl();
return <<END;	return <<END;
var editbrowser = null;	var editbrowser = null;
function openbrowser(formname,elementname,only,omit,titleelement) {	function openbrowser(formname,elementname,only,omit,titleelement) {
var url = '/res/?';	var url = '$resurl/?';
if (editbrowser == null) {	if (editbrowser == null) {
url += 'launch=1&';	url += 'launch=1&';
}	}
Line 321 sub browser_and_searcher_javascript {	Line 284 sub browser_and_searcher_javascript {
END	END
}	}

	sub lastresurl {
	if ($ENV{'environment.lastresurl'}) {
	return $ENV{'environment.lastresurl'}
	} else {
	return '/res';
	}
	}

	sub storeresurl {
	my $resurl=&Apache::lonnet::clutter(shift);
	unless ($resurl=~/^\/res/) { return 0; }
	$resurl=~s/\/$//;
	&Apache::lonnet::put('environment',{'lastresurl' => $resurl});
	&Apache::lonnet::appenv('environment.lastresurl' => $resurl);
	return 1;
	}

sub studentbrowser_javascript {	sub studentbrowser_javascript {
unless (	unless (
(($ENV{'request.course.id'}) &&	(($ENV{'request.course.id'}) &&
Line 373 sub coursebrowser_javascript {	Line 353 sub coursebrowser_javascript {
return (<<ENDSTDBRW);	return (<<ENDSTDBRW);
<script type="text/javascript" language="Javascript" >	<script type="text/javascript" language="Javascript" >
var stdeditbrowser;	var stdeditbrowser;
function opencrsbrowser(formname,uname,udom) {	function opencrsbrowser(formname,uname,udom,desc) {
var url = '/adm/pickcourse?';	var url = '/adm/pickcourse?';
var filter;	var filter;
if (filter != null) {	if (filter != null) {
Line 388 sub coursebrowser_javascript {	Line 368 sub coursebrowser_javascript {
}	}
}	}
url += 'form=' + formname + '&cnumelement='+uname+	url += 'form=' + formname + '&cnumelement='+uname+
'&cdomelement='+udom;	'&cdomelement='+udom+
	'&cnameelement='+desc;
var title = 'Course_Browser';	var title = 'Course_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=0';
options += ',width=700,height=600';	options += ',width=700,height=600';
Line 400 ENDSTDBRW	Line 381 ENDSTDBRW
}	}

sub selectcourse_link {	sub selectcourse_link {
my ($form,$unameele,$udomele)=@_;	my ($form,$unameele,$udomele,$desc)=@_;
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.	return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
'","'.$udomele.'");'."'>".&mt('Select Course')."</a>";	'","'.$udomele.'","'.$desc.'");'."'>".&mt('Select Course')."</a>";
}	}

=pod	=pod
Line 521 function select1_changed() {	Line 502 function select1_changed() {
// in with the nuclear	// in with the nuclear
for (i=0;i<values.length; i++) {	for (i=0;i<values.length; i++) {
$second.options[i] = new Option(values[i]);	$second.options[i] = new Option(values[i]);
	$second.options[i].value = values[i];
$second.options[i].text = texts[i];	$second.options[i].text = texts[i];
if (values[i] == select2def) {	if (values[i] == select2def) {
$second.options[i].selected = true;	$second.options[i].selected = true;
Line 591 sub help_open_topic {	Line 573 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 609 sub help_open_topic {	Line 593 sub help_open_topic {
}	}

# Add the graphic	# Add the graphic
	my $title = &mt('Online Help');
$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
<a href="$link"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>	<a href="$link" title="$title"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>
ENDTEMPLATE	ENDTEMPLATE
if ($text ne '') { $template.='</td></tr></table>' };	if ($text ne '') { $template.='</td></tr></table>' };
return $template;	return $template;
Line 637 sub helpLatexCheatsheet {	Line 622 sub helpLatexCheatsheet {
.'</td></tr></table>';	.'</td></tr></table>';
}	}

	sub help_open_bug {
	my ($topic, $text, $stayOnPage, $width, $height) = @_;
	unless ($ENV{'user.adv'}) { return ''; }
	unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
	$text = "" if (not defined $text);
	$stayOnPage = 0 if (not defined $stayOnPage);
	if ($ENV{'browser.interface'} eq 'textual' \|\|
	$ENV{'environment.remote'} eq 'off' ) {
	$stayOnPage=1;
	}
	$width = 600 if (not defined $width);
	$height = 600 if (not defined $height);

	$topic=~s/\W+/\+/g;
	my $link='';
	my $template='';
	my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
	&Apache::lonnet::escape($ENV{'REQUEST_URI'}).'&component='.$topic;
	if (!$stayOnPage)
	{
	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
	}
	else
	{
	$link = $url;
	}
	# Add the text
	if ($text ne "")
	{
	$template .=
	"<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
	"<td bgcolor='#FF5555'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
	}

	# Add the graphic
	my $title = &mt('Report a Bug');
	$template .= <<"ENDTEMPLATE";
	<a href="$link" title="$title"><image src="/adm/lonMisc/smallBug.gif" border="0" alt="(Bug: $topic)" /></a>
	ENDTEMPLATE
	if ($text ne '') { $template.='</td></tr></table>' };
	return $template;

	}

	sub help_open_faq {
	my ($topic, $text, $stayOnPage, $width, $height) = @_;
	unless ($ENV{'user.adv'}) { return ''; }
	unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
	$text = "" if (not defined $text);
	$stayOnPage = 0 if (not defined $stayOnPage);
	if ($ENV{'browser.interface'} eq 'textual' \|\|
	$ENV{'environment.remote'} eq 'off' ) {
	$stayOnPage=1;
	}
	$width = 350 if (not defined $width);
	$height = 400 if (not defined $height);

	$topic=~s/\W+/\+/g;
	my $link='';
	my $template='';
	my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
	if (!$stayOnPage)
	{
	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
	}
	else
	{
	$link = $url;
	}

	# Add the text
	if ($text ne "")
	{
	$template .=
	"<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
	"<td bgcolor='#448844'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
	}

	# Add the graphic
	my $title = &mt('View the FAQ');
	$template .= <<"ENDTEMPLATE";
	<a href="$link" title="$title"><image src="/adm/lonMisc/smallFAQ.gif" border="0" alt="(FAQ: $topic)" /></a>
	ENDTEMPLATE
	if ($text ne '') { $template.='</td></tr></table>' };
	return $template;

	}

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

=pod	=pod

=item * csv_translate($text)	=item * csv_translate($text)

Translate $text to allow it to be output as a 'comma seperated values'	Translate $text to allow it to be output as a 'comma separated values'
format.	format.

=cut	=cut

	###############################################################
	###############################################################
sub csv_translate {	sub csv_translate {
my $text = shift;	my $text = shift;
$text =~ s/\"/\"\"/g;	$text =~ s/\"/\"\"/g;
Line 653 sub csv_translate {	Line 731 sub csv_translate {
return $text;	return $text;
}	}


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

	=pod

	=item * define_excel_formats

	Define some commonly used Excel cell formats.

	Currently supported formats:

	=over 4

	=item header

	=item bold

	=item h1

	=item h2

	=item h3

	=item date

	=back

	Inputs: $workbook

	Returns: $format, a hash reference.

	=cut

	###############################################################
	###############################################################
	sub define_excel_formats {
	my ($workbook) = @_;
	my $format;
	$format->{'header'} = $workbook->add_format(bold => 1,
	bottom => 1,
	align => 'center');
	$format->{'bold'} = $workbook->add_format(bold=>1);
	$format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
	$format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
	$format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
	$format->{'date'} = $workbook->add_format(num_format=>
	'mmm d yyyy hh:mm AM/PM');
	return $format;
	}

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

=pod	=pod

=item * change_content_javascript():	=item * change_content_javascript():
Line 761 sub get_domains {	Line 893 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 797 sub select_form {	Line 958 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 913 Outputs:	Line 1110 Outputs:

=back	=back

	=back

=cut	=cut

###############################################################	###############################################################
Line 951 sub decode_user_agent {	Line 1150 sub decode_user_agent {
$clientunicode,$clientos,);	$clientunicode,$clientos,);
}	}

=pod

=back

=cut

###############################################################	###############################################################
## Authentication changing form generation subroutines ##	## Authentication changing form generation subroutines ##
###############################################################	###############################################################
Line 997 See loncreateuser.pm for invocation and	Line 1190 See loncreateuser.pm for invocation and

=back	=back

	=back

=cut	=cut

#-------------------------------------------	#-------------------------------------------
Line 1024 END	Line 1219 END
$Javascript_toUpperCase = "";	$Javascript_toUpperCase = "";
}	}

	my $radioval = "'nochange'";
	if (exists($in{'curr_authtype'}) &&
	defined($in{'curr_authtype'}) &&
	$in{'curr_authtype'} ne '') {
	$radioval = "'$in{'curr_authtype'}arg'";
	}
	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 1087 END	Line 1302 END

sub authform_authorwarning{	sub authform_authorwarning{
my $result='';	my $result='';
$result=<<"END";	$result='<i>'.
<i>As a general rule, only authors or co-authors should be filesystem	&mt('As a general rule, only authors or co-authors should be '.
authenticated (which allows access to the server filesystem).</i>	'filesystem authenticated '.
END	'(which allows access to the server filesystem).')."</i>\n";
return $result;	return $result;
}	}

Line 1100 sub authform_nochange{	Line 1315 sub authform_nochange{
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my $result='';	my $result = &mt('[_1] Do not change login data',
$result.=<<"END";	'<input type="radio" name="login" value="nochange" '.
<input type="radio" name="login" value="nochange" checked="checked"	'checked="checked" onclick="'.
onclick="javascript:changed_radio('nochange',$in{'formname'});" />	"javascript:changed_radio('nochange',$in{'formname'});".'" />');
Do not change login data
END
return $result;	return $result;
}	}

Line 1116 sub authform_kerberos{	Line 1329 sub authform_kerberos{
kerb_def_auth => 'krb4',	kerb_def_auth => 'krb4',
@_,	@_,
);	);
my $result='';	my ($check4,$check5,$krbarg);
my $check4;
my $check5;
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\"";
}	}
$result.=<<"END";	$krbarg = $in{'kerb_def_dom'};
<input type="radio" name="login" value="krb"
onclick="javascript:changed_radio('krb',$in{'formname'});"	my $krbcheck = "";
onchange="javascript:changed_radio('krb',$in{'formname'});" />	if ( grep/^curr_authtype$/,(keys %in) ) {
Kerberos authenticated with domain	if ($in{'curr_authtype'} =~ m/^krb/) {
<input type="text" size="10" name="krbarg" value="$in{'kerb_def_dom'}"	$krbcheck = " checked=\"on\"";
onchange="javascript:changed_text('krb',$in{'formname'});" />	if ( grep/^curr_autharg$/,(keys %in) ) {
<input type="radio" name="krbver" value="4" $check4 />Version 4	$krbarg = $in{'curr_autharg'};
<input type="radio" name="krbver" value="5" $check5 />Version 5	}
END	}
	}

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

Line 1143 sub authform_internal{	Line 1367 sub authform_internal{
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my $result='';
$result.=<<"END";	my $intcheck = "";
<input type="radio" name="login" value="int"	my $intarg = 'value=""';
onchange="javascript:changed_radio('int',$args{'formname'});"	if ( grep/^curr_authtype$/,(keys %args) ) {
onclick="javascript:changed_radio('int',$args{'formname'});" />	if ($args{'curr_authtype'} eq 'int') {
Internally authenticated (with initial password	$intcheck = " checked=\"on\"";
<input type="text" size="10" name="intarg" value=""	if ( grep/^curr_autharg$/,(keys %args) ) {
onchange="javascript:changed_text('int',$args{'formname'});" />)	$intarg = "value=\"$args{'curr_autharg'}\"";
END	}
	}
	}

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

Line 1161 sub authform_local{	Line 1395 sub authform_local{
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my $result='';
$result.=<<"END";	my $loccheck = "";
<input type="radio" name="login" value="loc"	my $locarg = 'value=""';
onchange="javascript:changed_radio('loc',$in{'formname'});"	if ( grep/^curr_authtype$/,(keys %in) ) {
onclick="javascript:changed_radio('loc',$in{'formname'});" />	if ($in{'curr_authtype'} eq 'loc') {
Local Authentication with argument	$loccheck = " checked=\"on\"";
<input type="text" size="10" name="locarg" value=""	if ( grep/^curr_autharg$/,(keys %in) ) {
onchange="javascript:changed_text('loc',$in{'formname'});" />	$locarg = "value=\"$in{'curr_autharg'}\"";
END	}
	}
	}

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

Line 1179 sub authform_filesystem{	Line 1422 sub authform_filesystem{
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my $result='';	my $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
$result.=<<"END";	my $result.= &mt
<input type="radio" name="login" value="fsys"	('[_1] Filesystem Authenticated (with initial password [_2])',
onchange="javascript:changed_radio('fsys',$in{'formname'});"	'<input type="radio" name="login" value="fsys" '.
onclick="javascript:changed_radio('fsys',$in{'formname'});" />	'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
Filesystem authenticated (with initial password	'<input type="text" size="10" name="fsysarg" value="" '.
<input type="text" size="10" name="fsysarg" value=""	'onchange="'.$jscall.'" />');
onchange="javascript:changed_text('fsys',$in{'formname'});">)
END
return $result;	return $result;
}	}

=pod

=back

=cut

###############################################################	###############################################################
## Get Authentication Defaults for Domain ##	## Get Authentication Defaults for Domain ##
###############################################################	###############################################################
Line 1351 sub keyword {	Line 1586 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 1416 sub plainname {	Line 1651 sub plainname {
$names{'lastname'}.' '.$names{'generation'};	$names{'lastname'}.' '.$names{'generation'};
$name=~s/\s+$//;	$name=~s/\s+$//;
$name=~s/\s+/ /g;	$name=~s/\s+/ /g;
	if ($name !~ /\S/) { $name=$uname.'@'.$udom; }
return $name;	return $name;
}	}

Line 1487 sub noteswrapper {	Line 1723 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 1535 sub languagedescription {	Line 1772 sub languagedescription {
($supported_language{$code}?' ('.&mt('interface available').')':'');	($supported_language{$code}?' ('.&mt('interface available').')':'');
}	}

	sub plainlanguagedescription {
	my $code=shift;
	return $language{$code};
	}

	sub supportedlanguagecode {
	my $code=shift;
	return $supported_language{$code};
	}

=pod	=pod

=item * copyrightids()	=item * copyrightids()
Line 1556 returns description of a specified copyr	Line 1803 returns description of a specified copyr
=cut	=cut

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

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


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

=pod	=pod

=item * filedescription()	=item * filedescription()
Line 1605 returns description for a specified file	Line 1860 returns description for a specified file
=cut	=cut

sub filedescription {	sub filedescription {
return $fd{lc(shift(@_))};	my $file_description = $fd{lc(shift())};
	$file_description =~ s:([\[\]]):~$1:g;
	return &mt($file_description);
}	}

=pod	=pod
Line 1619 extra formatting	Line 1876 extra formatting

sub filedescriptionex {	sub filedescriptionex {
my $ex=shift;	my $ex=shift;
return '.'.$ex.' '.$fd{lc($ex)};	my $file_description = $fd{lc($ex)};
	$file_description =~ s:([\[\]]):~$1:g;
	return '.'.$ex.' '.&mt($file_description);
}	}

# End of .tab access	# End of .tab access
Line 1654 sub display_languages {	Line 1913 sub display_languages {

sub preferred_languages {	sub preferred_languages {
my @languages=();	my @languages=();
if ($ENV{'environment.languages'}) {
@languages=split(/\s(\,\|\;\|\:)\s/,$ENV{'environment.languages'});
}
if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) {	if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) {
@languages=(@languages,split(/\s(\,\|\;\|\:)\s/,	@languages=(@languages,split(/\s(\,\|\;\|\:)\s/,
$ENV{'course.'.$ENV{'request.course.id'}.'.languages'}));	$ENV{'course.'.$ENV{'request.course.id'}.'.languages'}));
}	}
	if ($ENV{'environment.languages'}) {
	@languages=split(/\s(\,\|\;\|\:)\s/,$ENV{'environment.languages'});
	}
my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];	my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];
if ($browser) {	if ($browser) {
@languages=(@languages,split(/\s(\,\|\;\|\:)\s/,$browser));	@languages=(@languages,split(/\s(\,\|\;\|\:)\s/,$browser));
Line 1840 show a snapshot of what student was look	Line 2099 show a snapshot of what student was look
=cut	=cut

sub get_student_view {	sub get_student_view {
my ($symb,$username,$domain,$courseid,$target) = @_;	my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);	my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
my (%old,%moreenv);	my (%form);
my @elements=('symb','courseid','domain','username');	my @elements=('symb','courseid','domain','username');
foreach my $element (@elements) {	foreach my $element (@elements) {
$old{$element}=$ENV{'form.grade_'.$element};	$form{'grade_'.$element}=eval '$'.$element #'
$moreenv{'form.grade_'.$element}=eval '$'.$element #'
}	}
if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';}	if (defined($moreenv)) {
&Apache::lonnet::appenv(%moreenv);	%form=(%form,%{$moreenv});
$feedurl=&Apache::lonnet::clutter($feedurl);
my $userview=&Apache::lonnet::ssi_body($feedurl);
&Apache::lonnet::delenv('form.grade_');
foreach my $element (@elements) {
$ENV{'form.grade_'.$element}=$old{$element};
}	}
	if ($target eq 'tex') {$form{'grade_target'} = 'tex';}
	$feedurl=&Apache::lonnet::clutter($feedurl);
	my $userview=&Apache::lonnet::ssi_body($feedurl,%form);
$userview=~s/\<body[^\>]*\>//gi;	$userview=~s/\<body[^\>]*\>//gi;
$userview=~s/\<\/body\>//gi;	$userview=~s/\<\/body\>//gi;
$userview=~s/\<html\>//gi;	$userview=~s/\<html\>//gi;
Line 1878 show a snapshot of how student was answe	Line 2134 show a snapshot of how student was answe
sub get_student_answers {	sub get_student_answers {
my ($symb,$username,$domain,$courseid,%form) = @_;	my ($symb,$username,$domain,$courseid,%form) = @_;
my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);	my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
my (%old,%moreenv);	my (%moreenv);
my @elements=('symb','courseid','domain','username');	my @elements=('symb','courseid','domain','username');
foreach my $element (@elements) {	foreach my $element (@elements) {
$old{$element}=$ENV{'form.grade_'.$element};	$moreenv{'grade_'.$element}=eval '$'.$element #'
$moreenv{'form.grade_'.$element}=eval '$'.$element #'
}
$moreenv{'form.grade_target'}='answer';
&Apache::lonnet::appenv(%moreenv);
my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%form);
&Apache::lonnet::delenv('form.grade_');
foreach my $element (@elements) {
$ENV{'form.grade_'.$element}=$old{$element};
}	}
	$moreenv{'grade_target'}='answer';
	%moreenv=(%form,%moreenv);
	my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%moreenv);
return $userview;	return $userview;
}	}

Line 1947 sub maketime {	Line 2198 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 2033 sub domainlogo {	Line 2269 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 2121 other decorations will be returned.	Line 2357 other decorations will be returned.
sub bodytag {	sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;	my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;
$title=&mt($title);	$title=&mt($title);
unless ($function) {	$function = &get_users_function() if (!$function);
$function='student';
if ($ENV{'request.role'}=~/^(cc\|in\|ta\|ep)/) {
$function='coordinator';
}
if ($ENV{'request.role'}=~/^(su\|dc\|ad\|li)/) {
$function='admin';
}
if (($ENV{'request.role'}=~/^(au\|ca)/) \|\|
($ENV{'REQUEST_URI'}=~/^(\/priv\|\~)/)) {
$function='author';
}
}
my $img=&designparm($function.'.img',$domain);	my $img=&designparm($function.'.img',$domain);
my $pgbg=&designparm($function.'.pgbg',$domain);	my $pgbg=&designparm($function.'.pgbg',$domain);
my $tabbg=&designparm($function.'.tabbg',$domain);	my $tabbg=&designparm($function.'.tabbg',$domain);
Line 2144 sub bodytag {	Line 2368 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 2163 sub bodytag {	Line 2388 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 2179 END	Line 2408 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 2195 $upperleft</td>	Line 2424 $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 2206 $upperleft</td>	Line 2435 $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
}	}

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

	=pod

	=item get_users_function

	Used by &bodytag to determine the current users primary role.
	Returns either 'student','coordinator','admin', or 'author'.

	=cut

	###############################################
	sub get_users_function {
	my $function = 'student';
	if ($ENV{'request.role'}=~/^(cc\|in\|ta\|ep)/) {
	$function='coordinator';
	}
	if ($ENV{'request.role'}=~/^(su\|dc\|ad\|li)/) {
	$function='admin';
	}
	if (($ENV{'request.role'}=~/^(au\|ca)/) \|\|
	($ENV{'REQUEST_URI'}=~/^(\/priv\|\~)/)) {
	$function='author';
	}
	return $function;
	}

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

sub get_posted_cgi {	sub get_posted_cgi {
my $r=shift;	my $r=shift;

Line 2350 sub no_cache {	Line 2606 sub no_cache {
}	}

sub content_type {	sub content_type {
my ($r,$type,$charset) = @_;	my ($r,$type,$charset) = @_;
unless ($charset) {	unless ($charset) {
$charset=&Apache::lonlocal::current_encoding;	$charset=&Apache::lonlocal::current_encoding;
}	}
$r->content_type($type.($charset?'; charset='.$charset:''));	if ($charset) { $type.='; charset='.$charset; }
	if ($r) {
	$r->content_type($type);
	} else {
	print("Content-type: $type\n\n");
	}
}	}

=pod	=pod
Line 2386 sub add_to_env {	Line 2647 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 2410 sub upfile_store {	Line 2697 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 2431 sub load_tmp_file {	Line 2721 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 2480 sub record_sep {	Line 2771 sub record_sep {
}	}
} elsif ($ENV{'form.upfiletype'} eq 'tab') {	} elsif ($ENV{'form.upfiletype'} eq 'tab') {
my $i=0;	my $i=0;
foreach (split(/\t+/,$record)) {	foreach (split(/\t/,$record)) {
my $field=$_;	my $field=$_;
$field=~s/^(\"\|\')//;	$field=~s/^(\"\|\')//;
$field=~s/(\"\|\')$//;	$field=~s/(\"\|\')$//;
Line 2509 sub record_sep {	Line 2800 sub record_sep {
return %components;	return %components;
}	}

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

=pod	=pod

=item * upfile_select_html()	=item * upfile_select_html()

return HTML code to select file and specify its type	Return HTML code to select a file from the users machine and specify
	the file type.

=cut	=cut

	######################################################
	######################################################
sub upfile_select_html {	sub upfile_select_html {
return (<<'ENDUPFORM');	my %Types = (
<input type="file" name="upfile" size="50" />	csv => &mt('CSV (comma separated values, spreadsheet)'),
<br />Type: <select name="upfiletype">	space => &mt('Space separated'),
<option value="csv">CSV (comma separated values, spreadsheet)</option>	tab => &mt('Tabulator separated'),
<option value="space">Space separated</option>	# xml => &mt('HTML/XML'),
<option value="tab">Tabulator separated</option>	);
<option value="xml">HTML/XML</option>	my $Str = '<input type="file" name="upfile" size="50" />'.
</select>	'<br />Type: <select name="upfiletype">';
ENDUPFORM	foreach my $type (sort(keys(%Types))) {
	$Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
	}
	$Str .= "</select>\n";
	return $Str;
}	}

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

=pod	=pod

=item * csv_print_samples($r,$records)	=item * csv_print_samples($r,$records)
Line 2539 Apache Request ref, $records is an array	Line 2843 Apache Request ref, $records is an array

=cut	=cut

	######################################################
	######################################################
sub csv_print_samples {	sub csv_print_samples {
my ($r,$records) = @_;	my ($r,$records) = @_;
my (%sone,%stwo,%sthree);	my (%sone,%stwo,%sthree);
%sone=&record_sep($$records[0]);	%sone=&record_sep($$records[0]);
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}	if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}	if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
	#
$r->print('Samples<br /><table border="2"><tr>');	$r->print(&mt('Samples').'<br /><table border="2"><tr>');
foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column '.($_+1).'</th>'); }	foreach (sort({$a <=> $b} keys(%sone))) {
	$r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); }
$r->print('</tr>');	$r->print('</tr>');
foreach my $hash (\%sone,\%stwo,\%sthree) {	foreach my $hash (\%sone,\%stwo,\%sthree) {
$r->print('<tr>');	$r->print('<tr>');
Line 2561 sub csv_print_samples {	Line 2868 sub csv_print_samples {
$r->print('</tr></table><br />'."\n");	$r->print('</tr></table><br />'."\n");
}	}

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

=pod	=pod

=item * csv_print_select_table($r,$records,$d)	=item * csv_print_select_table($r,$records,$d)

Prints a table to create associations between values and table columns.	Prints a table to create associations between values and table columns.

$r is an Apache Request ref,	$r is an Apache Request ref,
$records is an arrayref from &Apache::loncommon::upfile_record_sep,	$records is an arrayref from &Apache::loncommon::upfile_record_sep,
$d is an array of 2 element arrays (internal name, displayed name)	$d is an array of 2 element arrays (internal name, displayed name,defaultcol)

=cut	=cut

	######################################################
	######################################################
sub csv_print_select_table {	sub csv_print_select_table {
my ($r,$records,$d) = @_;	my ($r,$records,$d) = @_;
my $i=0;my %sone;	my $i=0;my %sone;
%sone=&record_sep($$records[0]);	%sone=&record_sep($$records[0]);
$r->print('Associate columns with student attributes.'."\n".	$r->print(&mt('Associate columns with student attributes.')."\n".
'<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n");	'<table border="2"><tr>'.
	'<th>'.&mt('Attribute').'</th>'.
	'<th>'.&mt('Column').'</th></tr>'."\n");
foreach (@$d) {	foreach (@$d) {
my ($value,$display)=@{ $_ };	my ($value,$display,$defaultcol)=@{ $_ };
$r->print('<tr><td>'.$display.'</td>');	$r->print('<tr><td>'.$display.'</td>');

$r->print('<td><select name=f'.$i.	$r->print('<td><select name=f'.$i.
' onchange="javascript:flip(this.form,'.$i.');">');	' onchange="javascript:flip(this.form,'.$i.');">');
$r->print('<option value="none"></option>');	$r->print('<option value="none"></option>');
foreach (sort({$a <=> $b} keys(%sone))) {	foreach (sort({$a <=> $b} keys(%sone))) {
$r->print('<option value="'.$_.'">Column '.($_+1).'</option>');	$r->print('<option value="'.$_.'"'.
	($_ eq $defaultcol ? ' selected ' : '').
	'>Column '.($_+1).'</option>');
}	}
$r->print('</select></td></tr>'."\n");	$r->print('</select></td></tr>'."\n");
$i++;	$i++;
Line 2595 sub csv_print_select_table {	Line 2912 sub csv_print_select_table {
return $i;	return $i;
}	}

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

=pod	=pod

=item * csv_samples_select_table($r,$records,$d)	=item * csv_samples_select_table($r,$records,$d)
Line 2607 $d is an array of 2 element arrays (inte	Line 2927 $d is an array of 2 element arrays (inte

=cut	=cut

	######################################################
	######################################################
sub csv_samples_select_table {	sub csv_samples_select_table {
my ($r,$records,$d) = @_;	my ($r,$records,$d) = @_;
my %sone; my %stwo; my %sthree;	my %sone; my %stwo; my %sthree;
my $i=0;	my $i=0;
	#
$r->print('<table border=2><tr><th>Field</th><th>Samples</th></tr>');	$r->print('<table border=2><tr><th>'.
	&mt('Field').'</th><th>'.&mt('Samples').'</th></tr>');
%sone=&record_sep($$records[0]);	%sone=&record_sep($$records[0]);
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}	if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}	if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
	#
foreach (sort keys %sone) {	foreach (sort keys %sone) {
$r->print('<tr><td><select name=f'.$i.	$r->print('<tr><td><select name="f'.$i.'"'.
' onchange="javascript:flip(this.form,'.$i.');">');	' onchange="javascript:flip(this.form,'.$i.');">');
foreach (@$d) {	foreach (@$d) {
my ($value,$display)=@{ $_ };	my ($value,$display,$defaultcol)=@{ $_ };
$r->print('<option value='.$value.'>'.$display.'</option>');	$r->print('<option value="'.$value.'"'.
	($i eq $defaultcol ? ' selected ':'').'>'.
	$display.'</option>');
}	}
$r->print('</select></td><td>');	$r->print('</select></td><td>');
if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }	if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
Line 2635 sub csv_samples_select_table {	Line 2960 sub csv_samples_select_table {
return($i);	return($i);
}	}

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

=pod	=pod

=item clean_excel_name($name)	=item clean_excel_name($name)
Line 2643 Returns a replacement for $name which do	Line 2971 Returns a replacement for $name which do

=cut	=cut

	######################################################
	######################################################
sub clean_excel_name {	sub clean_excel_name {
my ($name) = @_;	my ($name) = @_;
$name =~ s/[:\*\?\/\\]//g;	$name =~ s/[:\*\?\/\\]//g;
Line 2689 sub check_if_partid_hidden {	Line 3019 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 2704 the routine &Apache::lonnet::transfer_pr	Line 3038 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 2737 If $Max is < any data point, the graph w	Line 3072 If $Max is < any data point, the graph w
=item $colors: array ref holding the colors to be used for the data sets when	=item $colors: array ref holding the colors to be used for the data sets when
they are plotted. If undefined, default values will be used.	they are plotted. If undefined, default values will be used.

	=item $labels: array ref holding the labels to use on the x-axis for the bars.

=item @Values: An array of array references. Each array reference holds data	=item @Values: An array of array references. Each array reference holds data
to be plotted in a stacked bar chart.	to be plotted in a stacked bar chart.

Line 2752 information for the plot.	Line 3089 information for the plot.
############################################################	############################################################
############################################################	############################################################
sub DrawBarGraph {	sub DrawBarGraph {
my ($Title,$xlabel,$ylabel,$Max,$colors,@Values)=@_;	my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
#	#
if (! defined($colors)) {	if (! defined($colors)) {
$colors = ['#33ff00',	$colors = ['#33ff00',
Line 2795 sub DrawBarGraph {	Line 3132 sub DrawBarGraph {
}	}
#	#
my @Labels;	my @Labels;
for (my $i=0;$i<@{$Values[0]};$i++) {	if (defined($labels)) {
push (@Labels,$i+1);	@Labels = @$labels;
	} else {
	for (my $i=0;$i<@{$Values[0]};$i++) {
	push (@Labels,$i+1);
	}
}	}
#	#
$Max = 1 if ($Max < 1);	$Max = 1 if ($Max < 1);
Line 2855 plotted in. If undefined, default value	Line 3196 plotted in. If undefined, default value
=item $Xlabels: Array ref containing the labels to be used for the X-axis.	=item $Xlabels: Array ref containing the labels to be used for the X-axis.

=item $Ydata: Array ref containing Array refs.	=item $Ydata: Array ref containing Array refs.
Each of the contained arrays will be plotted as a seperate curve.	Each of the contained arrays will be plotted as a separate curve.

=item %Values: hash indicating or overriding any default values which are	=item %Values: hash indicating or overriding any default values which are
passed to graph.png.	passed to graph.png.
Line 3022 sub DrawXYYGraph {	Line 3363 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 3042 Inputs:	Line 3387 Inputs:

=back	=back

	=back

=cut	=cut

############################################################	############################################################
Line 3054 sub chartlink {	Line 3401 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 = '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.'.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.142
changed lines
	Added in v.1.190