version 1.62, 2002/08/28 14:11:27
|
version 1.70, 2002/10/18 13:49:49
|
Line 98 my %cprtag;
|
Line 98 my %cprtag;
|
my %fe; my %fd; |
my %fe; my %fd; |
my %category_extensions; |
my %category_extensions; |
|
|
|
# ---------------------------------------------- Designs |
|
|
|
my %designhash; |
|
|
# ---------------------------------------------- Thesaurus variables |
# ---------------------------------------------- Thesaurus variables |
|
|
=pod |
=pod |
Line 166 BEGIN {
|
Line 170 BEGIN {
|
} |
} |
} |
} |
} |
} |
|
|
|
# -------------------------------------------------------------- domain designs |
|
|
|
my $filename; |
|
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; |
|
opendir(DIR,$designdir); |
|
while ($filename=readdir(DIR)) { |
|
my ($domain)=($filename=~/^(\w+)\./); |
|
{ |
|
my $fh=Apache::File->new($designdir.'/'.$filename); |
|
if ($fh) { |
|
while (<$fh>) { |
|
next if /^\#/; |
|
chomp; |
|
my ($key,$val)=(split(/\=/,$_)); |
|
if ($val) { $designhash{$domain.'.'.$key}=$val; } |
|
} |
|
} |
|
} |
|
|
|
} |
|
closedir(DIR); |
|
|
|
|
# ------------------------------------------------------------- file categories |
# ------------------------------------------------------------- file categories |
{ |
{ |
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. |
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. |
Line 946 sub plainname {
|
Line 974 sub plainname {
|
return $name; |
return $name; |
} |
} |
|
|
|
# -------------------------------------------------------------------- Nickname |
|
|
|
|
|
sub nickname { |
|
my ($uname,$udom)=@_; |
|
my %names=&Apache::lonnet::get('environment', |
|
['nickname','firstname','middlename','lastname','generation'],$udom,$uname); |
|
my $name=$names{'nickname'}; |
|
if ($name) { |
|
$name='"'.$name.'"'; |
|
} else { |
|
$name=$names{'firstname'}.' '.$names{'middlename'}.' '. |
|
$names{'lastname'}.' '.$names{'generation'}; |
|
$name=~s/\s+$//; |
|
$name=~s/\s+/ /g; |
|
} |
|
return $name; |
|
} |
|
|
|
|
# ------------------------------------------------------------------ Screenname |
# ------------------------------------------------------------------ Screenname |
|
|
sub screenname { |
sub screenname { |
Line 965 sub messagewrapper {
|
Line 1013 sub messagewrapper {
|
# ------------------------------------------------------------- Aboutme Wrapper |
# ------------------------------------------------------------- Aboutme Wrapper |
|
|
sub aboutmewrapper { |
sub aboutmewrapper { |
my ($link,$un,$do)=@_; |
my ($link,$username,$domain)=@_; |
return "<a href='/adm/$do/$un/aboutme'>$link</a>"; |
return "<a href='/adm/$domain/$username/aboutme'>$link</a>"; |
} |
} |
|
|
# ------------------------------------------------------------ Syllabus Wrapper |
# ------------------------------------------------------------ Syllabus Wrapper |
Line 1106 sub get_previous_attempt {
|
Line 1154 sub get_previous_attempt {
|
} |
} |
|
|
sub get_student_view { |
sub get_student_view { |
my ($symb,$username,$domain,$courseid) = @_; |
my ($symb,$username,$domain,$courseid,$target) = @_; |
my ($map,$id,$feedurl) = split(/___/,$symb); |
my ($map,$id,$feedurl) = split(/___/,$symb); |
my (%old,%moreenv); |
my (%old,%moreenv); |
my @elements=('symb','courseid','domain','username'); |
my @elements=('symb','courseid','domain','username'); |
Line 1114 sub get_student_view {
|
Line 1162 sub get_student_view {
|
$old{$element}=$ENV{'form.grade_'.$element}; |
$old{$element}=$ENV{'form.grade_'.$element}; |
$moreenv{'form.grade_'.$element}=eval '$'.$element #' |
$moreenv{'form.grade_'.$element}=eval '$'.$element #' |
} |
} |
|
if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';} |
&Apache::lonnet::appenv(%moreenv); |
&Apache::lonnet::appenv(%moreenv); |
my $userview=&Apache::lonnet::ssi('/res/'.$feedurl); |
my $userview=&Apache::lonnet::ssi('/res/'.$feedurl); |
&Apache::lonnet::delenv('form.grade_'); |
&Apache::lonnet::delenv('form.grade_'); |
Line 1173 sub maketime {
|
Line 1222 sub maketime {
|
} |
} |
|
|
|
|
|
######################################### |
|
# |
|
# 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 { |
my %courses=(); |
my %courses=(); |
my $now=time; |
my $now=time; |
Line 1197 sub findallcourses {
|
Line 1262 sub findallcourses {
|
|
|
=pod |
=pod |
|
|
=item &domainlogo() |
=item &determinedomain() |
|
|
Inputs: $domain (usually will be undef) |
Inputs: $domain (usually will be undef) |
|
|
Returns: A link to a domain logo, if the domain logo exists. |
Returns: Determines which domain should be used for designs |
If the domain logo does not exist, a description of the domain. |
|
|
|
=cut |
=cut |
|
|
############################################### |
############################################### |
############################################### |
sub determinedomain { |
sub domainlogo { |
my $domain=shift; |
my ($domain) = @_; |
if (! $domain) { |
if (! $domain) { |
|
# Determine domain if we have not been given one |
# Determine domain if we have not been given one |
$domain = $Apache::lonnet::perlvar{'lonDefDomain'}; |
$domain = $Apache::lonnet::perlvar{'lonDefDomain'}; |
if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; } |
if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; } |
Line 1218 sub domainlogo {
|
Line 1281 sub domainlogo {
|
$domain=$ENV{'request.role.domain'}; |
$domain=$ENV{'request.role.domain'}; |
} |
} |
} |
} |
# See if there is a logo |
return $domain; |
|
} |
|
############################################### |
|
=pod |
|
|
|
=item &domainlogo() |
|
|
|
Inputs: $domain (usually will be undef) |
|
|
|
Returns: A link to a domain logo, if the domain logo exists. |
|
If the domain logo does not exist, a description of the domain. |
|
|
|
=cut |
|
############################################### |
|
sub domainlogo { |
|
my $domain = &determinedomain(shift); |
|
# See if there is a logo |
if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') { |
if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') { |
return '<img src="/adm/lonDomLogos/'.$domain.'.gif" />'; |
return '<img src="/adm/lonDomLogos/'.$domain.'.gif" />'; |
} elsif(exists($Apache::lonnet::domaindescription{$domain})) { |
} elsif(exists($Apache::lonnet::domaindescription{$domain})) { |
Line 1227 sub domainlogo {
|
Line 1306 sub domainlogo {
|
return ''; |
return ''; |
} |
} |
} |
} |
|
############################################## |
|
|
|
=pod |
|
|
|
=item &designparm() |
|
|
|
Inputs: $which parameter; $domain (usually will be undef) |
|
|
|
Returns: value of designparamter $which |
|
|
|
=cut |
|
############################################## |
|
sub designparm { |
|
my ($which,$domain)=@_; |
|
$domain=&determinedomain($domain); |
|
if ($designhash{$domain.'.'.$which}) { |
|
return $designhash{$domain.'.'.$which}; |
|
} else { |
|
return $designhash{'default.'.$which}; |
|
} |
|
} |
|
|
############################################### |
############################################### |
############################################### |
############################################### |
Line 1253 other decorations will be returned.
|
Line 1353 other decorations will be returned.
|
=cut |
=cut |
|
|
############################################### |
############################################### |
|
|
|
|
############################################### |
############################################### |
sub bodytag { |
sub bodytag { |
my ($title,$function,$addentries,$bodyonly,$domain)=@_; |
my ($title,$function,$addentries,$bodyonly,$domain)=@_; |
Line 1269 sub bodytag {
|
Line 1371 sub bodytag {
|
$function='author'; |
$function='author'; |
} |
} |
} |
} |
my $img=''; |
my $img=&designparm($function.'.img',$domain); |
my $pgbg=''; |
my $pgbg=&designparm($function.'.pgbg',$domain); |
my $tabbg=''; |
my $tabbg=&designparm($function.'.tabbg',$domain); |
my $font=''; |
my $font=&designparm($function.'.font',$domain); |
my $link=''; |
my $link=&designparm($function.'.link',$domain); |
my $alink='#CC0000'; |
my $alink=&designparm($function.'.alink',$domain); |
my $vlink=''; |
my $vlink=&designparm($function.'.vlink',$domain); |
if ($function eq 'admin') { |
my $sidebg=&designparm($function.'.sidebg',$domain); |
$img='admin'; |
|
$pgbg='#FFFFCC'; |
# role and realm |
$tabbg='#CCCC99'; |
|
$font='#772200'; |
|
$link='#663300'; |
|
$vlink='#666600'; |
|
} elsif ($function eq 'coordinator') { |
|
$img='coordinator'; |
|
$pgbg='#CCFFFF'; |
|
$tabbg='#CCCCFF'; |
|
$font='#000044'; |
|
$link='#003333'; |
|
$vlink='#006633'; |
|
} elsif ($function eq 'author') { |
|
$img='author'; |
|
$pgbg='#CCFFFF'; |
|
$tabbg='#CCFFCC'; |
|
$font='#004400'; |
|
$link='#003333'; |
|
$vlink='#006666'; |
|
} else { |
|
$img='student'; |
|
$pgbg='#FFFFAA'; |
|
$tabbg='#FF9900'; |
|
$font='#991100'; |
|
$link='#993300'; |
|
$vlink='#996600'; |
|
} |
|
# role and realm |
|
my ($role,$realm) |
my ($role,$realm) |
=&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]); |
=&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]); |
# realm |
# realm |
Line 1328 END
|
Line 1403 END
|
$bodytag |
$bodytag |
<table width="100%" cellspacing="0" border="0" cellpadding="0"> |
<table width="100%" cellspacing="0" border="0" cellpadding="0"> |
<tr><td bgcolor="$font"> |
<tr><td bgcolor="$font"> |
<img src="/adm/lonInterFace/$img.jpg" /></td> |
<img src="$img" /></td> |
<td bgcolor="$font"><font color='$pgbg'>$messages</font></td> |
<td bgcolor="$font"><font color='$sidebg'>$messages</font></td> |
</tr> |
</tr> |
<tr> |
<tr> |
<td rowspan="3" bgcolor="$tabbg"> |
<td rowspan="3" bgcolor="$tabbg"> |
Line 1742 will result in $ENV{'form.uname'} and $E
|
Line 1817 will result in $ENV{'form.uname'} and $E
|
|
|
returns cache-controlling header code |
returns cache-controlling header code |
|
|
=item nocache() |
=item no_cache($r) |
|
|
specifies header code to not have cache |
specifies header code to not have cache |
|
|