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.150 and 1.158

version 1.150, 2003/11/10 20:19:37	version 1.158, 2003/12/08 15:06:42
Line 25	Line 25
#	#
# http://www.lon-capa.org/	# http://www.lon-capa.org/
#	#
# YEAR=2001
# 2/13-12/7 Guy Albertelli
# 12/21 Gerd Kortemeyer
# 12/25,12/28 Gerd Kortemeyer
# YEAR=2002
# 1/4 Gerd Kortemeyer
# 6/24,7/2 H. K. Ng

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

my $readit;	my $readit;

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

=cut

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

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

}	}
Line 164 BEGIN {	Line 158 BEGIN {

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

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

=pod	=pod

=head1 General Subroutines

=over 4

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

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

=over 4

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

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

=back

=cut	=cut

sub browser_and_searcher_javascript {	sub browser_and_searcher_javascript {
Line 887 Outputs:	Line 876 Outputs:

=back	=back

	=back

=cut	=cut

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

=pod

=back

=cut

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

=back	=back

	=back

=cut	=cut

#-------------------------------------------	#-------------------------------------------
Line 1155 sub authform_filesystem{	Line 1142 sub authform_filesystem{
return $result;	return $result;
}	}

=pod

=back

=cut

###############################################################	###############################################################
## Get Authentication Defaults for Domain ##	## Get Authentication Defaults for Domain ##
###############################################################	###############################################################
Line 2140 sub bodytag {	Line 2121 sub bodytag {
my $bodytag = <<END;	my $bodytag = <<END;
<style>	<style>
h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }	h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
a:hover { color: black; background: yellow }
a:focus { color: red; background: yellow }	a:focus { color: red; background: yellow }
</style>	</style>
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"	<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
style="border-color: $tabbg; border-width: 4px; border-style: solid; padding: 4px;$addstyle" $addentries>	style="margin-top: 0px;$addstyle" $addentries>
END	END
my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.	my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
$lonhttpdPort.$img.'" alt="'.$function.'" />';	$lonhttpdPort.$img.'" alt="'.$function.'" />';
Line 2159 END	Line 2139 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 2416 sub upfile_store {	Line 2396 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 2437 sub load_tmp_file {	Line 2420 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 2730 sub check_if_partid_hidden {	Line 2714 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 2745 the routine &Apache::lonnet::transfer_pr	Line 2733 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 3063 sub DrawXYYGraph {	Line 3052 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 3083 Inputs:	Line 3076 Inputs:

=back	=back

	=back

=cut	=cut

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

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

	=pod

	=head1 Course Environment Routines

	=over 4

	=item &restore_course_settings

	=item &store_course_settings

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

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

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

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

	Returns: both routines return nothing

	=cut

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

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

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

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

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

=pod	=pod

=back	=back

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

Removed from v.1.150
changed lines
	Added in v.1.158