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.171 and 1.230

version 1.171, 2004/01/13 15:48:25	version 1.230, 2004/11/12 23:29:56
Line 59 use Apache::lonnet();	Line 59 use Apache::lonnet();
use GDBM_File;	use GDBM_File;
use POSIX qw(strftime mktime);	use POSIX qw(strftime mktime);
use Apache::Constants qw(:common :http :methods);	use Apache::Constants qw(:common :http :methods);
use Apache::lonmsg();
use Apache::lonmenu();	use Apache::lonmenu();
use Apache::lonlocal;	use Apache::lonlocal;
use HTML::Entities;	use HTML::Entities;
Line 74 my $readit;	Line 73 my $readit;
my %language;	my %language;
my %supported_language;	my %supported_language;
my %cprtag;	my %cprtag;
	my %scprtag;
my %fe; my %fd;	my %fe; my %fd;
my %category_extensions;	my %category_extensions;

Line 131 BEGIN {	Line 131 BEGIN {
close($fh);	close($fh);
}	}
}	}
	# ------------------------------------------------------------------ source copyrights
	{
	my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
	'/source_copyright.tab';
	if ( open (my $fh,"<$sourcecopyrightfile") ) {
	while (<$fh>) {
	next if /^\#/;
	chomp;
	my ($key,$val)=(split(/\s+/,$_,2));
	$scprtag{$key}=$val;
	}
	close($fh);
	}
	}

# -------------------------------------------------------------- domain designs	# -------------------------------------------------------------- domain designs

Line 220 formname and elementname indicate the na	Line 234 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 235 of the element the selection from the se	Line 249 of the element the selection from the se
=cut	=cut

sub browser_and_searcher_javascript {	sub browser_and_searcher_javascript {
	my ($mode)=@_;
	if (!defined($mode)) { $mode='edit'; }
my $resurl=&lastresurl();	my $resurl=&lastresurl();
return <<END;	return <<END;
	// <!-- BEGIN LON-CAPA Internal
var editbrowser = null;	var editbrowser = null;
function openbrowser(formname,elementname,only,omit,titleelement) {	function openbrowser(formname,elementname,only,omit,titleelement) {
var url = '$resurl/?';	var url = '$resurl/?';
Line 244 sub browser_and_searcher_javascript {	Line 261 sub browser_and_searcher_javascript {
url += 'launch=1&';	url += 'launch=1&';
}	}
url += 'catalogmode=interactive&';	url += 'catalogmode=interactive&';
url += 'mode=edit&';	url += 'mode=$mode&';
url += 'form=' + formname + '&';	url += 'form=' + formname + '&';
if (only != null) {	if (only != null) {
url += 'only=' + only + '&';	url += 'only=' + only + '&';
}	} else {
	url += 'only=&';
	}
if (omit != null) {	if (omit != null) {
url += 'omit=' + omit + '&';	url += 'omit=' + omit + '&';
}	} else {
	url += 'omit=&';
	}
if (titleelement != null) {	if (titleelement != null) {
url += 'titleelement=' + titleelement + '&';	url += 'titleelement=' + titleelement + '&';
}	} else {
	url += 'titleelement=&';
	}
url += 'element=' + elementname + '';	url += 'element=' + elementname + '';
var title = 'Browser';	var title = 'Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=1,location=1';
options += ',width=700,height=600';	options += ',width=700,height=600';
editbrowser = open(url,title,options,'1');	editbrowser = open(url,title,options,'1');
editbrowser.focus();	editbrowser.focus();
Line 269 sub browser_and_searcher_javascript {	Line 292 sub browser_and_searcher_javascript {
url += 'launch=1&';	url += 'launch=1&';
}	}
url += 'catalogmode=interactive&';	url += 'catalogmode=interactive&';
url += 'mode=edit&';	url += 'mode=$mode&';
url += 'form=' + formname + '&';	url += 'form=' + formname + '&';
if (titleelement != null) {	if (titleelement != null) {
url += 'titleelement=' + titleelement + '&';	url += 'titleelement=' + titleelement + '&';
}	} else {
	url += 'titleelement=&';
	}
url += 'element=' + elementname + '';	url += 'element=' + elementname + '';
var title = 'Search';	var title = 'Search';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=0';
Line 281 sub browser_and_searcher_javascript {	Line 306 sub browser_and_searcher_javascript {
editsearcher = open(url,title,options,'1');	editsearcher = open(url,title,options,'1');
editsearcher.focus();	editsearcher.focus();
}	}
	// END LON-CAPA Internal -->
END	END
}	}

Line 349 sub selectstudent_link {	Line 375 sub selectstudent_link {
}	}

sub coursebrowser_javascript {	sub coursebrowser_javascript {
my ($domainfilter)=@_;	my ($domainfilter,$roleelement)=@_;
return (<<ENDSTDBRW);	return (<<ENDSTDBRW);
<script type="text/javascript" language="Javascript" >	<script type="text/javascript" language="Javascript" >
	var extra_element = "$roleelement"
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 368 sub coursebrowser_javascript {	Line 395 sub coursebrowser_javascript {
}	}
}	}
url += 'form=' + formname + '&cnumelement='+uname+	url += 'form=' + formname + '&cnumelement='+uname+
'&cdomelement='+udom;	'&cdomelement='+udom+
	'&cnameelement='+desc;
	if (extra_element != '') {
	url += '&roleelement=$roleelement';
	}
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 380 ENDSTDBRW	Line 411 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 465 sub linked_select_forms {	Line 496 sub linked_select_forms {
my $first = "document.$formname.$firstselectname";	my $first = "document.$formname.$firstselectname";
# output the javascript to do the changing	# output the javascript to do the changing
my $result = '';	my $result = '';
$result.="<script>\n";	$result.="<script type=\"text/javascript\">\n";
$result.="var select2data = new Object();\n";	$result.="var select2data = new Object();\n";
$" = '","';	$" = '","';
my $debug = '';	my $debug = '';
Line 592 sub help_open_topic {	Line 623 sub help_open_topic {
}	}

# Add the graphic	# Add the graphic
	my $title = &mt('Online Help');
	my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");
$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"><img src="$helpicon" 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 620 sub helpLatexCheatsheet {	Line 653 sub helpLatexCheatsheet {
.'</td></tr></table>';	.'</td></tr></table>';
}	}

	sub help_open_menu {
	my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_;
	$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 = 620 if (not defined $width);
	$height = 600 if (not defined $height);
	my $link='';
	my $title = &mt('Get help');
	my $origurl = $ENV{'REQUEST_URI'};
	$origurl=~s\|^/~\|/priv/\|;
	my $timestamp = time;
	foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {
	$$_ = &Apache::lonnet::escape($$_);
	}

	if (!$stayOnPage) {
	$link = "javascript:helpMenu('open')";
	} else {
	$link = "javascript:helpMenu('display')";
	}
	my $banner_link = "/adm/helpmenu?page=banner&color=$color&function=$function&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
	my $details_link = "/adm/helpmenu?page=body&color=$color&function=$function&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp";
	my $template;
	if ($text ne "") {
	$template .=
	"<table bgcolor='#773311' cellspacing='1' cellpadding='1' border='0'><tr>".
	"<td bgcolor='#886622'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
	}
	my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
	$template .= <<"ENDTEMPLATE";
	<script type="text/javascript">
	//<!-- BEGIN LON-CAPA Internal
	function helpMenu(caller) {
	if (caller == 'open') {
	newWindow = window.open("","helpmenu","HEIGHT=$height,WIDTH=$width,resize=yes,scrollbars=yes" )
	caller = newWindow.document
	} else {
	caller = this.document
	}
	caller.write("<html><head><title>LON-CAPA Help Menu</title><meta http-equiv='pragma' content='no-cache'></head>")
	caller.write("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
	caller.write("</html>")
	caller.close()
	if (caller == newWindow.document) {
	caller.focus()
	}
	}
	// END LON-CAPA Internal -->
	</script>
	<a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help Menu)" /></a>
	ENDTEMPLATE
	if ($component_help) {
	if (!$text) {
	$template=&help_open_topic($component_help,undef,$stayOnPage,
	$width,$height).' '.$template;
	} else {
	my $help_text;
	$help_text=&Apache::lonnet::unescape($topic);
	$template='<table><tr><td>'.
	&help_open_topic($component_help,$help_text,$stayOnPage,
	$width,$height).'</td><td>'.$template.
	'</td></tr></table>';
	}
	}
	if ($text ne '') { $template.='</td></tr></table>' };
	return $template;
	}

	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');
	my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
	$template .= <<"ENDTEMPLATE";
	<a href="$link" title="$title"><img src="$bugicon" 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');
	my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
	$template .= <<"ENDTEMPLATE";
	<a href="$link" title="$title"><img src="$faqicon" 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;
$text =~ s/\n//g;	$text =~ s/\n/ /g;
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=>
	'mm/dd/yyyy hh:mm:ss');
	return $format;
	}

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

=pod	=pod

=item * change_content_javascript():	=item * change_content_javascript():
Line 758 sub domain_select {	Line 1012 sub domain_select {
} &get_domains;	} &get_domains;
if ($multiple) {	if ($multiple) {
$domains{''}=&mt('Any domain');	$domains{''}=&mt('Any domain');
return &multiple_select_form($name,$value,%domains);	return &multiple_select_form($name,$value,4,%domains);
} else {	} else {
return &select_form($name,$value,%domains);	return &select_form($name,$value,%domains);
}	}
}	}

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

my $radioval = "'nochange'";	my $radioval = "'nochange'";
	if (exists($in{'curr_authtype'}) &&
	defined($in{'curr_authtype'}) &&
	$in{'curr_authtype'} ne '') {
	$radioval = "'$in{'curr_authtype'}arg'";
	}
my $argfield = 'null';	my $argfield = 'null';
if ( grep/^mode$/,(keys %in) ) {	if ( grep/^mode$/,(keys %in) ) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
Line 1480 sub get_related_words {	Line 1745 sub get_related_words {

=over 4	=over 4

=item * plainname($uname,$udom)	=item * plainname($uname,$udom,$first)

Takes a users logon name and returns it as a string in	Takes a users logon name and returns it as a string in
"first middle last generation" form	"first middle last generation" form
	if $first is set to 'lastname' then it returns it as
	'lastname generation, firstname middlename' if their is a lastname

=cut	=cut

###############################################################	###############################################################
sub plainname {	sub plainname {
my ($uname,$udom)=@_;	my ($uname,$udom,$first)=@_;
my %names=&Apache::lonnet::get('environment',	my %names=&Apache::lonnet::get('environment',
['firstname','middlename','lastname','generation'],	['firstname','middlename','lastname','generation'],
$udom,$uname);	$udom,$uname);
my $name=$names{'firstname'}.' '.$names{'middlename'}.' '.	my $name=&Apache::lonnet::format_name($names{'firstname'},
$names{'lastname'}.' '.$names{'generation'};	$names{'middlename'},
	$names{'lastname'},
	$names{'generation'},$first);
	$name=~s/^\s+//;
$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 1519 if the user does not	Line 1790 if the user does not

sub nickname {	sub nickname {
my ($uname,$udom)=@_;	my ($uname,$udom)=@_;
my %names=&Apache::lonnet::get('environment',	my %names;
['nickname','firstname','middlename','lastname','generation'],$udom,$uname);	if ($uname eq $ENV{'user.name'} &&
	$udom eq $ENV{'user.domain'}) {
	%names=('nickname' => $ENV{'environment.nickname'} ,
	'firstname' => $ENV{'environment.firstname'} ,
	'middlename' => $ENV{'environment.middlename'},
	'lastname' => $ENV{'environment.lastname'} ,
	'generation' => $ENV{'environment.generation'});
	} else {
	%names=&Apache::lonnet::get('environment',
	['nickname','firstname','middlename',
	'lastname','generation'],$udom,$uname);
	}
my $name=$names{'nickname'};	my $name=$names{'nickname'};
if ($name) {	if ($name) {
$name='"'.$name.'"';	$name='"'.$name.'"';
Line 1546 Gets a users screenname and returns it a	Line 1828 Gets a users screenname and returns it a

sub screenname {	sub screenname {
my ($uname,$udom)=@_;	my ($uname,$udom)=@_;
my %names=	if ($uname eq $ENV{'user.name'} &&
&Apache::lonnet::get('environment',['screenname'],$udom,$uname);	$udom eq $ENV{'user.domain'}) {return $ENV{'environment.screenname'};}
	my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
return $names{'screenname'};	return $names{'screenname'};
}	}


# ------------------------------------------------------------- Message Wrapper	# ------------------------------------------------------------- Message Wrapper

sub messagewrapper {	sub messagewrapper {
my ($link,$un,$do)=@_;	my ($link,$username,$domain)=@_;
return	return
"<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>";	'<a href="/adm/email?compose=individual&'.
	'recname='.$username.'&recdom='.$domain.'" '.
	'title="'.&mt('Send message').'">'.$link.'</a>';
}	}
# --------------------------------------------------------------- Notes Wrapper	# --------------------------------------------------------------- Notes Wrapper

Line 1569 sub noteswrapper {	Line 1855 sub noteswrapper {

sub aboutmewrapper {	sub aboutmewrapper {
my ($link,$username,$domain,$target)=@_;	my ($link,$username,$domain,$target)=@_;
return "<a href='/adm/$domain/$username/aboutme'".	return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
($target?" target='$target'":'').">$link</a>";	($target?' target="$target"':'').' title="'.&mt('View this users personal page').'">'.$link.'</a>';
}	}

# ------------------------------------------------------------ Syllabus Wrapper	# ------------------------------------------------------------ Syllabus Wrapper
Line 1581 sub syllabuswrapper {	Line 1867 sub syllabuswrapper {
if ($fontcolor) {	if ($fontcolor) {
$linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';	$linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';
}	}
return "<a href='/public/$domain/$coursedir/syllabus'>$linktext</a>";	return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
	}

	sub track_student_link {
	my ($linktext,$sname,$sdom,$target) = @_;
	my $link ="/adm/trackstudent";
	my $title = 'View recent activity';
	if (defined($sname) && $sname !~ /^\s*$/ &&
	defined($sdom) && $sdom !~ /^\s*$/) {
	$link .= "?selected_student=$sname:$sdom";
	$title .= ' of this student';
	}
	if (defined($target) && $target !~ /^\s*$/) {
	$target = qq{target="$target"};
	} else {
	$target = '';
	}
	return qq{<a href="$link" title="$title" $target>$linktext</a>};
}	}



=pod	=pod

=back	=back
Line 1653 sub copyrightdescription {	Line 1958 sub copyrightdescription {

=pod	=pod

	=item * source_copyrightids()

	returns list of all source copyrights

	=cut

	sub source_copyrightids {
	return sort(keys(%scprtag));
	}

	=pod

	=item * source_copyrightdescription()

	returns description of a specified source copyright id

	=cut

	sub source_copyrightdescription {
	return &mt($scprtag{shift(@_)});
	}

	=pod

=item * filecategories()	=item * filecategories()

returns list of all file categories	returns list of all file categories
Line 1691 sub fileembstyle {	Line 2020 sub fileembstyle {

sub filecategoryselect {	sub filecategoryselect {
my ($name,$value)=@_;	my ($name,$value)=@_;
return &select_form($name,$value,	return &select_form($value,$name,
'' => &mt('Any category'),	'' => &mt('Any category'),
map { $_,$_ } sort(keys(%category_extensions)));	map { $_,$_ } sort(keys(%category_extensions)));
}	}
Line 1705 returns description for a specified file	Line 2034 returns description for a specified file
=cut	=cut

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

=pod	=pod
Line 1719 extra formatting	Line 2050 extra formatting

sub filedescriptionex {	sub filedescriptionex {
my $ex=shift;	my $ex=shift;
return '.'.$ex.' '.&mt($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 1754 sub display_languages {	Line 2087 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 1940 show a snapshot of what student was look	Line 2273 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 1978 show a snapshot of how student was answe	Line 2308 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 2044 sub maketime {	Line 2369 sub maketime {
my %th=@_;	my %th=@_;
return POSIX::mktime(	return POSIX::mktime(
($th{'seconds'},$th{'minutes'},$th{'hours'},	($th{'seconds'},$th{'minutes'},$th{'hours'},
$th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));	$th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
}	}

#########################################	#########################################
Line 2115 sub domainlogo {	Line 2440 sub domainlogo {
my $domain = &determinedomain(shift);	my $domain = &determinedomain(shift);
# See if there is a logo	# See if there is a logo
if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {	if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};	my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif");
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }	return '<img src="'.$logo.'" alt="'.$domain.'" />';
return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.
'/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 2204 other decorations will be returned.	Line 2527 other decorations will be returned.
=cut	=cut

sub bodytag {	sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;	my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle)=@_;
$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 2262 END	Line 2573 END
return $bodytag;	return $bodytag;
} elsif ($ENV{'browser.interface'} eq 'textual') {	} elsif ($ENV{'browser.interface'} eq 'textual') {
# Accessibility	# Accessibility

return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',	return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
$forcereg).	$forcereg).
'<h1>LON-CAPA: '.$title.'</h1>';	'<h1>LON-CAPA: '.$title.'</h1>';
} elsif ($ENV{'environment.remote'} eq 'off') {	} elsif ($ENV{'environment.remote'} eq 'off') {
# No Remote	# No Remote
	my $roleinfo=(<<ENDROLE);
	<td bgcolor="$tabbg" align="right">
	<p>
	<font size="2" face="Arial, Helvetica, sans-serif">
	$ENV{'environment.firstname'}
	$ENV{'environment.middlename'}
	$ENV{'environment.lastname'}
	$ENV{'environment.generation'}
	</font>
	<br />
	<font size="2" face="Arial, Helvetica, sans-serif">$role</font>
	<br />
	<font size="2" face="Arial, Helvetica, sans-serif">$realm</font>
	</p>
	</td>
	ENDROLE
	my $titleinfo = '<font face="Arial, Helvetica, sans-serif" size="+3" color="'.
	$font.'"><b>'.$title.'</b></font>';
	if ($customtitle) {
	$titleinfo = $customtitle;
	}
	if ($ENV{'request.state'} eq 'construct') {
	my ($uname,$thisdisfn)=
	($ENV{'request.filename'} =~ m\|^/home/([^/]+)/public_html/(.*)\|);
	my $formaction='/priv/'.$uname.'/'.$thisdisfn;
	$formaction=~s/\/+/\//g;
	$titleinfo = '<form name="dirs" method="post" action="'.$formaction
	.'" target="_top">'
	.&Apache::lonhtmlcommon::crumbs($uname.'/'.$thisdisfn,'_top','/priv','','-1')
	.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
	.'</form>'
	.&Apache::lonmenu::constspaceform();

	&Apache::lonhtmlcommon::store_recent('construct',$formaction,$formaction);
	if ($thisdisfn!~m\|/$\|) { $forcereg=1; }
	}

	&Apache::lonnet::logthis("hrrm");
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 face="Arial, Helvetica, sans-serif" size="+3" color="'.$font.'"><b>'.$title.	'<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td rowspan="3" bgcolor="'.$tabbg.'">'.$titleinfo.'</td>'.$roleinfo.'</tr></table>';
'</b></font></td></tr></table>';
}	}

#	#
# Top frame rendering, Remote is up	# Top frame rendering, Remote is up
#	#
	my $titleinfo = ' <font size="5" face="Arial, Helvetica, sans-serif"><b>'.$title.'</b></font>';
	if ($customtitle) {
	$titleinfo = $customtitle;
	}
return(<<ENDBODY);	return(<<ENDBODY);
$bodytag	$bodytag
<table width="100%" cellspacing="0" border="0" cellpadding="0">	<table width="100%" cellspacing="0" border="0" cellpadding="0">
Line 2285 $upperleft</td>	Line 2638 $upperleft</td>
</tr>	</tr>
<tr>	<tr>
<td rowspan="3" bgcolor="$tabbg">	<td rowspan="3" bgcolor="$tabbg">
<font size="5" face="Arial, Helvetica, sans-serif"><b>$title</b></font>	$titleinfo
<td bgcolor="$tabbg" align="right">	<td bgcolor="$tabbg" align="right">
<font size="2" face="Arial, Helvetica, sans-serif">	<font size="2" face="Arial, Helvetica, sans-serif">
$ENV{'environment.firstname'}	$ENV{'environment.firstname'}
Line 2300 $upperleft</td>	Line 2653 $upperleft</td>
</td></tr>	</td></tr>
<tr>	<tr>
<td bgcolor="$tabbg" align="right"><font size="2" face="Arial, Helvetica, sans-serif">$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 2414 returns cache-controlling header code	Line 2794 returns cache-controlling header code
=cut	=cut

sub cacheheader {	sub cacheheader {
unless ($ENV{'request.method'} eq 'GET') { return ''; }	unless ($ENV{'request.method'} eq 'GET') { return ''; }
my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);	my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />	my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
<meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />	<meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
<meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';	<meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
return $output;	return $output;
}	}

=pod	=pod
Line 2431 specifies header code to not have cache	Line 2811 specifies header code to not have cache
=cut	=cut

sub no_cache {	sub no_cache {
my ($r) = @_;	my ($r) = @_;
unless ($ENV{'request.method'} eq 'GET') { return ''; }	if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
#my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);	$ENV{'request.method'} ne 'GET') { return ''; }
$r->no_cache(1);	my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
$r->header_out("Pragma" => "no-cache");	$r->no_cache(1);
#$r->header_out("Expires" => $date);	$r->header_out("Expires" => $date);
	$r->header_out("Pragma" => "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 2708 Prints a table to create associations be	Line 3094 Prints a table to create associations be

$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

Line 2723 sub csv_print_select_table {	Line 3109 sub csv_print_select_table {
'<th>'.&mt('Attribute').'</th>'.	'<th>'.&mt('Attribute').'</th>'.
'<th>'.&mt('Column').'</th></tr>'."\n");	'<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 2771 sub csv_samples_select_table {	Line 3159 sub csv_samples_select_table {
$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 2897 If $Max is < any data point, the graph w	Line 3287 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 2912 information for the plot.	Line 3304 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 2920 sub DrawBarGraph {	Line 3312 sub DrawBarGraph {
'#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',	'#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
];	];
}	}
	my $extra_settings = {};
	if (ref($Values[-1]) eq 'HASH') {
	$extra_settings = pop(@Values);
	}
#	#
my $identifier = &get_cgi_id();	my $identifier = &get_cgi_id();
my $id = 'cgi.'.$identifier;	my $id = 'cgi.'.$identifier;
if (! @Values \|\| ref($Values[0]) ne 'ARRAY') {	if (! @Values \|\| ref($Values[0]) ne 'ARRAY') {
return '';	return '';
}	}
	#
	my @Labels;
	if (defined($labels)) {
	@Labels = @$labels;
	} else {
	for (my $i=0;$i<@{$Values[0]};$i++) {
	push (@Labels,$i+1);
	}
	}
	#
my $NumBars = scalar(@{$Values[0]});	my $NumBars = scalar(@{$Values[0]});
	if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
my %ValuesHash;	my %ValuesHash;
my $NumSets=1;	my $NumSets=1;
foreach my $array (@Values) {	foreach my $array (@Values) {
Line 2936 sub DrawBarGraph {	Line 3343 sub DrawBarGraph {
}	}
#	#
my ($height,$width,$xskip,$bar_width) = (200,120,1,15);	my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
if ($NumBars < 10) {	if ($NumBars < 3) {
	$width = 120+$NumBars*32;
	$xskip = 1;
	$bar_width = 30;
	} elsif ($NumBars < 5) {
	$width = 120+$NumBars*20;
	$xskip = 1;
	$bar_width = 20;
	} elsif ($NumBars < 10) {
$width = 120+$NumBars*15;	$width = 120+$NumBars*15;
$xskip = 1;	$xskip = 1;
$bar_width = 15;	$bar_width = 15;
Line 2954 sub DrawBarGraph {	Line 3369 sub DrawBarGraph {
$bar_width = 4;	$bar_width = 4;
}	}
#	#
my @Labels;
for (my $i=0;$i<@{$Values[0]};$i++) {
push (@Labels,$i+1);
}
#
$Max = 1 if ($Max < 1);	$Max = 1 if ($Max < 1);
if ( int($Max) < $Max ) {	if ( int($Max) < $Max ) {
$Max++;	$Max++;
Line 2981 sub DrawBarGraph {	Line 3391 sub DrawBarGraph {
$ValuesHash{$id.'.bar_width'} = $bar_width;	$ValuesHash{$id.'.bar_width'} = $bar_width;
$ValuesHash{$id.'.labels'} = join(',',@Labels);	$ValuesHash{$id.'.labels'} = join(',',@Labels);
#	#
	# Deal with other parameters
	while (my ($key,$value) = each(%$extra_settings)) {
	$ValuesHash{$id.'.'.$key} = $value;
	}
	#
&Apache::lonnet::appenv(%ValuesHash);	&Apache::lonnet::appenv(%ValuesHash);
return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';	return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
}	}
Line 3015 plotted in. If undefined, default value	Line 3430 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 3215 Inputs:	Line 3630 Inputs:
sub chartlink {	sub chartlink {
my ($linktext, $sname, $sdomain) = @_;	my ($linktext, $sname, $sdomain) = @_;
my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.	my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
'&SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).	'&SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).
'&chartoutputmode='.HTML::Entities::encode('html, with all links').	'&chartoutputmode='.HTML::Entities::encode('html, with all links').
'">'.$linktext.'</a>';	'">'.$linktext.'</a>';
}	}

Line 3263 sub store_course_settings {	Line 3678 sub store_course_settings {
my %SaveHash;	my %SaveHash;
my %AppHash;	my %AppHash;
while (my ($setting,$type) = each(%$Settings)) {	while (my ($setting,$type) = each(%$Settings)) {
my $basename = 'env.internal.'.$prefix.'.'.$setting;	my $basename = 'internal.'.$prefix.'.'.$setting;
my $envname = 'course.'.$courseid.'.'.$basename;	my $envname = 'course.'.$courseid.'.'.$basename;
if (exists($ENV{'form.'.$setting})) {	if (exists($ENV{'form.'.$setting})) {
# Save this value away	# Save this value away
Line 3308 sub restore_course_settings {	Line 3723 sub restore_course_settings {
my ($prefix,$Settings) = @_;	my ($prefix,$Settings) = @_;
while (my ($setting,$type) = each(%$Settings)) {	while (my ($setting,$type) = each(%$Settings)) {
next if (exists($ENV{'form.'.$setting}));	next if (exists($ENV{'form.'.$setting}));
my $envname = 'course.'.$courseid.'.env.internal.'.$prefix.	my $envname = 'course.'.$courseid.'.internal.'.$prefix.
'.'.$setting;	'.'.$setting;
if (exists($ENV{$envname})) {	if (exists($ENV{$envname})) {
if ($type eq 'scalar') {	if ($type eq 'scalar') {
Line 3353 sub icon {	Line 3768 sub icon {
return $iconname;	return $iconname;
}	}

	sub lonhttpdurl {
	my ($url)=@_;
	my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
	if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
	return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
	}

	sub connection_aborted {
	my ($r)=@_;
	$r->print(" ");$r->rflush();
	my $c = $r->connection;
	return $c->aborted();
	}

	# Escapes strings that may have embedded 's that will be put into
	# strings as 'strings'.
	sub escape_single {
	my ($input) = @_;
	$input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
	$input =~ s/\'/\\\'/g; # Esacpe the 's....
	return $input;
	}

	# Same as escape_single, but escape's "'s This
	# can be used for "strings"
	sub escape_double {
	my ($input) = @_;
	$input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
	$input =~ s/\"/\\\"/g; # Esacpe the "s....
	return $input;
	}

	# Escapes the last element of a full URL.
	sub escape_url {
	my ($url) = @_;
	my @urlslices = split(/\//, $url);
	my $lastitem = &Apache::lonnet::escape(pop(@urlslices));
	return join('/',@urlslices).'/'.$lastitem;
	}
=pod	=pod

=back	=back

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

Removed from v.1.171
changed lines
	Added in v.1.230