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.157 and 1.170

version 1.157, 2003/12/01 14:36:22	version 1.170, 2004/01/02 21:00:56
Line 102 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 138 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 155 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 229 of the element the selection from the se	Line 235 of the element the selection from the se
=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 277 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 548 sub help_open_topic {	Line 572 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 718 sub get_domains {	Line 744 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 754 sub select_form {	Line 809 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 979 END	Line 1070 END
$Javascript_toUpperCase = "";	$Javascript_toUpperCase = "";
}	}

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

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

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

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

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

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

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

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

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

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

Line 1290 sub keyword {	Line 1432 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 1426 sub noteswrapper {	Line 1568 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 1505 returns description of a specified copyr	Line 1648 returns description of a specified copyr
=cut	=cut

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

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


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

=pod	=pod

=item * filedescription()	=item * filedescription()
Line 1554 returns description for a specified file	Line 1705 returns description for a specified file
=cut	=cut

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

=pod	=pod
Line 1568 extra formatting	Line 1719 extra formatting

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

# End of .tab access	# End of .tab access
Line 1896 sub maketime {	Line 2047 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 2390 sub upfile_store {	Line 2526 sub upfile_store {
my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.	my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
'_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;	'_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
{	{
my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').	my $datafile = $r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp');	'/tmp/'.$datatoken.'.tmp';
print $fh $ENV{'form.upfile'};	if ( open(my $fh,">$datafile") ) {
	print $fh $ENV{'form.upfile'};
	close($fh);
	}
}	}
return $datatoken;	return $datatoken;
}	}
Line 2411 sub load_tmp_file {	Line 2550 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 3199 sub propath {	Line 3339 sub propath {

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

=pod	=pod

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

Removed from v.1.157
changed lines
	Added in v.1.170