--- loncom/interface/loncommon.pm 2006/03/19 22:48:53 1.314
+++ loncom/interface/loncommon.pm 2006/05/17 23:25:56 1.374
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.314 2006/03/19 22:48:53 albertel Exp $
+# $Id: loncommon.pm,v 1.374 2006/05/17 23:25:56 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -58,10 +58,13 @@ use strict;
use Apache::lonnet;
use GDBM_File;
use POSIX qw(strftime mktime);
-use Apache::Constants qw(:common :http :methods);
use Apache::lonmenu();
use Apache::lonlocal;
use HTML::Entities;
+use Apache::lonhtmlcommon();
+use Apache::loncoursedata();
+use Apache::lontexconvert();
+use LONCAPA;
my $readit;
@@ -74,7 +77,7 @@ my %language;
my %supported_language;
my %cprtag;
my %scprtag;
-my %fe; my %fd;
+my %fe; my %fd; my %fm;
my %category_extensions;
# ---------------------------------------------- Designs
@@ -105,10 +108,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;
@@ -122,24 +125,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);
@@ -157,10 +160,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);
@@ -176,10 +179,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);
@@ -191,13 +194,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);
@@ -704,8 +708,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 = &escape($$datum);
}
if (!$stayOnPage) {
$link = "javascript:helpMenu('open')";
@@ -721,8 +726,18 @@ sub help_open_menu {
"<td bgcolor='#CC6600'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
}
my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
- my $html=&Apache::lonxml::xmlbegin();
my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
+ my $start_page =
+ &Apache::loncommon::start_page('Help Menu', undef,
+ {'frameset' => 1,
+ 'js_ready' => 1,
+ 'add_entries' => {
+ 'border' => '0',
+ 'rows' => "105,*",},});
+ my $end_page =
+ &Apache::loncommon::end_page({'frameset' => 1,
+ 'js_ready' => 1,});
+
$template .= <<"ENDTEMPLATE";
<script type="text/javascript">
// <!-- BEGIN LON-CAPA Internal
@@ -746,9 +761,7 @@ function helpMenu(target) {
return;
}
function writeHelp(caller) {
- caller.document.writeln('$html<head><title>LON-CAPA Help Menu</title><meta http-equiv="pragma" content="no-cache"></head>')
- caller.document.writeln("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
- caller.document.writeln("</html>")
+ caller.document.writeln('$start_page<frame name="bannerframe" src="$banner_link" /><frame name="bodyframe" src="$details_link" /> $end_page')
caller.document.close()
caller.focus()
}
@@ -763,7 +776,7 @@ ENDTEMPLATE
$width,$height).' '.$template;
} else {
my $help_text;
- $help_text=&Apache::lonnet::unescape($topic);
+ $help_text=&unescape($topic);
$template='<table><tr><td>'.
&help_open_topic($component_help,$help_text,$stayOnPage,
$width,$height).'</td><td>'.$template.
@@ -791,7 +804,7 @@ sub help_open_bug {
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;
+ &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'))";
@@ -1142,8 +1155,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;
}
@@ -1197,7 +1210,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";
}
@@ -1227,10 +1240,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;
@@ -1294,10 +1308,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;
@@ -1319,9 +1333,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;
@@ -1343,9 +1357,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;
}
@@ -1835,8 +1850,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;
}
@@ -1892,11 +1907,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;
@@ -1937,7 +1952,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;
}
@@ -2010,10 +2025,11 @@ sub screenname {
# ------------------------------------------------------------- Message Wrapper
sub messagewrapper {
- my ($link,$username,$domain)=@_;
+ my ($link,$username,$domain,$subject,$text)=@_;
return
'<a href="/adm/email?compose=individual&'.
- 'recname='.$username.'&recdom='.$domain.'" '.
+ 'recname='.$username.'&recdom='.$domain.
+ '&subject='.&escape($subject).'&text='.&escape($text).'" '.
'title="'.&mt('Send message').'">'.$link.'</a>';
}
# --------------------------------------------------------------- Notes Wrapper
@@ -2173,7 +2189,8 @@ category
=cut
sub filecategorytypes {
- return @{$category_extensions{lc($_[0])}};
+ my ($cat) = @_;
+ return @{$category_extensions{lc($cat)}};
}
=pod
@@ -2188,6 +2205,10 @@ sub fileembstyle {
return $fe{lc(shift(@_))};
}
+sub filemimetype {
+ return $fm{lc(shift(@_))};
+}
+
sub filecategoryselect {
my ($name,$value)=@_;
@@ -2244,13 +2265,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;
@@ -2285,11 +2306,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;
@@ -2345,14 +2366,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);
@@ -2368,27 +2389,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.='<td>'.&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)}
+ $value=&unescape($value);
+ if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
$prevattempts.='<td>'.$value.' </td>';
}
$prevattempts.='</tr></table></td></tr></table>';
@@ -2420,14 +2441,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
@@ -2509,7 +2530,7 @@ sub submlink {
if (!$symb) { $symb=$cursymb; }
}
if (!$symb) { $symb=&Apache::lonnet::symbread(); }
- $symb=&Apache::lonnet::escape($symb);
+ $symb=&escape($symb);
if ($target) { $target="target=\"$target\""; }
return '<a href="/adm/grades?&command=submission&'.
'symb='.$symb.'&student='.$uname.
@@ -2555,7 +2576,7 @@ sub pprmlink {
if (!$symb) { $symb=$cursymb; }
}
if (!$symb) { $symb=&Apache::lonnet::symbread(); }
- $symb=&Apache::lonnet::escape($symb);
+ $symb=&escape($symb);
if ($target) { $target="target=\"$target\""; }
return '<a href="/adm/parmset?&command=set&'.
'symb='.$symb.'&uname='.$uname.
@@ -2585,6 +2606,11 @@ sub timehash {
'dlsav' => $ltime[8] );
}
+sub utc_string {
+ my ($date)=@_;
+ return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
+}
+
sub maketime {
my %th=@_;
return POSIX::mktime(
@@ -2595,11 +2621,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; }
@@ -2607,10 +2639,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);
}
###############################################
@@ -2737,10 +2769,21 @@ Inputs:
=item * $forcereg, if page should register as content page (relevant for
text interface only)
-=item * $customtitle, overrides the $title in some way ????
+=item * $customtitle, alternate text to use instead of $title
+ in the title box that appears, this text
+ is not auto translated like the $title is
=item * $notopbar, if true, keep the 'what is this' info but remove the
navigational links
+
+=item * $bgcolor, used to override the bgcolor on a webpage to a specific value
+
+=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
Returns: A uniform header for LON-CAPA web pages.
@@ -2752,130 +2795,141 @@ other decorations will be returned.
sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
- $notopbar)=@_;
+ $notopbar,$bgcolor,$notitle,$no_inline_link)=@_;
+
$title=&mt($title);
+
$function = &get_users_function() if (!$function);
- my $img=&designparm($function.'.img',$domain);
- my $pgbg=&designparm($function.'.pgbg',$domain);
- my $tabbg=&designparm($function.'.tabbg',$domain);
- my $font=&designparm($function.'.font',$domain);
- my $link=&designparm($function.'.link',$domain);
- my $alink=&designparm($function.'.alink',$domain);
- my $vlink=&designparm($function.'.vlink',$domain);
- my $sidebg=&designparm($function.'.sidebg',$domain);
-# Accessibility font enhance
- unless ($addentries) { $addentries=''; }
- my $addstyle='';
- if ($env{'browser.fontenhance'} eq 'on') {
- $addstyle=' font-size: x-large;';
- }
+ my $img = &designparm($function.'.img',$domain);
+ my $font = &designparm($function.'.font',$domain);
+ my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
+
+ my %design = ( 'style' => 'margin-top: 0px',
+ 'bgcolor' => $pgbg,
+ 'text' => $font,
+ 'alink' => &designparm($function.'.alink',$domain),
+ 'vlink' => &designparm($function.'.vlink',$domain),
+ 'link' => &designparm($function.'.link',$domain),);
+ @$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
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
+
+ my $extra_body_attr = &make_attr_string($forcereg,$addentries);
+
# construct main body tag
- my $bodytag = <<END;
-<style type="text/css">
-h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
-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>
-<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
-style="margin-top: 0px;$addstyle" $addentries>
-END
- &Apache::lontexconvert::jsMath_reset();
- if ($env{'environment.texengine'} eq 'jsMath') {
- $bodytag.=&Apache::lontexconvert::jsMath_header();
- }
+ my $bodytag = "<body $extra_body_attr>".
+ &Apache::lontexconvert::init_math_support();
- my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
- $lonhttpdPort.$img.'" alt="'.$function.'" />';
- if ($bodyonly) {
+ if ($bodyonly
+ || ($env{'request.state'} eq 'construct'
+ && $env{'environment.remote'} ne 'off' )) {
return $bodytag;
} elsif ($env{'browser.interface'} eq 'textual') {
# Accessibility
- return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
- $forcereg).
- '<h1>LON-CAPA: '.$title.'</h1>';
- } elsif ($env{'environment.remote'} eq 'off') {
-# No Remote
- my $roleinfo=(<<ENDROLE);
-<td bgcolor="$tabbg" align="right">
-<font size="2" face="Arial, Helvetica, sans-serif">
+ $bodytag.=&Apache::lonmenu::menubuttons($forcereg,$forcereg);
+ if (!$notitle) {
+ $bodytag.='<h1>LON-CAPA: '.$title.'</h1>';
+ }
+ return $bodytag;
+ }
+
+
+
+ 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 $titletable = '<table bgcolor="'.$pgbg.'" width="100%" border="0" '.
- 'cellspacing="3" cellpadding="3">'.
- '<tr><td bgcolor="'.$tabbg.'">'.
- $titleinfo.'</td>'.$roleinfo.'</tr></table>';
- if ($env{'request.state'} eq 'construct') {
- if ($notopbar) {
- $bodytag .= $titletable;
- } else {
- $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);
- }
+ 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 id="LC_title_bar">'.
+ "<tr><td> $titleinfo $dc_info</td>".$roleinfo.
+ '</tr></table>';
+ }
+ if ($notopbar) {
+ $bodytag .= $titletable;
} else {
- if ($notopbar) {
- $bodytag .= $titletable;
+ if ($env{'request.state'} eq 'construct') {
+ $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg,
+ $titletable);
} else {
- $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).
- $titletable;
+ $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg).
+ $titletable;
}
}
return $bodytag;
@@ -2884,51 +2938,86 @@ 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 class="LC_title_bar_role_logo">$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><td>$titleinfo $dc_info $menu</td>
+$roleinfo
</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 />
+</table>
ENDBODY
}
+sub make_attr_string {
+ my ($register,$attr_ref) = @_;
+
+ if ($attr_ref && !ref($attr_ref)) {
+ die("addentries Must be a hash ref ".
+ join(':',caller(1))." ".
+ join(':',caller(0))." ");
+ }
+
+ if ($register) {
+ my ($on_load,$on_unload);
+ foreach my $key (keys(%{$attr_ref})) {
+ if (lc($key) eq 'onload') {
+ $on_load.=$attr_ref->{$key}.';';
+ delete($attr_ref->{$key});
+
+ } elsif (lc($key) eq 'onunload') {
+ $on_unload.=$attr_ref->{$key}.';';
+ delete($attr_ref->{$key});
+ }
+ }
+ $attr_ref->{'onload'} =
+ &Apache::lonmenu::loadevents(). $on_load;
+ $attr_ref->{'onunload'}=
+ &Apache::lonmenu::unloadevents().$on_unload;
+ }
+
+# Accessibility font enhance
+ if ($env{'browser.fontenhance'} eq 'on') {
+ my $style;
+ foreach my $key (keys(%{$attr_ref})) {
+ if (lc($key) eq 'style') {
+ $style.=$attr_ref->{$key}.';';
+ delete($attr_ref->{$key});
+ }
+ }
+ $attr_ref->{'style'}=$style.'; font-size: x-large;';
+ }
+
+ if ($env{'browser.blackwhite'} eq 'on') {
+ delete($attr_ref->{'font'});
+ delete($attr_ref->{'link'});
+ delete($attr_ref->{'alink'});
+ delete($attr_ref->{'vlink'});
+ delete($attr_ref->{'bgcolor'});
+ delete($attr_ref->{'background'});
+ }
+
+ my $attr_string;
+ foreach my $attr (keys(%$attr_ref)) {
+ $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
+ }
+ return $attr_string;
+}
+
+
###############################################
###############################################
@@ -2953,6 +3042,12 @@ Inputs: none
sub endbodytag {
my $endbodytag='</body>';
$endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
+ if ( exists( $env{'internal.head.redirect'} ) ) {
+ $endbodytag=
+ "<br /><a href=\"$env{'internal.head.redirect'}\">".
+ &mt('Continue').'</a>'.
+ $endbodytag;
+ }
return $endbodytag;
}
@@ -2960,12 +3055,254 @@ sub endbodytag {
=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;
+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;}
+.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;
+ padding: 0px 2px 0px 2px;
+ background: $pgbg;
+ font-family: $sans;
+ border-collapse: separate;
+}
+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;
+ padding: 0px;
+}
+table#LC_title_bar td.LC_title_bar_role_logo {
+ background: $sidebg;
+ padding: 0px;
+}
+
+table#LC_menubuttons_mainmenu {
+ background: $pgbg;
+ border: 0px;
+ border-spacing: 1px;
+ padding: 0px 1px;
+ 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
+}
+
+=pod
+
+=over 4
+
=item * &headtag()
Returns a uniform footer for LON-CAPA web pages.
Inputs: $title - optional title for the head
$head_extra - optional extra HTML to put inside the <head>
+ $args - optional arguments
+ force_register - if is true call registerurl so the remote is
+ informed
+ 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
@@ -2974,24 +3311,39 @@ 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/'.&escape($url).'.css';
+
my $result =
'<head>'.
- &Apache::lonxml::fontsettings().
+ '<link rel="stylesheet" type="text/css" href="'.$url.'" />'.
+ &font_settings().
&Apache::lonhtmlcommon::htmlareaheaders();
-
+
+ if ($args->{'force_register'}) {
+ $result .= &Apache::lonmenu::registerurl(1);
+ }
+
if (ref($args->{'redirect'})) {
my ($time,$url) = @{$args->{'redirect'}};
+ $url = &Apache::lonenc::check_encrypt($url);
+ $env{'internal.head.redirect'} = $url;
$result.=<<ADDMETA
<meta http-equiv="pragma" content="no-cache" />
-<meta HTTP-EQUIV="Refresh" CONTENT="2; url=$url" />
+<meta http-equiv="Refresh" content="$time; url=$url" />
ADDMETA
}
if (!defined($title)) {
$title = 'The LearningOnline Network with CAPA';
}
- $result .= '<title>'.&mt($title).'</title>'.$head_extra;
-
+ $result .= '<title> LON-CAPA '.&mt($title).'</title>'.$head_extra;
return $result;
}
@@ -2999,6 +3351,66 @@ ADDMETA
=over 4
+=item * &font_settings()
+
+Returns neccessary <meta> to set the proper encoding
+
+Inputs: none
+
+=back
+
+=cut
+
+sub font_settings {
+ my $headerstring='';
+ if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) {
+ $headerstring.=
+ '<meta Content-Type="text/html; charset=x-mac-roman" />';
+ } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
+ $headerstring.=
+ '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
+ }
+ return $headerstring;
+}
+
+=pod
+
+=over 4
+
+=item * &xml_begin()
+
+Returns the needed doctype and <html>
+
+Inputs: none
+
+=back
+
+=cut
+
+sub xml_begin {
+ my $output='';
+
+ &Apache::lonhtmlcommon::init_htmlareafields();
+
+ if ($env{'browser.mathml'}) {
+ $output='<?xml version="1.0"?>'
+ #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
+# .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
+
+# .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" [<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">] >'
+ .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'
+ .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
+ .'xmlns="http://www.w3.org/1999/xhtml">';
+ } else {
+ $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html>';
+ }
+ return $output;
+}
+
+=pod
+
+=over 4
+
=item * &endheadtag()
Returns a uniform </head> for LON-CAPA web pages.
@@ -3028,8 +3440,8 @@ Inputs: $title - optional title for the
=cut
sub head {
- my ($title,$head_extra) = @_;
- return &headtag($title,$head_extra).&endheadtag();
+ my ($title,$head_extra,$args) = @_;
+ return &headtag($title,$head_extra,$args).&endheadtag();
}
=pod
@@ -3042,14 +3454,35 @@ Returns a complete <html> .. <body> sect
Inputs: $title - optional title for the page
$head_extra - optional extra HTML to incude inside the <head>
- %args - additional optional args supported are:
- only_body -> is true will set &bodytag() onlybodytag arg on
- no_nav_bar -> is true will set &bodytag() notopbar arg on
- add_entries -> additional attributes to add to the <body>
- domain -> force to color decorate a page for a
- specific domain
- function -> force usage of a specific rolish color scheme
- redirect -> ...
+ $args - additional optional args supported are:
+ only_body -> is true will set &bodytag() onlybodytag
+ arg on
+ no_nav_bar -> is true will set &bodytag() notopbar arg on
+ add_entries -> additional attributes to add to the <body>
+ domain -> force to color decorate a page for a
+ specific domain
+ function -> force usage of a specific rolish color
+ scheme
+ redirect -> see &headtag()
+ bgcolor -> override the default page bg color
+ js_ready -> return a string ready for being used in
+ a javascript writeln
+ html_encode -> return a string ready for being used in
+ a html attribute
+ force_register -> if is true will turn on the &bodytag()
+ $forcereg arg
+ body_title -> alternate text to use instead of $title
+ in the title box that appears, this text
+ is not auto translated like the $title is
+ frameset -> if true will start with a <frameset>
+ rather than <body>
+ no_title -> if true the title bar won't be shown
+ skip_phases -> hash ref of
+ 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
@@ -3057,19 +3490,49 @@ Inputs: $title - optional title for the
sub start_page {
my ($title,$head_extra,$args) = @_;
+ #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
my %head_args;
- if (defined($args->{'redirect'})) {
- $head_args{'redirect'} = $args->{'redirect'};
+ foreach my $arg ('redirect','force_register','domain','function',
+ 'bgcolor') {
+ if (defined($args->{$arg})) {
+ $head_args{$arg} = $args->{$arg};
+ }
}
- return
- &Apache::lonxml::xmlbegin().
- &headtag($title,$head_extra,\%head_args).&endheadtag().
- &bodytag($title, $args->{'function'}, $args->{'add_entries'},
- $args->{'only_body'},
- undef,undef,undef,$args->{'no_nav_bar'});
+ $env{'internal.start_page'}++;
+ my $result;
+ if (! exists($args->{'skip_phases'}{'head'}) ) {
+ $result.=
+ &xml_begin().
+ &headtag($title,$head_extra,\%head_args).&endheadtag();
+ }
+
+ if (! exists($args->{'skip_phases'}{'body'}) ) {
+ if ($args->{'frameset'}) {
+ my $attr_string = &make_attr_string($args->{'force_register'},
+ $args->{'add_entries'});
+ $result .= "\n<frameset $attr_string>\n";
+ } else {
+ $result .=
+ &bodytag($title,
+ $args->{'function'}, $args->{'add_entries'},
+ $args->{'only_body'}, $args->{'domain'},
+ $args->{'force_register'}, $args->{'body_title'},
+ $args->{'no_nav_bar'}, $args->{'bgcolor'},
+ $args->{'no_title'}, $args->{'no_inline_link'});
+ }
+ }
+
+ if ($args->{'js_ready'}) {
+ $result = &js_ready($result);
+ }
+ if ($args->{'html_encode'}) {
+ $result = &html_encode($result);
+ }
+ return $result;
}
+
=pod
=over 4
@@ -3078,15 +3541,134 @@ sub start_page {
Returns a complete </body></html> section for LON-CAPA web pages.
-Inputs: None
-
+Inputs: $args - additional optional args supported are:
+ js_ready -> return a string ready for being used in
+ a javascript writeln
+ html_encode -> return a string ready for being used in
+ a html attribute
+ frameset -> if true will start with a <frameset>
+ rather than <body>
=back
=cut
sub end_page {
- return &endbodytag."\n</html>";
+ my ($args) = @_;
+ $env{'internal.end_page'}++;
+ my $result;
+ if ($args->{'discussion'}) {
+ my ($target,$parser);
+ if (ref($args->{'discussion'})) {
+ ($target,$parser) =($args->{'discussion'}{'target'},
+ $args->{'discussion'}{'parser'});
+ }
+ $result .= &Apache::lonxml::xmlend($target,$parser);
+ }
+
+ if ($args->{'frameset'}) {
+ $result .= '</frameset>';
+ } else {
+ $result .= &endbodytag();
+ }
+ $result .= "\n</html>";
+
+ if ($args->{'js_ready'}) {
+ $result = &js_ready($result);
+ }
+
+ if ($args->{'html_encode'}) {
+ $result = &html_encode($result);
+ }
+
+ return $result;
+}
+
+sub html_encode {
+ my ($result) = @_;
+
+ $result = &HTML::Entities::encode($result,'<>&"');
+
+ return $result;
+}
+sub js_ready {
+ my ($result) = @_;
+
+ $result =~ s/[\n\r]/ /xmsg;
+ $result =~ s/\\/\\\\/xmsg;
+ $result =~ s/'/\\'/xmsg;
+ $result =~ s{</}{<\\/}xmsg;
+
+ return $result;
+}
+
+sub validate_page {
+ if ( exists($env{'internal.start_page'})
+ && $env{'internal.start_page'} > 1) {
+ &Apache::lonnet::logthis('start_page called multiple times '.
+ $env{'internal.start_page'}.' '.
+ $ENV{'request.filename'});
+ }
+ if ( exists($env{'internal.end_page'})
+ && $env{'internal.end_page'} > 1) {
+ &Apache::lonnet::logthis('end_page called multiple times '.
+ $env{'internal.end_page'}.' '.
+ $env{'request.filename'});
+ }
+ if ( exists($env{'internal.start_page'})
+ && ! exists($env{'internal.end_page'})) {
+ &Apache::lonnet::logthis('start_page called without end_page '.
+ $env{'request.filename'});
+ }
+ if ( ! exists($env{'internal.start_page'})
+ && exists($env{'internal.end_page'})) {
+ &Apache::lonnet::logthis('end_page called without start_page'.
+ $env{'request.filename'});
+ }
}
+
+sub simple_error_page {
+ my ($r,$title,$msg) = @_;
+ my $page =
+ &Apache::loncommon::start_page($title).
+ &mt($msg).
+ &Apache::loncommon::end_page();
+ if (ref($r)) {
+ $r->print($page);
+ return;
+ }
+ 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>';
+ }
+
+ sub start_data_table_header_row {
+ return '<tr class="LC_header_row">';
+ }
+
+ sub end_data_table_header_row {
+ return '</tr>';
+ }
+}
+
###############################################
=pod
@@ -3178,32 +3760,40 @@ sub check_user_status {
Determines all the sections for a course including
sections with students and sections containing other roles.
-Incoming parameters: domain, course number, reference to
-section hash (keys to be section/group IDs), reference to
-array containing roles for which sections should be gathered
-(optional). If the fourth argument is undefined, sections
-are gathered for any role.
+Incoming parameters: domain, course number,
+reference to array containing roles for which sections should
+be gathered (optional). If the third argument is undefined,
+sections are gathered for any role.
-Returns number of sections.
+Returns section hash (keys are section IDs, values are
+number of users in each section), subject to the
+optional roles filter.
=cut
###############################################
sub get_sections {
- my ($cdom,$cnum,$sectioncount,$possible_roles) = @_;
- if (!($cdom && $cnum)) { return 0; }
- my $numsections = 0;
+ my ($cdom,$cnum,$possible_roles) = @_;
+ if (!defined($cdom) || !defined($cnum)) {
+ my $cid = $env{'request.course.id'};
- if (!defined($possible_roles) || (grep/^st$/,@$possible_roles)) {
+ return if (!defined($cid));
+
+ $cdom = $env{'course.'.$cid.'.domain'};
+ $cnum = $env{'course.'.$cid.'.num'};
+ }
+
+ my %sectioncount;
+
+ if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
my $sec_index = &Apache::loncoursedata::CL_SECTION();
my $status_index = &Apache::loncoursedata::CL_STATUS();
- while (my ($student,$data) = each %$classlist) {
+ while (my ($student,$data) = each(%$classlist)) {
my ($section,$status) = ($data->[$sec_index],
$data->[$status_index]);
unless ($section eq '-1' || $section =~ /^\s*$/) {
- if (!defined($$sectioncount{$section})) { $numsections++; }
- $$sectioncount{$section}++;
+ $sectioncount{$section}++;
}
}
}
@@ -3219,10 +3809,9 @@ sub get_sections {
}
if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
if (!defined($section) || $section eq '-1') { next; }
- if (!defined($$sectioncount{$section})) { $numsections++; }
- $$sectioncount{$section}++;
+ $sectioncount{$section}++;
}
- return $numsections;
+ return %sectioncount;
}
###############################################
@@ -3234,10 +3823,9 @@ sub get_sections {
Retrieve information about groups in a course,
Input:
-1. Reference to hash to populate with group information.
-2. Optional course domain
-3. Optional course number
-4. Optional group name
+1. Optional course domain
+2. Optional course number
+3. Optional group name
Course domain and number will be taken from user's
environment if not supplied. Optional group name will'
@@ -3245,39 +3833,37 @@ be passed to lonnet::get_coursegroups()
use in the call to the dump function.
Output
-Returns number of groups in the course (subject to the
-optional group name filter).
-
-Side effects:
-Populates the referenced curr_groups hash, with key,
-value pairs. Keys are group names, corresponding values
+Returns hash of groups in the course (subject to the
+optional group name filter). In the hash, the keys are
+group names, and their corresponding values
are scalars containing group information in XML. This
-can be sent to &get_group_settings() to be parsed.
+can be sent to &get_group_settings() to be parsed.
+Side effects:
+None.
=cut
###############################################
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;
}
###############################################
@@ -3329,6 +3915,7 @@ sub get_group_settings {
} elsif ($entry eq 'role') {
if ($tool eq 'autosec') {
$role = $token->[2]{id};
+ @{$content{$tool}{$role}} = ();
}
} else {
my $value=$parser->get_text('/'.$entry);
@@ -3338,7 +3925,7 @@ sub get_group_settings {
$content{$tool}{$function} = $value;
}
} elsif ($entry eq 'groupname') {
- $content{$entry}=&Apache::lonnet::unescape($value);
+ $content{$entry}=&unescape($value);
} elsif (($entry eq 'roles') || ($entry eq 'types') ||
($entry eq 'sectionpick') || ($entry eq 'defpriv')) {
push(@{$content{$entry}},$value);
@@ -3505,78 +4092,6 @@ sub get_user_info {
return;
}
-###############################################
-
-sub get_posted_cgi {
- my $r=shift;
-
- my $buffer;
- if ($r->header_in('Content-length')) {
- $r->read($buffer,$r->header_in('Content-length'),0);
- }
- unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
- my @pairs=split(/&/,$buffer);
- my $pair;
- foreach $pair (@pairs) {
- my ($name,$value) = split(/=/,$pair);
- $value =~ tr/+/ /;
- $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
- $name =~ tr/+/ /;
- $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
- &add_to_env("form.$name",$value);
- }
- } else {
- my $contentsep=$1;
- my @lines = split (/\n/,$buffer);
- my $name='';
- my $value='';
- my $fname='';
- my $fmime='';
- my $i;
- for ($i=0;$i<=$#lines;$i++) {
- if ($lines[$i]=~/^$contentsep/) {
- if ($name) {
- chomp($value);
- if ($fname) {
- $env{"form.$name.filename"}=$fname;
- $env{"form.$name.mimetype"}=$fmime;
- } else {
- $value=~s/\s+$//s;
- }
- &add_to_env("form.$name",$value);
- }
- if ($i<$#lines) {
- $i++;
- $lines[$i]=~
- /Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i;
- $name=$1;
- $value='';
- if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) {
- $fname=$1;
- if
- ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) {
- $fmime=$1;
- $i++;
- } else {
- $fmime='';
- }
- } else {
- $fname='';
- $fmime='';
- }
- $i++;
- }
- } else {
- $value.=$lines[$i]."\n";
- }
- }
- }
- $env{'request.method'}=$ENV{'REQUEST_METHOD'};
- $r->method_number(M_GET);
- $r->method('GET');
- $r->headers_in->unset('Content-length');
-}
-
=pod
=item * get_unprocessed_cgi($query,$possible_names)
@@ -3595,9 +4110,9 @@ 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(/=/,$_);
- $name = &Apache::lonnet::unescape($name);
+ foreach my $pair (split(/&/,$query)) {
+ my ($name, $value) = split(/=/,$pair);
+ $name = &unescape($name);
if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
@@ -3813,8 +4328,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;
@@ -3822,8 +4336,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;
@@ -3917,14 +4430,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>');
@@ -3957,17 +4470,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++;
@@ -4228,9 +4741,9 @@ sub DrawBarGraph {
$Title = '' if (! defined($Title));
$xlabel = '' if (! defined($xlabel));
$ylabel = '' if (! defined($ylabel));
- $ValuesHash{$id.'.title'} = &Apache::lonnet::escape($Title);
- $ValuesHash{$id.'.xlabel'} = &Apache::lonnet::escape($xlabel);
- $ValuesHash{$id.'.ylabel'} = &Apache::lonnet::escape($ylabel);
+ $ValuesHash{$id.'.title'} = &escape($Title);
+ $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
+ $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
$ValuesHash{$id.'.y_max_value'} = $Max;
$ValuesHash{$id.'.NumBars'} = $NumBars;
$ValuesHash{$id.'.NumSets'} = $NumSets;
@@ -4310,9 +4823,9 @@ sub DrawXYGraph {
$ylabel = '' if (! defined($ylabel));
my %ValuesHash =
(
- $id.'.title' => &Apache::lonnet::escape($Title),
- $id.'.xlabel' => &Apache::lonnet::escape($xlabel),
- $id.'.ylabel' => &Apache::lonnet::escape($ylabel),
+ $id.'.title' => &escape($Title),
+ $id.'.xlabel' => &escape($xlabel),
+ $id.'.ylabel' => &escape($ylabel),
$id.'.y_max_value'=> $Max,
$id.'.labels' => join(',',@$Xlabels),
$id.'.PlotType' => 'XY',
@@ -4407,9 +4920,9 @@ sub DrawXYYGraph {
$ylabel = '' if (! defined($ylabel));
my %ValuesHash =
(
- $id.'.title' => &Apache::lonnet::escape($Title),
- $id.'.xlabel' => &Apache::lonnet::escape($xlabel),
- $id.'.ylabel' => &Apache::lonnet::escape($ylabel),
+ $id.'.title' => &escape($Title),
+ $id.'.xlabel' => &escape($xlabel),
+ $id.'.ylabel' => &escape($ylabel),
$id.'.labels' => join(',',@$Xlabels),
$id.'.PlotType' => 'XY',
$id.'.NumSets' => 2,
@@ -4481,7 +4994,7 @@ Inputs:
sub chartlink {
my ($linktext, $sname, $sdomain) = @_;
my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
- '&SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).
+ '&SelectedStudent='.&escape($sname.':'.$sdomain).
'&chartoutputmode='.HTML::Entities::encode('html, with all links').
'">'.$linktext.'</a>';
}
@@ -4511,6 +5024,7 @@ a hash ref describing the data to be sto
'chartoutputmode' => 'scalar',
'chartoutputdata' => 'scalar',
'Section' => 'array',
+ 'Group' => 'array',
'StudentData' => 'array',
'Maps' => 'array');
@@ -4544,11 +5058,11 @@ sub store_course_settings {
if (ref($env{'form.'.$setting})) {
$stored_form = join(',',
map {
- &Apache::lonnet::escape($_);
+ &escape($_);
} sort(@{$env{'form.'.$setting}}));
} else {
$stored_form =
- &Apache::lonnet::escape($env{'form.'.$setting});
+ &escape($env{'form.'.$setting});
}
# Determine if the array contents are the same.
if ($stored_form ne $env{$envname}) {
@@ -4582,7 +5096,7 @@ sub restore_course_settings {
} elsif ($type eq 'array') {
$env{'form.'.$setting} = [
map {
- &Apache::lonnet::unescape($_);
+ &unescape($_);
} split(',',$env{$envname})
];
}
@@ -4655,7 +5169,7 @@ sub escape_double {
sub escape_url {
my ($url) = @_;
my @urlslices = split(/\//, $url,-1);
- my $lastitem = &Apache::lonnet::escape(pop(@urlslices));
+ my $lastitem = &escape(pop(@urlslices));
return join('/',@urlslices).'/'.$lastitem;
}
=pod