--- loncom/interface/loncommon.pm 2006/04/20 02:01:30 1.343
+++ loncom/interface/loncommon.pm 2006/05/09 14:38:09 1.365
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.343 2006/04/20 02:01:30 albertel Exp $
+# $Id: loncommon.pm,v 1.365 2006/05/09 14:38:09 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -63,6 +63,7 @@ use Apache::lonlocal;
use HTML::Entities;
use Apache::lonhtmlcommon();
use Apache::loncoursedata();
+use Apache::lontexconvert();
my $readit;
@@ -75,7 +76,7 @@ my %language;
my %supported_language;
my %cprtag;
my %scprtag;
-my %fe; my %fd;
+my %fe; my %fd; my %fm;
my %category_extensions;
# ---------------------------------------------- Designs
@@ -106,10 +107,10 @@ BEGIN {
my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/language.tab';
if ( open(my $fh,"<$langtabfile") ) {
- while (<$fh>) {
- next if /^\#/;
- chomp;
- my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_));
+ while (my $line = <$fh>) {
+ next if ($line=~/^\#/);
+ chomp($line);
+ my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));
$language{$key}=$val.' - '.$enc;
if ($sup) {
$supported_language{$key}=$sup;
@@ -123,24 +124,24 @@ BEGIN {
my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/copyright.tab';
if ( open (my $fh,"<$copyrightfile") ) {
- while (<$fh>) {
- next if /^\#/;
- chomp;
- my ($key,$val)=(split(/\s+/,$_,2));
+ while (my $line = <$fh>) {
+ next if ($line=~/^\#/);
+ chomp($line);
+ my ($key,$val)=(split(/\s+/,$line,2));
$cprtag{$key}=$val;
}
close($fh);
}
}
-# ------------------------------------------------------------------ source copyrights
+# ----------------------------------------------------------- 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));
+ while (my $line = <$fh>) {
+ next if ($line =~ /^\#/);
+ chomp($line);
+ my ($key,$val)=(split(/\s+/,$line,2));
$scprtag{$key}=$val;
}
close($fh);
@@ -158,10 +159,10 @@ BEGIN {
{
my $designfile = $designdir.'/'.$filename;
if ( open (my $fh,"<$designfile") ) {
- while (<$fh>) {
- next if /^\#/;
- chomp;
- my ($key,$val)=(split(/\=/,$_));
+ while (my $line = <$fh>) {
+ next if ($line =~ /^\#/);
+ chomp($line);
+ my ($key,$val)=(split(/\=/,$line));
if ($val) { $designhash{$domain.'.'.$key}=$val; }
}
close($fh);
@@ -177,10 +178,10 @@ BEGIN {
my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filecategories.tab';
if ( open (my $fh,"<$categoryfile") ) {
- while (<$fh>) {
- next if /^\#/;
- chomp;
- my ($extension,$category)=(split(/\s+/,$_,2));
+ while (my $line = <$fh>) {
+ next if ($line =~ /^\#/);
+ chomp($line);
+ my ($extension,$category)=(split(/\s+/,$line,2));
push @{$category_extensions{lc($category)}},$extension;
}
close($fh);
@@ -192,13 +193,14 @@ BEGIN {
my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filetypes.tab';
if ( open (my $fh,"<$typesfile") ) {
- while (<$fh>) {
- next if (/^\#/);
- chomp;
- my ($ending,$emb,$descr)=split(/\s+/,$_,3);
+ while (my $line = <$fh>) {
+ next if ($line =~ /^\#/);
+ chomp($line);
+ my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
if ($descr ne '') {
$fe{$ending}=lc($emb);
$fd{$ending}=$descr;
+ if ($mime ne 'unk') { $fm{$ending}=$mime; }
}
}
close($fh);
@@ -705,8 +707,9 @@ sub help_open_menu {
my $origurl = $ENV{'REQUEST_URI'};
$origurl=~s|^/~|/priv/|;
my $timestamp = time;
- foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {
- $$_ = &Apache::lonnet::escape($$_);
+ foreach my $datum (\$color,\$function,\$topic,\$component_help,\$faq,
+ \$bug,\$origurl) {
+ $$datum = &Apache::lonnet::escape($$datum);
}
if (!$stayOnPage) {
$link = "javascript:helpMenu('open')";
@@ -1151,8 +1154,8 @@ sub get_domains {
# The code below was stolen from "The Perl Cookbook", p 102, 1st ed.
my @domains;
my %seen;
- foreach (sort values(%Apache::lonnet::hostdom)) {
- push (@domains,$_) unless $seen{$_}++;
+ foreach my $dom (sort(values(%Apache::lonnet::hostdom))) {
+ push(@domains,$dom) unless $seen{$dom}++;
}
return @domains;
}
@@ -1206,7 +1209,7 @@ sub multiple_select_form {
my @order = ref($order) ? @$order
: sort(keys(%$hash));
foreach my $key (@order) {
- $output.='<option value="'.$key.'" ';
+ $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
$output.='selected="selected" ' if ($selected{$key});
$output.='>'.$hash->{$key}."</option>\n";
}
@@ -1236,10 +1239,11 @@ sub select_form {
} else {
@keys=sort(keys(%hash));
}
- foreach (@keys) {
- $selectform.="<option value=\"$_\" ".
- ($_ eq $def ? 'selected="selected" ' : '').
- ">".&mt($hash{$_})."</option>\n";
+ foreach my $key (@keys) {
+ $selectform.=
+ '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
+ ($key eq $def ? 'selected="selected" ' : '').
+ ">".&mt($hash{$key})."</option>\n";
}
$selectform.="</select>";
return $selectform;
@@ -1303,10 +1307,10 @@ sub select_dom_form {
my @domains = get_domains();
if ($includeempty) { @domains=('',@domains); }
my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
- foreach (@domains) {
- $selectdomain.="<option value=\"$_\" ".
- ($_ eq $defdom ? 'selected="selected" ' : '').
- ">$_</option>\n";
+ foreach my $dom (@domains) {
+ $selectdomain.="<option value=\"$dom\" ".
+ ($dom eq $defdom ? 'selected="selected" ' : '').
+ ">$dom</option>\n";
}
$selectdomain.="</select>";
return $selectdomain;
@@ -1328,9 +1332,9 @@ given $domain.
sub get_library_servers {
my $domain = shift;
my %library_servers;
- foreach (keys(%Apache::lonnet::libserv)) {
- if ($Apache::lonnet::hostdom{$_} eq $domain) {
- $library_servers{$_} = $Apache::lonnet::hostname{$_};
+ foreach my $hostid (keys(%Apache::lonnet::libserv)) {
+ if ($Apache::lonnet::hostdom{$hostid} eq $domain) {
+ $library_servers{$hostid} = $Apache::lonnet::hostname{$hostid};
}
}
return %library_servers;
@@ -1352,9 +1356,10 @@ sub home_server_option_list {
my $domain = shift;
my %servers = &get_library_servers($domain);
my $result = '';
- foreach (sort keys(%servers)) {
+ foreach my $hostid (sort(keys(%servers))) {
$result.=
- '<option value="'.$_.'">'.$_.' '.$servers{$_}."</option>\n";
+ '<option value="'.$hostid.'">'.
+ $hostid.' '.$servers{$hostid}."</option>\n";
}
return $result;
}
@@ -1844,8 +1849,8 @@ sub initialize_keywords {
}
untie %thesaurus_db;
# Remove special values from %Keywords.
- foreach ('total.count','average.count') {
- delete($Keywords{$_}) if (exists($Keywords{$_}));
+ foreach my $value ('total.count','average.count') {
+ delete($Keywords{$value}) if (exists($Keywords{$value}));
}
return 1;
}
@@ -1901,11 +1906,11 @@ sub get_related_words {
}
my @Words=();
if (exists($thesaurus_db{$keyword})) {
- $_ = $thesaurus_db{$keyword};
- (undef,@Words) = split/:/; # The first element is the number of times
- # the word appears. We do not need it now.
+ # The first element is the number of times
+ # the word appears. We do not need it now.
+ (undef,@Words) = (split(/:/,$thesaurus_db{$keyword}));
for (my $i=0;$i<=$#Words;$i++) {
- ($Words[$i],undef)= split/\,/,$Words[$i];
+ ($Words[$i],undef)= split(/\,/,$Words[$i]);
}
}
untie %thesaurus_db;
@@ -1946,7 +1951,7 @@ sub plainname {
$name=~s/^\s+//;
$name=~s/\s+$//;
$name=~s/\s+/ /g;
- if ($name !~ /\S/) { $name=$uname.'@'.$udom; }
+ if ($name !~ /\S/) { $name=$uname.':'.$udom; }
return $name;
}
@@ -2182,7 +2187,8 @@ category
=cut
sub filecategorytypes {
- return @{$category_extensions{lc($_[0])}};
+ my ($cat) = @_;
+ return @{$category_extensions{lc($cat)}};
}
=pod
@@ -2197,6 +2203,10 @@ sub fileembstyle {
return $fe{lc(shift(@_))};
}
+sub filemimetype {
+ return $fm{lc(shift(@_))};
+}
+
sub filecategoryselect {
my ($name,$value)=@_;
@@ -2253,13 +2263,13 @@ sub fileextensions {
sub display_languages {
my %languages=();
- foreach (&preferred_languages()) {
- $languages{$_}=1;
+ foreach my $lang (&preferred_languages()) {
+ $languages{$lang}=1;
}
&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
if ($env{'form.displaylanguage'}) {
- foreach (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
- $languages{$_}=1;
+ foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
+ $languages{$lang}=1;
}
}
return %languages;
@@ -2294,11 +2304,11 @@ sub preferred_languages {
}
# turn "en-ca" into "en-ca,en"
my @genlanguages;
- foreach (@languages) {
- unless ($_=~/\w/) { next; }
- push (@genlanguages,$_);
- if ($_=~/(\-|\_)/) {
- push (@genlanguages,(split(/(\-|\_)/,$_))[0]);
+ foreach my $lang (@languages) {
+ unless ($lang=~/\w/) { next; }
+ push (@genlanguages,$lang);
+ if ($lang=~/(\-|\_)/) {
+ push(@genlanguages,(split(/(\-|\_)/,$lang))[0]);
}
}
return @genlanguages;
@@ -2354,14 +2364,14 @@ sub get_previous_attempt {
my %lasthash=();
my $version;
for ($version=1;$version<=$returnhash{'version'};$version++) {
- foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
- $lasthash{$_}=$returnhash{$version.':'.$_};
+ foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
+ $lasthash{$key}=$returnhash{$version.':'.$key};
}
}
$prevattempts='<table border="0" width="100%"><tr><td bgcolor="#777777">';
$prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>';
- foreach (sort(keys %lasthash)) {
- my ($ign,@parts) = split(/\./,$_);
+ foreach my $key (sort(keys(%lasthash))) {
+ my ($ign,@parts) = split(/\./,$key);
if ($#parts > 0) {
my $data=$parts[-1];
pop(@parts);
@@ -2377,27 +2387,27 @@ sub get_previous_attempt {
if ($getattempt eq '') {
for ($version=1;$version<=$returnhash{'version'};$version++) {
$prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>';
- foreach (sort(keys %lasthash)) {
+ foreach my $key (sort(keys(%lasthash))) {
my $value;
- if ($_ =~ /timestamp/) {
- $value=scalar(localtime($returnhash{$version.':'.$_}));
+ if ($key =~ /timestamp/) {
+ $value=scalar(localtime($returnhash{$version.':'.$key}));
} else {
- $value=$returnhash{$version.':'.$_};
+ $value=$returnhash{$version.':'.$key};
}
$prevattempts.='<td>'.&Apache::lonnet::unescape($value).' </td>';
}
}
}
$prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Current</td>';
- foreach (sort(keys %lasthash)) {
+ foreach my $key (sort(keys(%lasthash))) {
my $value;
- if ($_ =~ /timestamp/) {
- $value=scalar(localtime($lasthash{$_}));
+ if ($key =~ /timestamp/) {
+ $value=scalar(localtime($lasthash{$key}));
} else {
- $value=$lasthash{$_};
+ $value=$lasthash{$key};
}
$value=&Apache::lonnet::unescape($value);
- if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
+ if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
$prevattempts.='<td>'.$value.' </td>';
}
$prevattempts.='</tr></table></td></tr></table>';
@@ -2429,14 +2439,14 @@ sub relative_to_absolute {
}
}
$thisdir=~s-/[^/]*$--;
- foreach (@rlinks) {
- unless (($_=~/^http:\/\//i) ||
- ($_=~/^\//) ||
- ($_=~/^javascript:/i) ||
- ($_=~/^mailto:/i) ||
- ($_=~/^\#/)) {
- my $newlocation=&Apache::lonnet::hreflocation($thisdir,$_);
- $output=~s/(\"|\'|\=\s*)$_(\"|\'|\s|\>)/$1$newlocation$2/;
+ foreach my $link (@rlinks) {
+ unless (($link=~/^http:\/\//i) ||
+ ($link=~/^\//) ||
+ ($link=~/^javascript:/i) ||
+ ($link=~/^mailto:/i) ||
+ ($link=~/^\#/)) {
+ my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
+ $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
}
}
# -------------------------------------------------- Deal with Applet codebases
@@ -2604,11 +2614,17 @@ sub maketime {
#########################################
sub findallcourses {
- my %courses=();
+ my ($roles) = @_;
+ my %roles;
+ if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
+ my %courses;
my $now=time;
- foreach (keys %env) {
- if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {
- my ($starttime,$endtime)=$env{$_};
+ foreach my $key (keys(%env)) {
+ if ( $key=~m{^user\.role\.(\w+)\./(\w+)/(\w+)} ) {
+ my ($role,$domain,$id) = ($1,$2,$3);
+ next if ($role eq 'ca' || $role eq 'aa');
+ next if (%roles && !exists($roles{$role}));
+ my ($starttime,$endtime)=split(/\./,$env{$key});
my $active=1;
if ($starttime) {
if ($now<$starttime) { $active=0; }
@@ -2616,10 +2632,10 @@ sub findallcourses {
if ($endtime) {
if ($now>$endtime) { $active=0; }
}
- if ($active) { $courses{$1.'_'.$2}=1; }
+ if ($active) { $courses{$domain.'_'.$id}=1; }
}
}
- return keys %courses;
+ return keys(%courses);
}
###############################################
@@ -2757,6 +2773,9 @@ Inputs:
=item * $notitle, if true keep the nav controls, but remove the title bar
+=item * $no_inline_link, if true and in remote mode, don't show the
+ 'Switch To Inline Menu' link
+
=back
@@ -2769,15 +2788,13 @@ other decorations will be returned.
sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
- $notopbar,$bgcolor,$notitle)=@_;
+ $notopbar,$bgcolor,$notitle,$no_inline_link)=@_;
$title=&mt($title);
$function = &get_users_function() if (!$function);
my $img = &designparm($function.'.img',$domain);
- my $tabbg = &designparm($function.'.tabbg',$domain);
my $font = &designparm($function.'.font',$domain);
- my $sidebg = &designparm($function.'.sidebg',$domain);
my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
my %design = ( 'style' => 'margin-top: 0px',
@@ -2789,14 +2806,13 @@ sub bodytag {
@$addentries{keys(%design)} = @design{keys(%design)};
# role and realm
- my ($role,$realm)
- =&Apache::lonnet::plaintext((split(/\./,$env{'request.role'}))[0]);
+ my ($role,$realm) =
+ &Apache::lonnet::plaintext((split(/\./,$env{'request.role'}))[0]);
# realm
if ($env{'request.course.id'}) {
- $realm=
- $env{'course.'.$env{'request.course.id'}.'.description'};
+ $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
}
- unless ($realm) { $realm=' '; }
+ if (!$realm) { $realm=' '; }
# Set messages
my $messages=&domainlogo($domain);
# Port for miniserver
@@ -2806,14 +2822,9 @@ sub bodytag {
my $extra_body_attr = &make_attr_string($forcereg,$addentries);
# construct main body tag
- my $bodytag = <<END;
-<body $extra_body_attr>
-END
+ my $bodytag = "<body $extra_body_attr>".
+ &Apache::lontexconvert::init_math_support();
- $bodytag .= &Apache::lontexconvert::init_math_support();
-
- my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
- $lonhttpdPort.$img.'" alt="'.$function.'" />';
if ($bodyonly
|| ($env{'request.state'} eq 'construct'
&& $env{'environment.remote'} ne 'off' )) {
@@ -2826,75 +2837,92 @@ END
$bodytag.='<h1>LON-CAPA: '.$title.'</h1>';
}
return $bodytag;
- } elsif ($env{'environment.remote'} eq 'off') {
-# No Remote
- my $roleinfo=(<<ENDROLE);
-<td bgcolor="$tabbg" align="right">
-<font size="2" face="Arial, Helvetica, sans-serif">
+ }
+
+
+
+ my $roleinfo=(<<ENDROLE);
+<td class="LC_title_bar_who">
+<div class="LC_title_bar_name">
$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>
+
+</div>
+<div class="LC_title_bar_role">
+$role
+</div>
+<div class="LC_title_bar_realm">
+$realm
+</div>
</td>
ENDROLE
- my $titleinfo = '<font face="Arial, Helvetica, sans-serif" size="+3" color="'.
- $font.'"><b>'.$title.'</b></font>';
- if ($customtitle) {
- $titleinfo = $customtitle;
- }
+ my $titleinfo = '<span class="LC_title_bar_title">'.$title.'</span>';
+ if ($customtitle) {
+ $titleinfo = $customtitle;
+ }
+ #
+ # Extra info if you are the DC
+ my $dc_info = '';
+ if ($env{'user.adv'} && exists($env{'user.role.dc./'.
+ $env{'course.'.$env{'request.course.id'}.
+ '.domain'}.'/'})) {
+ my $cid = $env{'request.course.id'};
+ $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
+ $dc_info = '('.$dc_info.')';
+ }
+
+ if ($env{'environment.remote'} eq 'off') {
+ # No Remote
if ($env{'request.state'} eq 'construct') {
+ $forcereg=1;
+ }
+
+ if (!$customtitle && $env{'request.state'} eq 'construct') {
+ # this is for resources; directories have customtitle, and crumbs
+ # and select recent are created in lonpubdir.pm
my ($uname,$thisdisfn)=
($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
my $formaction='/priv/'.$uname.'/'.$thisdisfn;
$formaction=~s/\/+/\//g;
- unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm
- my $parentpath = '';
- my $lastitem = '';
- if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
- $parentpath = $1;
- $lastitem = $2;
- } else {
- $lastitem = $thisdisfn;
- }
- $titleinfo = &Apache::loncommon::help_open_menu('','','','',3,'Authoring').
- '<font face="Arial, Helvetica, sans-serif"><b>Construction Space</b>:</font> '.
- '<form name="dirs" method="post" action="'.$formaction
- .'" target="_top"><tt><b>'
- .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
- .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
- .'</form>'
- .&Apache::lonmenu::constspaceform();
- }
- $forcereg=1;
+ my $parentpath = '';
+ my $lastitem = '';
+ if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
+ $parentpath = $1;
+ $lastitem = $2;
+ } else {
+ $lastitem = $thisdisfn;
+ }
+ $titleinfo =
+ &Apache::loncommon::help_open_menu('','','','',3,'Authoring').
+ '<b>Construction Space</b>: '.
+ '<form name="dirs" method="post" action="'.$formaction
+ .'" target="_top"><tt><b>'
+ .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
+ .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
+ .'</form>'
+ .&Apache::lonmenu::constspaceform();
}
+
my $titletable;
if (!$notitle) {
$titletable =
- '<table bgcolor="'.$pgbg.'" width="100%" border="0" '.
- 'cellspacing="3" cellpadding="3">'.
- '<tr><td bgcolor="'.$tabbg.'">'.
- $titleinfo.'</td>'.$roleinfo.'</tr></table>';
+ '<table id="LC_title_bar">'.
+ "<tr><td> $titleinfo $dc_info</td>".$roleinfo.
+ '</tr></table>';
}
- if ($env{'request.state'} eq 'construct') {
- if ($notopbar) {
- $bodytag .= $titletable;
- } else {
+ if ($notopbar) {
+ $bodytag .= $titletable;
+ } else {
+ if ($env{'request.state'} eq 'construct') {
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg,
$titletable);
- }
- } else {
- if ($notopbar) {
- $bodytag .= $titletable;
} else {
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg).
- $titletable;
+ $titletable;
}
}
return $bodytag;
@@ -2903,51 +2931,26 @@ ENDROLE
#
# Top frame rendering, Remote is up
#
- my $titleinfo = ' <font size="5" face="Arial, Helvetica, sans-serif"><b>'.$title.'</b></font>';
- if ($customtitle) {
- $titleinfo = $customtitle;
- }
- #
- # Extra info if you are the DC
- my $dc_info = '';
- if ($env{'user.adv'} && exists($env{'user.role.dc./'.
- $env{'course.'.$env{'request.course.id'}.
- '.domain'}.'/'})) {
- my $cid = $env{'request.course.id'};
- $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
- $dc_info = '('.$dc_info.')';
- }
+
+ my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
+ $lonhttpdPort.$img.'" alt="'.$function.'" />';
+
# Explicit link to get inline menu
- my $menu='<br /><font size="2" face="Arial, Helvetica, sans-serif"> <a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a></font>';
+ my $menu= ($no_inline_link?''
+ :'<br /><a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a>');
#
if ($notitle) {
return $bodytag;
}
return(<<ENDBODY);
$bodytag
-<table width="100%" cellspacing="0" border="0" cellpadding="0">
-<tr><td bgcolor="$sidebg">
-$upperleft</td>
-<td bgcolor="$sidebg" align="right">$messages </td>
+<table id="LC_title_bar" class="LC_with_remote">
+<tr><td>$upperleft</td>
+ <td class="LC_title_bar_domain_logo">$messages </td>
</tr>
-<tr>
-<td rowspan="3" bgcolor="$tabbg">
-$titleinfo $dc_info $menu
-</td><td bgcolor="$tabbg" align="right">
-<font size="2" face="Arial, Helvetica, sans-serif">
- $env{'environment.firstname'}
- $env{'environment.middlename'}
- $env{'environment.lastname'}
- $env{'environment.generation'}
- </font>
-</td>
-</tr>
-<tr><td bgcolor="$tabbg" align="right">
-<font size="2" face="Arial, Helvetica, sans-serif">$role</font>
-</td></tr>
-<tr>
-<td bgcolor="$tabbg" align="right"><font size="2" face="Arial, Helvetica, sans-serif">$realm</font> </td></tr>
-</table><br />
+<tr><td>$titleinfo $dc_info $menu</td>
+$roleinfo
+</table>
ENDBODY
}
@@ -3040,17 +3043,227 @@ sub endbodytag {
return $endbodytag;
}
+=pod
+
+=over 4
+
+=item * &standard_css()
+
+Returns a style sheet
+
+Inputs: (all optional)
+ domain -> force to color decorate a page for a specific
+ domain
+ function -> force usage of a specific rolish color scheme
+ bgcolor -> override the default page bgcolor
+
+=back
+
+=cut
+
sub standard_css {
+ my ($function,$domain,$bgcolor) = @_;
+ $function = &get_users_function() if (!$function);
+ my $img = &designparm($function.'.img', $domain);
+ my $tabbg = &designparm($function.'.tabbg', $domain);
+ my $font = &designparm($function.'.font', $domain);
+ my $sidebg = &designparm($function.'.sidebg',$domain);
+ my $pgbg = $bgcolor ||
+ &designparm($function.'.pgbg', $domain);
+ my $alink = &designparm($function.'.alink', $domain);
+ my $vlink = &designparm($function.'.vlink', $domain);
+ my $link = &designparm($function.'.link', $domain);
+
+ my $sans = 'Arial,Helvetica,sans-serif';
+ my $data_table_head = $tabbg;
+ my $data_table_light = '#EEEEEE';
+ my $data_table_dark = '#DDD';
+ my $data_table_highlight = '#FFFF00';
+ my $mail_new = '#FFBB77';
+ my $mail_new_hover = '#DD9955';
+ my $mail_read = '#BBBB77';
+ my $mail_read_hover = '#999944';
+ my $mail_replied = '#AAAA88';
+ my $mail_replied_hover = '#888855';
+ my $mail_other = '#99BBBB';
+ my $mail_other_hover = '#669999';
+
return <<END;
-<style type="text/css">
-h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
+h1, h2, h3, th { font-family: $sans }
a:focus { color: red; background: yellow }
table.thinborder { border-collapse: collapse; }
table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px}
form, .inline { display: inline; }
.center { text-align: center; }
.filename {font-family: monospace;}
-</style>
+.LC_error {
+ color: red;
+ font-size: larger;
+}
+.LC_success {
+ color: green;
+}
+
+table#LC_top_nav, table#LC_menubuttons, table#LC_nav_location, table#LC_breadcrumbs {
+ width: 100%;
+ background: $pgbg;
+ border: 0px;
+ border-spacing: 2px 1px;
+ padding: 0px;
+ margin: 0px;
+ border-collapse: separate;
+}
+table#LC_title_bar {
+ width: 100%;
+ border: 0;
+ border-spacing: 0px 1px;
+ background: $pgbg;
+ font-family: $sans;
+ border-collapse: collapse;
+}
+table#LC_title_bar.LC_with_remote {
+ width: 100%;
+ border: 0;
+ border-spacing: 0;
+ background: $pgbg;
+ font-family: $sans;
+ border-collapse: collapse;
+}
+table#LC_title_bar td {
+ padding: 3px;
+ background: $tabbg;
+}
+table#LC_title_bar td.LC_title_bar_who {
+ background: $tabbg;
+ color: $font;
+ font: medium $sans;
+ text-align: right;
+}
+span.LC_title_bar_title {
+ font: bold xx-large $sans;
+}
+table#LC_title_bar td.LC_title_bar_domain_logo {
+ background: $sidebg;
+ text-align: right;
+}
+
+table#LC_menubuttons_mainmenu {
+ background: $pgbg;
+ border: 0px;
+ border-spacing: 1px;
+ padding: 0px;
+ margin: 0px;
+ border-collapse: separate;
+}
+table#LC_menubuttons img, table#LC_menubuttons_mainmenu img {
+ border: 0px;
+}
+table#LC_top_nav td {
+ background: $tabbg;
+}
+table#LC_top_nav td a, div#LC_top_nav a {
+ color: $font;
+ font-family: $sans;
+}
+table#LC_top_nav td.LC_top_nav_logo {
+ background: $tabbg;
+ text-align: right;
+}
+table#LC_breadcrumbs td {
+ background: $tabbg;
+ color: $font;
+ font-family: $sans;
+ font-size: smaller;
+}
+table#LC_breadcrumbs td.LC_breadcrumb_component {
+ background: $tabbg;
+ color: $font;
+ font-family: $sans;
+ font-size: larger;
+ text-align: right;
+}
+.LC_menubuttons_inline_text {
+ color: $font;
+ font-family: $sans;
+ font-size: smaller;
+}
+
+td.LC_menubuttons_text {
+ color: $font;
+ font-family: $sans;
+}
+td.LC_menubuttons_img {
+ background: $tabbg;
+}
+.LC_current_location {
+ font-family: $sans;
+ background: $tabbg;
+}
+.LC_new_mail {
+ font-family: $sans;
+ font-weight: bold;
+}
+
+table.LC_data_table, table.LC_mail_list {
+ border: 1px solid #000000;
+ border-collapse: seperate;
+}
+table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th {
+ font-weight: bold;
+ background-color: $data_table_head;
+}
+table.LC_data_table tr td {
+ background-color: $data_table_light;
+}
+table.LC_data_table tr.LC_even_row td {
+ background-color: $data_table_dark;
+}
+table.LC_data_table tr.LC_empty td {
+ background-color: #FFFFFF;
+}
+
+table.LC_calendar {
+ border: 1px solid #000000;
+ border-collapse: collapse;
+}
+table.LC_calendar_pickdate {
+ font-size: xx-small;
+}
+table.LC_calendar tr td {
+ border: 1px solid #000000;
+ vertical-align: top;
+}
+table.LC_calendar tr td.LC_calendar_day_empty {
+ background-color: $data_table_dark;
+}
+table.LC_calendar tr td.LC_calendar_day_current {
+ background-color: $data_table_highlight;
+}
+
+table.LC_mail_list tr.LC_mail_new {
+ background-color: $mail_new;
+}
+table.LC_mail_list tr.LC_mail_new:hover {
+ background-color: $mail_new_hover;
+}
+table.LC_mail_list tr.LC_mail_read {
+ background-color: $mail_read;
+}
+table.LC_mail_list tr.LC_mail_read:hover {
+ background-color: $mail_read_hover;
+}
+table.LC_mail_list tr.LC_mail_replied {
+ background-color: $mail_replied;
+}
+table.LC_mail_list tr.LC_mail_replied:hover {
+ background-color: $mail_replied_hover;
+}
+table.LC_mail_list tr.LC_mail_other {
+ background-color: $mail_other;
+}
+table.LC_mail_list tr.LC_mail_other:hover {
+ background-color: $mail_other_hover;
+}
END
}
@@ -3067,11 +3280,16 @@ Inputs: $title - optional title for the
$args - optional arguments
force_register - if is true call registerurl so the remote is
informed
- redirect - array ref of seconds before redirect occurs
+ redirect -> array ref of seconds before redirect occurs
url to redirect to
(side effect of setting
$env{'internal.head.redirect'} to the url
redirected too)
+ domain -> force to color decorate a page for a specific
+ domain
+ function -> force usage of a specific rolish color scheme
+ bgcolor -> override the default page bgcolor
+
=back
=cut
@@ -3079,9 +3297,18 @@ Inputs: $title - optional title for the
sub headtag {
my ($title,$head_extra,$args) = @_;
+ my $function = $args->{'function'} || &get_users_function();
+ my $domain = $args->{'domain'} || &determinedomain();
+ my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
+ my $url = join(':',$env{'user.name'},$env{'user.domain'},
+ $env{'environment.color.timestamp'},
+ $function,$domain,$bgcolor);
+
+ $url = '/adm/css/'.&Apache::lonnet::escape($url).'.css';
+
my $result =
'<head>'.
- &standard_css().
+ '<link rel="stylesheet" type="text/css" href="'.$url.'" />'.
&font_settings().
&Apache::lonhtmlcommon::htmlareaheaders();
@@ -3095,7 +3322,7 @@ sub headtag {
$env{'internal.head.redirect'} = $url;
$result.=<<ADDMETA
<meta http-equiv="pragma" content="no-cache" />
-<meta HTTP-EQUIV="Refresh" CONTENT="$time; url=$url" />
+<meta http-equiv="Refresh" content="$time; url=$url" />
ADDMETA
}
if (!defined($title)) {
@@ -3240,6 +3467,9 @@ Inputs: $title - optional title for the
head -> skip the <html><head> generation
body -> skip all <body> generation
+ no_inline_link -> if true and in remote mode, don't show the
+ 'Switch To Inline Menu' link
+
=back
=cut
@@ -3248,7 +3478,8 @@ sub start_page {
my ($title,$head_extra,$args) = @_;
#&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
my %head_args;
- foreach my $arg ('redirect','force_register') {
+ foreach my $arg ('redirect','force_register','domain','function',
+ 'bgcolor') {
if (defined($args->{$arg})) {
$head_args{$arg} = $args->{$arg};
}
@@ -3274,7 +3505,7 @@ sub start_page {
$args->{'only_body'}, $args->{'domain'},
$args->{'force_register'}, $args->{'body_title'},
$args->{'no_nav_bar'}, $args->{'bgcolor'},
- $args->{'no_title'});
+ $args->{'no_title'}, $args->{'no_inline_link'});
}
}
@@ -3394,6 +3625,29 @@ sub simple_error_page {
}
return $page;
}
+
+{
+ my $row_count;
+ sub start_data_table {
+ undef($row_count);
+ return '<table class="LC_data_table">';
+ }
+
+ sub end_data_table {
+ undef($row_count);
+ return '</table>';
+ }
+
+ sub start_data_table_row {
+ $row_count++;
+ return '<tr '.(($row_count % 2)?'':'class="LC_even_row"').'>';
+ }
+
+ sub end_data_table_row {
+ return '</tr>';
+ }
+}
+
###############################################
=pod
@@ -3566,25 +3820,24 @@ can be sent to &get_group_settings() to
###############################################
sub coursegroups {
- my ($curr_groups,$cdom,$cnum,$group) = @_;
- my $numgroups;
+ my ($cdom,$cnum,$group) = @_;
if (!defined($cdom) || !defined($cnum)) {
my $cid = $env{'request.course.id'};
+
+ return if (!defined($cid));
+
$cdom = $env{'course.'.$cid.'.domain'};
$cnum = $env{'course.'.$cid.'.num'};
}
- %{$curr_groups} = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);
- my ($tmp) = keys(%{$curr_groups});
- if ($tmp=~/^error:/) {
- unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') {
- &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.
- $cdom);
- }
- $numgroups = 0;
- } else {
- $numgroups = keys(%{$curr_groups});
+ my %curr_groups = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);
+ my ($tmp) = keys(%curr_groups);
+ if ($tmp=~/^(con_lost|no_such_host|error: [^2] )/) {
+ undef(%curr_groups);
+ &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom);
+ } elsif ($tmp=~/^error: 2 /) {
+ undef(%curr_groups);
}
- return $numgroups;
+ return %curr_groups;
}
###############################################
@@ -3830,8 +4083,8 @@ will result in $env{'form.uname'} and $e
sub get_unprocessed_cgi {
my ($query,$possible_names)= @_;
# $Apache::lonxml::debug=1;
- foreach (split(/&/,$query)) {
- my ($name, $value) = split(/=/,$_);
+ foreach my $pair (split(/&/,$query)) {
+ my ($name, $value) = split(/=/,$pair);
$name = &Apache::lonnet::unescape($name);
if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
$value =~ tr/+/ /;
@@ -4048,8 +4301,7 @@ sub record_sep {
if ($env{'form.upfiletype'} eq 'xml') {
} elsif ($env{'form.upfiletype'} eq 'space') {
my $i=0;
- foreach (split(/\s+/,$record)) {
- my $field=$_;
+ foreach my $field (split(/\s+/,$record)) {
$field=~s/^(\"|\')//;
$field=~s/(\"|\')$//;
$components{&takeleft($i)}=$field;
@@ -4057,8 +4309,7 @@ sub record_sep {
}
} elsif ($env{'form.upfiletype'} eq 'tab') {
my $i=0;
- foreach (split(/\t/,$record)) {
- my $field=$_;
+ foreach my $field (split(/\t/,$record)) {
$field=~s/^(\"|\')//;
$field=~s/(\"|\')$//;
$components{&takeleft($i)}=$field;
@@ -4152,14 +4403,14 @@ sub csv_print_samples {
my $samples = &get_samples($records,3);
$r->print(&mt('Samples').'<br /><table border="2"><tr>');
- foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
- $r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); }
+ foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
+ $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
$r->print('</tr>');
foreach my $hash (@$samples) {
$r->print('<tr>');
- foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
+ foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('<td>');
- if (defined($$hash{$_})) { $r->print($$hash{$_}); }
+ if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
$r->print('</td>');
}
$r->print('</tr>');
@@ -4192,17 +4443,17 @@ sub csv_print_select_table {
'<table border="2"><tr>'.
'<th>'.&mt('Attribute').'</th>'.
'<th>'.&mt('Column').'</th></tr>'."\n");
- foreach (@$d) {
- my ($value,$display,$defaultcol)=@{ $_ };
+ foreach my $array_ref (@$d) {
+ my ($value,$display,$defaultcol)=@{ $array_ref };
$r->print('<tr><td>'.$display.'</td>');
$r->print('<td><select name=f'.$i.
' onchange="javascript:flip(this.form,'.$i.');">');
$r->print('<option value="none"></option>');
- foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
- $r->print('<option value="'.$_.'"'.
- ($_ eq $defaultcol ? ' selected="selected" ' : '').
- '>Column '.($_+1).'</option>');
+ foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
+ $r->print('<option value="'.$sample.'"'.
+ ($sample eq $defaultcol ? ' selected="selected" ' : '').
+ '>Column '.($sample+1).'</option>');
}
$r->print('</select></td></tr>'."\n");
$i++;