|
version 1.345, 2006/04/21 20:45:42
|
version 1.370, 2006/05/12 02:17:50
|
|
Line 64 use HTML::Entities;
|
Line 64 use HTML::Entities;
|
| use Apache::lonhtmlcommon(); |
use Apache::lonhtmlcommon(); |
| use Apache::loncoursedata(); |
use Apache::loncoursedata(); |
| use Apache::lontexconvert(); |
use Apache::lontexconvert(); |
| |
use LONCAPA; |
| |
|
| my $readit; |
my $readit; |
| |
|
|
Line 76 my %language;
|
Line 77 my %language;
|
| my %supported_language; |
my %supported_language; |
| my %cprtag; |
my %cprtag; |
| my %scprtag; |
my %scprtag; |
| my %fe; my %fd; |
my %fe; my %fd; my %fm; |
| my %category_extensions; |
my %category_extensions; |
| |
|
| # ---------------------------------------------- Designs |
# ---------------------------------------------- Designs |
|
Line 107 BEGIN {
|
Line 108 BEGIN {
|
| my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}. |
my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}. |
| '/language.tab'; |
'/language.tab'; |
| if ( open(my $fh,"<$langtabfile") ) { |
if ( open(my $fh,"<$langtabfile") ) { |
| while (<$fh>) { |
while (my $line = <$fh>) { |
| next if /^\#/; |
next if ($line=~/^\#/); |
| chomp; |
chomp($line); |
| my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_)); |
my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line)); |
| $language{$key}=$val.' - '.$enc; |
$language{$key}=$val.' - '.$enc; |
| if ($sup) { |
if ($sup) { |
| $supported_language{$key}=$sup; |
$supported_language{$key}=$sup; |
|
Line 124 BEGIN {
|
Line 125 BEGIN {
|
| my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. |
my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. |
| '/copyright.tab'; |
'/copyright.tab'; |
| if ( open (my $fh,"<$copyrightfile") ) { |
if ( open (my $fh,"<$copyrightfile") ) { |
| while (<$fh>) { |
while (my $line = <$fh>) { |
| next if /^\#/; |
next if ($line=~/^\#/); |
| chomp; |
chomp($line); |
| my ($key,$val)=(split(/\s+/,$_,2)); |
my ($key,$val)=(split(/\s+/,$line,2)); |
| $cprtag{$key}=$val; |
$cprtag{$key}=$val; |
| } |
} |
| close($fh); |
close($fh); |
| } |
} |
| } |
} |
| # ------------------------------------------------------------------ source copyrights |
# ----------------------------------------------------------- source copyrights |
| { |
{ |
| my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. |
my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. |
| '/source_copyright.tab'; |
'/source_copyright.tab'; |
| if ( open (my $fh,"<$sourcecopyrightfile") ) { |
if ( open (my $fh,"<$sourcecopyrightfile") ) { |
| while (<$fh>) { |
while (my $line = <$fh>) { |
| next if /^\#/; |
next if ($line =~ /^\#/); |
| chomp; |
chomp($line); |
| my ($key,$val)=(split(/\s+/,$_,2)); |
my ($key,$val)=(split(/\s+/,$line,2)); |
| $scprtag{$key}=$val; |
$scprtag{$key}=$val; |
| } |
} |
| close($fh); |
close($fh); |
|
Line 159 BEGIN {
|
Line 160 BEGIN {
|
| { |
{ |
| my $designfile = $designdir.'/'.$filename; |
my $designfile = $designdir.'/'.$filename; |
| if ( open (my $fh,"<$designfile") ) { |
if ( open (my $fh,"<$designfile") ) { |
| while (<$fh>) { |
while (my $line = <$fh>) { |
| next if /^\#/; |
next if ($line =~ /^\#/); |
| chomp; |
chomp($line); |
| my ($key,$val)=(split(/\=/,$_)); |
my ($key,$val)=(split(/\=/,$line)); |
| if ($val) { $designhash{$domain.'.'.$key}=$val; } |
if ($val) { $designhash{$domain.'.'.$key}=$val; } |
| } |
} |
| close($fh); |
close($fh); |
|
Line 178 BEGIN {
|
Line 179 BEGIN {
|
| my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}. |
my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}. |
| '/filecategories.tab'; |
'/filecategories.tab'; |
| if ( open (my $fh,"<$categoryfile") ) { |
if ( open (my $fh,"<$categoryfile") ) { |
| while (<$fh>) { |
while (my $line = <$fh>) { |
| next if /^\#/; |
next if ($line =~ /^\#/); |
| chomp; |
chomp($line); |
| my ($extension,$category)=(split(/\s+/,$_,2)); |
my ($extension,$category)=(split(/\s+/,$line,2)); |
| push @{$category_extensions{lc($category)}},$extension; |
push @{$category_extensions{lc($category)}},$extension; |
| } |
} |
| close($fh); |
close($fh); |
|
Line 193 BEGIN {
|
Line 194 BEGIN {
|
| my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}. |
my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}. |
| '/filetypes.tab'; |
'/filetypes.tab'; |
| if ( open (my $fh,"<$typesfile") ) { |
if ( open (my $fh,"<$typesfile") ) { |
| while (<$fh>) { |
while (my $line = <$fh>) { |
| next if (/^\#/); |
next if ($line =~ /^\#/); |
| chomp; |
chomp($line); |
| my ($ending,$emb,$descr)=split(/\s+/,$_,3); |
my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4); |
| if ($descr ne '') { |
if ($descr ne '') { |
| $fe{$ending}=lc($emb); |
$fe{$ending}=lc($emb); |
| $fd{$ending}=$descr; |
$fd{$ending}=$descr; |
| |
if ($mime ne 'unk') { $fm{$ending}=$mime; } |
| } |
} |
| } |
} |
| close($fh); |
close($fh); |
|
Line 706 sub help_open_menu {
|
Line 708 sub help_open_menu {
|
| my $origurl = $ENV{'REQUEST_URI'}; |
my $origurl = $ENV{'REQUEST_URI'}; |
| $origurl=~s|^/~|/priv/|; |
$origurl=~s|^/~|/priv/|; |
| my $timestamp = time; |
my $timestamp = time; |
| foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) { |
foreach my $datum (\$color,\$function,\$topic,\$component_help,\$faq, |
| $$_ = &Apache::lonnet::escape($$_); |
\$bug,\$origurl) { |
| |
$$datum = &escape($$datum); |
| } |
} |
| if (!$stayOnPage) { |
if (!$stayOnPage) { |
| $link = "javascript:helpMenu('open')"; |
$link = "javascript:helpMenu('open')"; |
|
Line 773 ENDTEMPLATE
|
Line 776 ENDTEMPLATE
|
| $width,$height).' '.$template; |
$width,$height).' '.$template; |
| } else { |
} else { |
| my $help_text; |
my $help_text; |
| $help_text=&Apache::lonnet::unescape($topic); |
$help_text=&unescape($topic); |
| $template='<table><tr><td>'. |
$template='<table><tr><td>'. |
| &help_open_topic($component_help,$help_text,$stayOnPage, |
&help_open_topic($component_help,$help_text,$stayOnPage, |
| $width,$height).'</td><td>'.$template. |
$width,$height).'</td><td>'.$template. |
|
Line 801 sub help_open_bug {
|
Line 804 sub help_open_bug {
|
| my $link=''; |
my $link=''; |
| my $template=''; |
my $template=''; |
| my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='. |
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) |
if (!$stayOnPage) |
| { |
{ |
| $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; |
$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; |
|
Line 1152 sub get_domains {
|
Line 1155 sub get_domains {
|
| # The code below was stolen from "The Perl Cookbook", p 102, 1st ed. |
# The code below was stolen from "The Perl Cookbook", p 102, 1st ed. |
| my @domains; |
my @domains; |
| my %seen; |
my %seen; |
| foreach (sort values(%Apache::lonnet::hostdom)) { |
foreach my $dom (sort(values(%Apache::lonnet::hostdom))) { |
| push (@domains,$_) unless $seen{$_}++; |
push(@domains,$dom) unless $seen{$dom}++; |
| } |
} |
| return @domains; |
return @domains; |
| } |
} |
|
Line 1207 sub multiple_select_form {
|
Line 1210 sub multiple_select_form {
|
| my @order = ref($order) ? @$order |
my @order = ref($order) ? @$order |
| : sort(keys(%$hash)); |
: sort(keys(%$hash)); |
| foreach my $key (@order) { |
foreach my $key (@order) { |
| $output.='<option value="'.$key.'" '; |
$output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" '; |
| $output.='selected="selected" ' if ($selected{$key}); |
$output.='selected="selected" ' if ($selected{$key}); |
| $output.='>'.$hash->{$key}."</option>\n"; |
$output.='>'.$hash->{$key}."</option>\n"; |
| } |
} |
|
Line 1237 sub select_form {
|
Line 1240 sub select_form {
|
| } else { |
} else { |
| @keys=sort(keys(%hash)); |
@keys=sort(keys(%hash)); |
| } |
} |
| foreach (@keys) { |
foreach my $key (@keys) { |
| $selectform.="<option value=\"$_\" ". |
$selectform.= |
| ($_ eq $def ? 'selected="selected" ' : ''). |
'<option value="'.&HTML::Entities::encode($key,'"<>&').'" '. |
| ">".&mt($hash{$_})."</option>\n"; |
($key eq $def ? 'selected="selected" ' : ''). |
| |
">".&mt($hash{$key})."</option>\n"; |
| } |
} |
| $selectform.="</select>"; |
$selectform.="</select>"; |
| return $selectform; |
return $selectform; |
|
Line 1304 sub select_dom_form {
|
Line 1308 sub select_dom_form {
|
| my @domains = get_domains(); |
my @domains = get_domains(); |
| if ($includeempty) { @domains=('',@domains); } |
if ($includeempty) { @domains=('',@domains); } |
| my $selectdomain = "<select name=\"$name\" size=\"1\">\n"; |
my $selectdomain = "<select name=\"$name\" size=\"1\">\n"; |
| foreach (@domains) { |
foreach my $dom (@domains) { |
| $selectdomain.="<option value=\"$_\" ". |
$selectdomain.="<option value=\"$dom\" ". |
| ($_ eq $defdom ? 'selected="selected" ' : ''). |
($dom eq $defdom ? 'selected="selected" ' : ''). |
| ">$_</option>\n"; |
">$dom</option>\n"; |
| } |
} |
| $selectdomain.="</select>"; |
$selectdomain.="</select>"; |
| return $selectdomain; |
return $selectdomain; |
|
Line 1329 given $domain.
|
Line 1333 given $domain.
|
| sub get_library_servers { |
sub get_library_servers { |
| my $domain = shift; |
my $domain = shift; |
| my %library_servers; |
my %library_servers; |
| foreach (keys(%Apache::lonnet::libserv)) { |
foreach my $hostid (keys(%Apache::lonnet::libserv)) { |
| if ($Apache::lonnet::hostdom{$_} eq $domain) { |
if ($Apache::lonnet::hostdom{$hostid} eq $domain) { |
| $library_servers{$_} = $Apache::lonnet::hostname{$_}; |
$library_servers{$hostid} = $Apache::lonnet::hostname{$hostid}; |
| } |
} |
| } |
} |
| return %library_servers; |
return %library_servers; |
|
Line 1353 sub home_server_option_list {
|
Line 1357 sub home_server_option_list {
|
| my $domain = shift; |
my $domain = shift; |
| my %servers = &get_library_servers($domain); |
my %servers = &get_library_servers($domain); |
| my $result = ''; |
my $result = ''; |
| foreach (sort keys(%servers)) { |
foreach my $hostid (sort(keys(%servers))) { |
| $result.= |
$result.= |
| '<option value="'.$_.'">'.$_.' '.$servers{$_}."</option>\n"; |
'<option value="'.$hostid.'">'. |
| |
$hostid.' '.$servers{$hostid}."</option>\n"; |
| } |
} |
| return $result; |
return $result; |
| } |
} |
|
Line 1845 sub initialize_keywords {
|
Line 1850 sub initialize_keywords {
|
| } |
} |
| untie %thesaurus_db; |
untie %thesaurus_db; |
| # Remove special values from %Keywords. |
# Remove special values from %Keywords. |
| foreach ('total.count','average.count') { |
foreach my $value ('total.count','average.count') { |
| delete($Keywords{$_}) if (exists($Keywords{$_})); |
delete($Keywords{$value}) if (exists($Keywords{$value})); |
| } |
} |
| return 1; |
return 1; |
| } |
} |
|
Line 1902 sub get_related_words {
|
Line 1907 sub get_related_words {
|
| } |
} |
| my @Words=(); |
my @Words=(); |
| if (exists($thesaurus_db{$keyword})) { |
if (exists($thesaurus_db{$keyword})) { |
| $_ = $thesaurus_db{$keyword}; |
# The first element is the number of times |
| (undef,@Words) = split/:/; # The first element is the number of times |
# the word appears. We do not need it now. |
| # the word appears. We do not need it now. |
(undef,@Words) = (split(/:/,$thesaurus_db{$keyword})); |
| for (my $i=0;$i<=$#Words;$i++) { |
for (my $i=0;$i<=$#Words;$i++) { |
| ($Words[$i],undef)= split/\,/,$Words[$i]; |
($Words[$i],undef)= split(/\,/,$Words[$i]); |
| } |
} |
| } |
} |
| untie %thesaurus_db; |
untie %thesaurus_db; |
|
Line 1947 sub plainname {
|
Line 1952 sub plainname {
|
| $name=~s/^\s+//; |
$name=~s/^\s+//; |
| $name=~s/\s+$//; |
$name=~s/\s+$//; |
| $name=~s/\s+/ /g; |
$name=~s/\s+/ /g; |
| if ($name !~ /\S/) { $name=$uname.'@'.$udom; } |
if ($name !~ /\S/) { $name=$uname.':'.$udom; } |
| return $name; |
return $name; |
| } |
} |
| |
|
|
Line 2020 sub screenname {
|
Line 2025 sub screenname {
|
| # ------------------------------------------------------------- Message Wrapper |
# ------------------------------------------------------------- Message Wrapper |
| |
|
| sub messagewrapper { |
sub messagewrapper { |
| my ($link,$username,$domain)=@_; |
my ($link,$username,$domain,$subject,$text)=@_; |
| return |
return |
| '<a href="/adm/email?compose=individual&'. |
'<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>'; |
'title="'.&mt('Send message').'">'.$link.'</a>'; |
| } |
} |
| # --------------------------------------------------------------- Notes Wrapper |
# --------------------------------------------------------------- Notes Wrapper |
|
Line 2183 category
|
Line 2189 category
|
| =cut |
=cut |
| |
|
| sub filecategorytypes { |
sub filecategorytypes { |
| return @{$category_extensions{lc($_[0])}}; |
my ($cat) = @_; |
| |
return @{$category_extensions{lc($cat)}}; |
| } |
} |
| |
|
| =pod |
=pod |
|
Line 2198 sub fileembstyle {
|
Line 2205 sub fileembstyle {
|
| return $fe{lc(shift(@_))}; |
return $fe{lc(shift(@_))}; |
| } |
} |
| |
|
| |
sub filemimetype { |
| |
return $fm{lc(shift(@_))}; |
| |
} |
| |
|
| |
|
| sub filecategoryselect { |
sub filecategoryselect { |
| my ($name,$value)=@_; |
my ($name,$value)=@_; |
|
Line 2254 sub fileextensions {
|
Line 2265 sub fileextensions {
|
| |
|
| sub display_languages { |
sub display_languages { |
| my %languages=(); |
my %languages=(); |
| foreach (&preferred_languages()) { |
foreach my $lang (&preferred_languages()) { |
| $languages{$_}=1; |
$languages{$lang}=1; |
| } |
} |
| &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']); |
&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']); |
| if ($env{'form.displaylanguage'}) { |
if ($env{'form.displaylanguage'}) { |
| foreach (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) { |
foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) { |
| $languages{$_}=1; |
$languages{$lang}=1; |
| } |
} |
| } |
} |
| return %languages; |
return %languages; |
|
Line 2295 sub preferred_languages {
|
Line 2306 sub preferred_languages {
|
| } |
} |
| # turn "en-ca" into "en-ca,en" |
# turn "en-ca" into "en-ca,en" |
| my @genlanguages; |
my @genlanguages; |
| foreach (@languages) { |
foreach my $lang (@languages) { |
| unless ($_=~/\w/) { next; } |
unless ($lang=~/\w/) { next; } |
| push (@genlanguages,$_); |
push (@genlanguages,$lang); |
| if ($_=~/(\-|\_)/) { |
if ($lang=~/(\-|\_)/) { |
| push (@genlanguages,(split(/(\-|\_)/,$_))[0]); |
push(@genlanguages,(split(/(\-|\_)/,$lang))[0]); |
| } |
} |
| } |
} |
| return @genlanguages; |
return @genlanguages; |
|
Line 2355 sub get_previous_attempt {
|
Line 2366 sub get_previous_attempt {
|
| my %lasthash=(); |
my %lasthash=(); |
| my $version; |
my $version; |
| for ($version=1;$version<=$returnhash{'version'};$version++) { |
for ($version=1;$version<=$returnhash{'version'};$version++) { |
| foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { |
foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) { |
| $lasthash{$_}=$returnhash{$version.':'.$_}; |
$lasthash{$key}=$returnhash{$version.':'.$key}; |
| } |
} |
| } |
} |
| $prevattempts='<table border="0" width="100%"><tr><td bgcolor="#777777">'; |
$prevattempts='<table border="0" width="100%"><tr><td bgcolor="#777777">'; |
| $prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>'; |
$prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>'; |
| foreach (sort(keys %lasthash)) { |
foreach my $key (sort(keys(%lasthash))) { |
| my ($ign,@parts) = split(/\./,$_); |
my ($ign,@parts) = split(/\./,$key); |
| if ($#parts > 0) { |
if ($#parts > 0) { |
| my $data=$parts[-1]; |
my $data=$parts[-1]; |
| pop(@parts); |
pop(@parts); |
|
Line 2378 sub get_previous_attempt {
|
Line 2389 sub get_previous_attempt {
|
| if ($getattempt eq '') { |
if ($getattempt eq '') { |
| for ($version=1;$version<=$returnhash{'version'};$version++) { |
for ($version=1;$version<=$returnhash{'version'};$version++) { |
| $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>'; |
$prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>'; |
| foreach (sort(keys %lasthash)) { |
foreach my $key (sort(keys(%lasthash))) { |
| my $value; |
my $value; |
| if ($_ =~ /timestamp/) { |
if ($key =~ /timestamp/) { |
| $value=scalar(localtime($returnhash{$version.':'.$_})); |
$value=scalar(localtime($returnhash{$version.':'.$key})); |
| } else { |
} 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>'; |
$prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Current</td>'; |
| foreach (sort(keys %lasthash)) { |
foreach my $key (sort(keys(%lasthash))) { |
| my $value; |
my $value; |
| if ($_ =~ /timestamp/) { |
if ($key =~ /timestamp/) { |
| $value=scalar(localtime($lasthash{$_})); |
$value=scalar(localtime($lasthash{$key})); |
| } else { |
} else { |
| $value=$lasthash{$_}; |
$value=$lasthash{$key}; |
| } |
} |
| $value=&Apache::lonnet::unescape($value); |
$value=&unescape($value); |
| if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)} |
if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)} |
| $prevattempts.='<td>'.$value.' </td>'; |
$prevattempts.='<td>'.$value.' </td>'; |
| } |
} |
| $prevattempts.='</tr></table></td></tr></table>'; |
$prevattempts.='</tr></table></td></tr></table>'; |
|
Line 2430 sub relative_to_absolute {
|
Line 2441 sub relative_to_absolute {
|
| } |
} |
| } |
} |
| $thisdir=~s-/[^/]*$--; |
$thisdir=~s-/[^/]*$--; |
| foreach (@rlinks) { |
foreach my $link (@rlinks) { |
| unless (($_=~/^http:\/\//i) || |
unless (($link=~/^http:\/\//i) || |
| ($_=~/^\//) || |
($link=~/^\//) || |
| ($_=~/^javascript:/i) || |
($link=~/^javascript:/i) || |
| ($_=~/^mailto:/i) || |
($link=~/^mailto:/i) || |
| ($_=~/^\#/)) { |
($link=~/^\#/)) { |
| my $newlocation=&Apache::lonnet::hreflocation($thisdir,$_); |
my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link); |
| $output=~s/(\"|\'|\=\s*)$_(\"|\'|\s|\>)/$1$newlocation$2/; |
$output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/; |
| } |
} |
| } |
} |
| # -------------------------------------------------- Deal with Applet codebases |
# -------------------------------------------------- Deal with Applet codebases |
|
Line 2519 sub submlink {
|
Line 2530 sub submlink {
|
| if (!$symb) { $symb=$cursymb; } |
if (!$symb) { $symb=$cursymb; } |
| } |
} |
| if (!$symb) { $symb=&Apache::lonnet::symbread(); } |
if (!$symb) { $symb=&Apache::lonnet::symbread(); } |
| $symb=&Apache::lonnet::escape($symb); |
$symb=&escape($symb); |
| if ($target) { $target="target=\"$target\""; } |
if ($target) { $target="target=\"$target\""; } |
| return '<a href="/adm/grades?&command=submission&'. |
return '<a href="/adm/grades?&command=submission&'. |
| 'symb='.$symb.'&student='.$uname. |
'symb='.$symb.'&student='.$uname. |
|
Line 2565 sub pprmlink {
|
Line 2576 sub pprmlink {
|
| if (!$symb) { $symb=$cursymb; } |
if (!$symb) { $symb=$cursymb; } |
| } |
} |
| if (!$symb) { $symb=&Apache::lonnet::symbread(); } |
if (!$symb) { $symb=&Apache::lonnet::symbread(); } |
| $symb=&Apache::lonnet::escape($symb); |
$symb=&escape($symb); |
| if ($target) { $target="target=\"$target\""; } |
if ($target) { $target="target=\"$target\""; } |
| return '<a href="/adm/parmset?&command=set&'. |
return '<a href="/adm/parmset?&command=set&'. |
| 'symb='.$symb.'&uname='.$uname. |
'symb='.$symb.'&uname='.$uname. |
|
Line 2595 sub timehash {
|
Line 2606 sub timehash {
|
| 'dlsav' => $ltime[8] ); |
'dlsav' => $ltime[8] ); |
| } |
} |
| |
|
| |
sub utc_string { |
| |
my ($date)=@_; |
| |
my @utctime=gmtime($date); |
| |
my $year=$utctime[5]+1900; |
| |
my $month=$utctime[4]+1; |
| |
return "$year$month$utctime[3]T$utctime[2]$utctime[1]$utctime[0]Z"; |
| |
} |
| |
|
| sub maketime { |
sub maketime { |
| my %th=@_; |
my %th=@_; |
| return POSIX::mktime( |
return POSIX::mktime( |
|
Line 2605 sub maketime {
|
Line 2624 sub maketime {
|
| ######################################### |
######################################### |
| |
|
| sub findallcourses { |
sub findallcourses { |
| my %courses=(); |
my ($roles) = @_; |
| |
my %roles; |
| |
if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; } |
| |
my %courses; |
| my $now=time; |
my $now=time; |
| foreach (keys %env) { |
foreach my $key (keys(%env)) { |
| if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) { |
if ( $key=~m{^user\.role\.(\w+)\./(\w+)/(\w+)} ) { |
| my ($starttime,$endtime)=$env{$_}; |
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; |
my $active=1; |
| if ($starttime) { |
if ($starttime) { |
| if ($now<$starttime) { $active=0; } |
if ($now<$starttime) { $active=0; } |
|
Line 2617 sub findallcourses {
|
Line 2642 sub findallcourses {
|
| if ($endtime) { |
if ($endtime) { |
| if ($now>$endtime) { $active=0; } |
if ($now>$endtime) { $active=0; } |
| } |
} |
| if ($active) { $courses{$1.'_'.$2}=1; } |
if ($active) { $courses{$domain.'_'.$id}=1; } |
| } |
} |
| } |
} |
| return keys %courses; |
return keys(%courses); |
| } |
} |
| |
|
| ############################################### |
############################################### |
|
Line 2758 Inputs:
|
Line 2783 Inputs:
|
| |
|
| =item * $notitle, if true keep the nav controls, but remove the title bar |
=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 |
=back |
| |
|
|
Line 2770 other decorations will be returned.
|
Line 2798 other decorations will be returned.
|
| |
|
| sub bodytag { |
sub bodytag { |
| my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle, |
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle, |
| $notopbar,$bgcolor,$notitle)=@_; |
$notopbar,$bgcolor,$notitle,$no_inline_link)=@_; |
| |
|
| $title=&mt($title); |
$title=&mt($title); |
| |
|
| $function = &get_users_function() if (!$function); |
$function = &get_users_function() if (!$function); |
| my $img = &designparm($function.'.img',$domain); |
my $img = &designparm($function.'.img',$domain); |
| my $tabbg = &designparm($function.'.tabbg',$domain); |
|
| my $font = &designparm($function.'.font',$domain); |
my $font = &designparm($function.'.font',$domain); |
| my $sidebg = &designparm($function.'.sidebg',$domain); |
|
| my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain); |
my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain); |
| |
|
| my %design = ( 'style' => 'margin-top: 0px', |
my %design = ( 'style' => 'margin-top: 0px', |
|
Line 2790 sub bodytag {
|
Line 2816 sub bodytag {
|
| @$addentries{keys(%design)} = @design{keys(%design)}; |
@$addentries{keys(%design)} = @design{keys(%design)}; |
| |
|
| # role and realm |
# 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 |
| if ($env{'request.course.id'}) { |
if ($env{'request.course.id'}) { |
| $realm= |
$realm = $env{'course.'.$env{'request.course.id'}.'.description'}; |
| $env{'course.'.$env{'request.course.id'}.'.description'}; |
|
| } |
} |
| unless ($realm) { $realm=' '; } |
if (!$realm) { $realm=' '; } |
| # Set messages |
# Set messages |
| my $messages=&domainlogo($domain); |
my $messages=&domainlogo($domain); |
| # Port for miniserver |
# Port for miniserver |
|
Line 2807 sub bodytag {
|
Line 2832 sub bodytag {
|
| my $extra_body_attr = &make_attr_string($forcereg,$addentries); |
my $extra_body_attr = &make_attr_string($forcereg,$addentries); |
| |
|
| # construct main body tag |
# construct main body tag |
| my $bodytag = <<END; |
my $bodytag = "<body $extra_body_attr>". |
| <body $extra_body_attr> |
&Apache::lontexconvert::init_math_support(); |
| END |
|
| |
|
| $bodytag .= &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{'request.state'} eq 'construct' |
| && $env{'environment.remote'} ne 'off' )) { |
&& $env{'environment.remote'} ne 'off' )) { |
|
Line 2827 END
|
Line 2847 END
|
| $bodytag.='<h1>LON-CAPA: '.$title.'</h1>'; |
$bodytag.='<h1>LON-CAPA: '.$title.'</h1>'; |
| } |
} |
| return $bodytag; |
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.firstname'} |
| $env{'environment.middlename'} |
$env{'environment.middlename'} |
| $env{'environment.lastname'} |
$env{'environment.lastname'} |
| $env{'environment.generation'} |
$env{'environment.generation'} |
| </font> |
|
| <br /> |
</div> |
| <font size="2" face="Arial, Helvetica, sans-serif">$role</font> |
<div class="LC_title_bar_role"> |
| <br /> |
$role |
| <font size="2" face="Arial, Helvetica, sans-serif">$realm</font> |
</div> |
| |
<div class="LC_title_bar_realm"> |
| |
$realm |
| |
</div> |
| </td> |
</td> |
| ENDROLE |
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') { |
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)= |
my ($uname,$thisdisfn)= |
| ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|); |
($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|); |
| my $formaction='/priv/'.$uname.'/'.$thisdisfn; |
my $formaction='/priv/'.$uname.'/'.$thisdisfn; |
| $formaction=~s/\/+/\//g; |
$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(); |
|
| |
|
| } |
my $parentpath = ''; |
| $forcereg=1; |
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; |
my $titletable; |
| if (!$notitle) { |
if (!$notitle) { |
| $titletable = |
$titletable = |
| '<table bgcolor="'.$pgbg.'" width="100%" border="0" '. |
'<table id="LC_title_bar">'. |
| 'cellspacing="3" cellpadding="3">'. |
"<tr><td> $titleinfo $dc_info</td>".$roleinfo. |
| '<tr><td bgcolor="'.$tabbg.'">'. |
'</tr></table>'; |
| $titleinfo.'</td>'.$roleinfo.'</tr></table>'; |
|
| } |
} |
| if ($env{'request.state'} eq 'construct') { |
if ($notopbar) { |
| if ($notopbar) { |
$bodytag .= $titletable; |
| $bodytag .= $titletable; |
} else { |
| } else { |
if ($env{'request.state'} eq 'construct') { |
| $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg, |
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg, |
| $titletable); |
$titletable); |
| } |
|
| } else { |
|
| if ($notopbar) { |
|
| $bodytag .= $titletable; |
|
| } else { |
} else { |
| $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg). |
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg). |
| $titletable; |
$titletable; |
| } |
} |
| } |
} |
| return $bodytag; |
return $bodytag; |
|
Line 2904 ENDROLE
|
Line 2941 ENDROLE
|
| # |
# |
| # Top frame rendering, Remote is up |
# Top frame rendering, Remote is up |
| # |
# |
| my $titleinfo = ' <font size="5" face="Arial, Helvetica, sans-serif"><b>'.$title.'</b></font>'; |
|
| if ($customtitle) { |
my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'. |
| $titleinfo = $customtitle; |
$lonhttpdPort.$img.'" alt="'.$function.'" />'; |
| } |
|
| # |
|
| # 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.')'; |
|
| } |
|
| # Explicit link to get inline menu |
# 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) { |
if ($notitle) { |
| return $bodytag; |
return $bodytag; |
| } |
} |
| return(<<ENDBODY); |
return(<<ENDBODY); |
| $bodytag |
$bodytag |
| <table width="100%" cellspacing="0" border="0" cellpadding="0"> |
<table id="LC_title_bar" class="LC_with_remote"> |
| <tr><td bgcolor="$sidebg"> |
<tr><td class="LC_title_bar_role_logo">$upperleft</td> |
| $upperleft</td> |
<td class="LC_title_bar_domain_logo">$messages </td> |
| <td bgcolor="$sidebg" align="right">$messages </td> |
|
| </tr> |
</tr> |
| <tr> |
<tr><td>$titleinfo $dc_info $menu</td> |
| <td rowspan="3" bgcolor="$tabbg"> |
$roleinfo |
| $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> |
| <tr><td bgcolor="$tabbg" align="right"> |
</table> |
| <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 /> |
|
| ENDBODY |
ENDBODY |
| } |
} |
| |
|
|
Line 3041 sub endbodytag {
|
Line 3054 sub endbodytag {
|
| return $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 { |
sub standard_css { |
| my ($function,$domain,$bgcolor) = @_; |
my ($function,$domain,$bgcolor) = @_; |
| my $function = &get_users_function() if (!$function); |
$function = &get_users_function() if (!$function); |
| my $img = &designparm($function.'.img',$domain); |
my $img = &designparm($function.'.img', $domain); |
| my $tabbg = &designparm($function.'.tabbg',$domain); |
my $tabbg = &designparm($function.'.tabbg', $domain); |
| my $font = &designparm($function.'.font',$domain); |
my $font = &designparm($function.'.font', $domain); |
| my $sidebg = &designparm($function.'.sidebg',$domain); |
my $sidebg = &designparm($function.'.sidebg',$domain); |
| my $pgbg = $bgcolor || &designparm($function.'.pgbg',$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'; |
| |
|
| my $alink = &designparm($function.'.alink',$domain); |
|
| my $vlink = &designparm($function.'.vlink',$domain); |
|
| my $link = &designparm($function.'.link',$domain); |
|
| my $sans = 'Arial,Helvetica,sans-serif'; |
|
| return <<END; |
return <<END; |
| <style type="text/css"> |
|
| h1, h2, h3, th { font-family: $sans } |
h1, h2, h3, th { font-family: $sans } |
| a:focus { color: red; background: yellow } |
a:focus { color: red; background: yellow } |
| table.thinborder { border-collapse: collapse; } |
table.thinborder { border-collapse: collapse; } |
|
Line 3063 table.thinborder tr th, table.thinborder
|
Line 3107 table.thinborder tr th, table.thinborder
|
| form, .inline { display: inline; } |
form, .inline { display: inline; } |
| .center { text-align: center; } |
.center { text-align: center; } |
| .filename {font-family: monospace;} |
.filename {font-family: monospace;} |
| table#LC_top_nav { |
.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: collapse; |
| |
} |
| |
table#LC_title_bar.LC_with_remote { |
| width: 100%; |
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; |
background: $pgbg; |
| border: 0px; |
border: 0px; |
| border-spacing: 1px; |
border-spacing: 1px; |
|
Line 3072 table#LC_top_nav {
|
Line 3172 table#LC_top_nav {
|
| margin: 0px; |
margin: 0px; |
| border-collapse: separate; |
border-collapse: separate; |
| } |
} |
| |
table#LC_menubuttons img, table#LC_menubuttons_mainmenu img { |
| |
border: 0px; |
| |
} |
| table#LC_top_nav td { |
table#LC_top_nav td { |
| background: $tabbg; |
background: $tabbg; |
| } |
} |
|
Line 3079 table#LC_top_nav td a, div#LC_top_nav a
|
Line 3182 table#LC_top_nav td a, div#LC_top_nav a
|
| color: $font; |
color: $font; |
| font-family: $sans; |
font-family: $sans; |
| } |
} |
| </style> |
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 |
END |
| } |
} |
| |
|
|
Line 3096 Inputs: $title - optional title for the
|
Line 3297 Inputs: $title - optional title for the
|
| $args - optional arguments |
$args - optional arguments |
| force_register - if is true call registerurl so the remote is |
force_register - if is true call registerurl so the remote is |
| informed |
informed |
| redirect - array ref of seconds before redirect occurs |
redirect -> array ref of seconds before redirect occurs |
| url to redirect to |
url to redirect to |
| (side effect of setting |
(side effect of setting |
| $env{'internal.head.redirect'} to the url |
$env{'internal.head.redirect'} to the url |
| redirected too) |
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 |
=back |
| |
|
| =cut |
=cut |
|
Line 3108 Inputs: $title - optional title for the
|
Line 3314 Inputs: $title - optional title for the
|
| sub headtag { |
sub headtag { |
| my ($title,$head_extra,$args) = @_; |
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 = |
my $result = |
| '<head>'. |
'<head>'. |
| &standard_css(). |
'<link rel="stylesheet" type="text/css" href="'.$url.'" />'. |
| &font_settings(). |
&font_settings(). |
| &Apache::lonhtmlcommon::htmlareaheaders(); |
&Apache::lonhtmlcommon::htmlareaheaders(); |
| |
|
|
Line 3269 Inputs: $title - optional title for the
|
Line 3484 Inputs: $title - optional title for the
|
| head -> skip the <html><head> generation |
head -> skip the <html><head> generation |
| body -> skip all <body> 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 |
=back |
| |
|
| =cut |
=cut |
|
Line 3277 sub start_page {
|
Line 3495 sub start_page {
|
| my ($title,$head_extra,$args) = @_; |
my ($title,$head_extra,$args) = @_; |
| #&Apache::lonnet::logthis("start_page ".join(':',caller(0))); |
#&Apache::lonnet::logthis("start_page ".join(':',caller(0))); |
| my %head_args; |
my %head_args; |
| foreach my $arg ('redirect','force_register') { |
foreach my $arg ('redirect','force_register','domain','function', |
| |
'bgcolor') { |
| if (defined($args->{$arg})) { |
if (defined($args->{$arg})) { |
| $head_args{$arg} = $args->{$arg}; |
$head_args{$arg} = $args->{$arg}; |
| } |
} |
|
Line 3303 sub start_page {
|
Line 3522 sub start_page {
|
| $args->{'only_body'}, $args->{'domain'}, |
$args->{'only_body'}, $args->{'domain'}, |
| $args->{'force_register'}, $args->{'body_title'}, |
$args->{'force_register'}, $args->{'body_title'}, |
| $args->{'no_nav_bar'}, $args->{'bgcolor'}, |
$args->{'no_nav_bar'}, $args->{'bgcolor'}, |
| $args->{'no_title'}); |
$args->{'no_title'}, $args->{'no_inline_link'}); |
| } |
} |
| } |
} |
| |
|
|
Line 3423 sub simple_error_page {
|
Line 3642 sub simple_error_page {
|
| } |
} |
| return $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>'; |
| |
} |
| |
|
| |
sub start_data_table_header_row { |
| |
return '<tr class="LC_header_row">'; |
| |
} |
| |
|
| |
sub end_data_table_header_row { |
| |
return '</tr>'; |
| |
} |
| |
} |
| |
|
| ############################################### |
############################################### |
| |
|
| =pod |
=pod |
|
Line 3526 Returns number of sections.
|
Line 3776 Returns number of sections.
|
| |
|
| ############################################### |
############################################### |
| sub get_sections { |
sub get_sections { |
| my ($cdom,$cnum,$sectioncount,$possible_roles) = @_; |
my ($cdom,$cnum,$possible_roles) = @_; |
| if (!($cdom && $cnum)) { return 0; } |
if (!defined($cdom) || !defined($cnum)) { |
| my $numsections = 0; |
my $cid = $env{'request.course.id'}; |
| |
|
| |
return if (!defined($cid)); |
| |
|
| |
$cdom = $env{'course.'.$cid.'.domain'}; |
| |
$cnum = $env{'course.'.$cid.'.num'}; |
| |
} |
| |
|
| if (!defined($possible_roles) || (grep/^st$/,@$possible_roles)) { |
my %sectioncount; |
| |
|
| |
if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) { |
| my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum); |
my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum); |
| my $sec_index = &Apache::loncoursedata::CL_SECTION(); |
my $sec_index = &Apache::loncoursedata::CL_SECTION(); |
| my $status_index = &Apache::loncoursedata::CL_STATUS(); |
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], |
my ($section,$status) = ($data->[$sec_index], |
| $data->[$status_index]); |
$data->[$status_index]); |
| unless ($section eq '-1' || $section =~ /^\s*$/) { |
unless ($section eq '-1' || $section =~ /^\s*$/) { |
| if (!defined($$sectioncount{$section})) { $numsections++; } |
$sectioncount{$section}++; |
| $$sectioncount{$section}++; |
|
| } |
} |
| } |
} |
| } |
} |
|
Line 3555 sub get_sections {
|
Line 3812 sub get_sections {
|
| } |
} |
| if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; } |
if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; } |
| if (!defined($section) || $section eq '-1') { next; } |
if (!defined($section) || $section eq '-1') { next; } |
| if (!defined($$sectioncount{$section})) { $numsections++; } |
$sectioncount{$section}++; |
| $$sectioncount{$section}++; |
|
| } |
} |
| return $numsections; |
return %sectioncount; |
| } |
} |
| |
|
| ############################################### |
############################################### |
|
Line 3595 can be sent to &get_group_settings() to
|
Line 3851 can be sent to &get_group_settings() to
|
| ############################################### |
############################################### |
| |
|
| sub coursegroups { |
sub coursegroups { |
| my ($curr_groups,$cdom,$cnum,$group) = @_; |
my ($cdom,$cnum,$group) = @_; |
| my $numgroups; |
|
| if (!defined($cdom) || !defined($cnum)) { |
if (!defined($cdom) || !defined($cnum)) { |
| my $cid = $env{'request.course.id'}; |
my $cid = $env{'request.course.id'}; |
| |
|
| |
return if (!defined($cid)); |
| |
|
| $cdom = $env{'course.'.$cid.'.domain'}; |
$cdom = $env{'course.'.$cid.'.domain'}; |
| $cnum = $env{'course.'.$cid.'.num'}; |
$cnum = $env{'course.'.$cid.'.num'}; |
| } |
} |
| %{$curr_groups} = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group); |
my %curr_groups = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group); |
| my ($tmp) = keys(%{$curr_groups}); |
my ($tmp) = keys(%curr_groups); |
| if ($tmp=~/^error:/) { |
if ($tmp=~/^(con_lost|no_such_host|error: [^2] )/) { |
| unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') { |
undef(%curr_groups); |
| &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'. |
&logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom); |
| $cdom); |
} elsif ($tmp=~/^error: 2 /) { |
| } |
undef(%curr_groups); |
| $numgroups = 0; |
|
| } else { |
|
| $numgroups = keys(%{$curr_groups}); |
|
| } |
} |
| return $numgroups; |
return %curr_groups; |
| } |
} |
| |
|
| ############################################### |
############################################### |
|
Line 3674 sub get_group_settings {
|
Line 3929 sub get_group_settings {
|
| $content{$tool}{$function} = $value; |
$content{$tool}{$function} = $value; |
| } |
} |
| } elsif ($entry eq 'groupname') { |
} elsif ($entry eq 'groupname') { |
| $content{$entry}=&Apache::lonnet::unescape($value); |
$content{$entry}=&unescape($value); |
| } elsif (($entry eq 'roles') || ($entry eq 'types') || |
} elsif (($entry eq 'roles') || ($entry eq 'types') || |
| ($entry eq 'sectionpick') || ($entry eq 'defpriv')) { |
($entry eq 'sectionpick') || ($entry eq 'defpriv')) { |
| push(@{$content{$entry}},$value); |
push(@{$content{$entry}},$value); |
|
Line 3859 will result in $env{'form.uname'} and $e
|
Line 4114 will result in $env{'form.uname'} and $e
|
| sub get_unprocessed_cgi { |
sub get_unprocessed_cgi { |
| my ($query,$possible_names)= @_; |
my ($query,$possible_names)= @_; |
| # $Apache::lonxml::debug=1; |
# $Apache::lonxml::debug=1; |
| foreach (split(/&/,$query)) { |
foreach my $pair (split(/&/,$query)) { |
| my ($name, $value) = split(/=/,$_); |
my ($name, $value) = split(/=/,$pair); |
| $name = &Apache::lonnet::unescape($name); |
$name = &unescape($name); |
| if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) { |
if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) { |
| $value =~ tr/+/ /; |
$value =~ tr/+/ /; |
| $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
Line 4077 sub record_sep {
|
Line 4332 sub record_sep {
|
| if ($env{'form.upfiletype'} eq 'xml') { |
if ($env{'form.upfiletype'} eq 'xml') { |
| } elsif ($env{'form.upfiletype'} eq 'space') { |
} elsif ($env{'form.upfiletype'} eq 'space') { |
| my $i=0; |
my $i=0; |
| foreach (split(/\s+/,$record)) { |
foreach my $field (split(/\s+/,$record)) { |
| my $field=$_; |
|
| $field=~s/^(\"|\')//; |
$field=~s/^(\"|\')//; |
| $field=~s/(\"|\')$//; |
$field=~s/(\"|\')$//; |
| $components{&takeleft($i)}=$field; |
$components{&takeleft($i)}=$field; |
|
Line 4086 sub record_sep {
|
Line 4340 sub record_sep {
|
| } |
} |
| } elsif ($env{'form.upfiletype'} eq 'tab') { |
} elsif ($env{'form.upfiletype'} eq 'tab') { |
| my $i=0; |
my $i=0; |
| foreach (split(/\t/,$record)) { |
foreach my $field (split(/\t/,$record)) { |
| my $field=$_; |
|
| $field=~s/^(\"|\')//; |
$field=~s/^(\"|\')//; |
| $field=~s/(\"|\')$//; |
$field=~s/(\"|\')$//; |
| $components{&takeleft($i)}=$field; |
$components{&takeleft($i)}=$field; |
|
Line 4181 sub csv_print_samples {
|
Line 4434 sub csv_print_samples {
|
| my $samples = &get_samples($records,3); |
my $samples = &get_samples($records,3); |
| |
|
| $r->print(&mt('Samples').'<br /><table border="2"><tr>'); |
$r->print(&mt('Samples').'<br /><table border="2"><tr>'); |
| foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) { |
foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { |
| $r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); } |
$r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); } |
| $r->print('</tr>'); |
$r->print('</tr>'); |
| foreach my $hash (@$samples) { |
foreach my $hash (@$samples) { |
| $r->print('<tr>'); |
$r->print('<tr>'); |
| foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) { |
foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { |
| $r->print('<td>'); |
$r->print('<td>'); |
| if (defined($$hash{$_})) { $r->print($$hash{$_}); } |
if (defined($$hash{$sample})) { $r->print($$hash{$sample}); } |
| $r->print('</td>'); |
$r->print('</td>'); |
| } |
} |
| $r->print('</tr>'); |
$r->print('</tr>'); |
|
Line 4221 sub csv_print_select_table {
|
Line 4474 sub csv_print_select_table {
|
| '<table border="2"><tr>'. |
'<table border="2"><tr>'. |
| '<th>'.&mt('Attribute').'</th>'. |
'<th>'.&mt('Attribute').'</th>'. |
| '<th>'.&mt('Column').'</th></tr>'."\n"); |
'<th>'.&mt('Column').'</th></tr>'."\n"); |
| foreach (@$d) { |
foreach my $array_ref (@$d) { |
| my ($value,$display,$defaultcol)=@{ $_ }; |
my ($value,$display,$defaultcol)=@{ $array_ref }; |
| $r->print('<tr><td>'.$display.'</td>'); |
$r->print('<tr><td>'.$display.'</td>'); |
| |
|
| $r->print('<td><select name=f'.$i. |
$r->print('<td><select name=f'.$i. |
| ' onchange="javascript:flip(this.form,'.$i.');">'); |
' onchange="javascript:flip(this.form,'.$i.');">'); |
| $r->print('<option value="none"></option>'); |
$r->print('<option value="none"></option>'); |
| foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) { |
foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { |
| $r->print('<option value="'.$_.'"'. |
$r->print('<option value="'.$sample.'"'. |
| ($_ eq $defaultcol ? ' selected="selected" ' : ''). |
($sample eq $defaultcol ? ' selected="selected" ' : ''). |
| '>Column '.($_+1).'</option>'); |
'>Column '.($sample+1).'</option>'); |
| } |
} |
| $r->print('</select></td></tr>'."\n"); |
$r->print('</select></td></tr>'."\n"); |
| $i++; |
$i++; |
|
Line 4492 sub DrawBarGraph {
|
Line 4745 sub DrawBarGraph {
|
| $Title = '' if (! defined($Title)); |
$Title = '' if (! defined($Title)); |
| $xlabel = '' if (! defined($xlabel)); |
$xlabel = '' if (! defined($xlabel)); |
| $ylabel = '' if (! defined($ylabel)); |
$ylabel = '' if (! defined($ylabel)); |
| $ValuesHash{$id.'.title'} = &Apache::lonnet::escape($Title); |
$ValuesHash{$id.'.title'} = &escape($Title); |
| $ValuesHash{$id.'.xlabel'} = &Apache::lonnet::escape($xlabel); |
$ValuesHash{$id.'.xlabel'} = &escape($xlabel); |
| $ValuesHash{$id.'.ylabel'} = &Apache::lonnet::escape($ylabel); |
$ValuesHash{$id.'.ylabel'} = &escape($ylabel); |
| $ValuesHash{$id.'.y_max_value'} = $Max; |
$ValuesHash{$id.'.y_max_value'} = $Max; |
| $ValuesHash{$id.'.NumBars'} = $NumBars; |
$ValuesHash{$id.'.NumBars'} = $NumBars; |
| $ValuesHash{$id.'.NumSets'} = $NumSets; |
$ValuesHash{$id.'.NumSets'} = $NumSets; |
|
Line 4574 sub DrawXYGraph {
|
Line 4827 sub DrawXYGraph {
|
| $ylabel = '' if (! defined($ylabel)); |
$ylabel = '' if (! defined($ylabel)); |
| my %ValuesHash = |
my %ValuesHash = |
| ( |
( |
| $id.'.title' => &Apache::lonnet::escape($Title), |
$id.'.title' => &escape($Title), |
| $id.'.xlabel' => &Apache::lonnet::escape($xlabel), |
$id.'.xlabel' => &escape($xlabel), |
| $id.'.ylabel' => &Apache::lonnet::escape($ylabel), |
$id.'.ylabel' => &escape($ylabel), |
| $id.'.y_max_value'=> $Max, |
$id.'.y_max_value'=> $Max, |
| $id.'.labels' => join(',',@$Xlabels), |
$id.'.labels' => join(',',@$Xlabels), |
| $id.'.PlotType' => 'XY', |
$id.'.PlotType' => 'XY', |
|
Line 4671 sub DrawXYYGraph {
|
Line 4924 sub DrawXYYGraph {
|
| $ylabel = '' if (! defined($ylabel)); |
$ylabel = '' if (! defined($ylabel)); |
| my %ValuesHash = |
my %ValuesHash = |
| ( |
( |
| $id.'.title' => &Apache::lonnet::escape($Title), |
$id.'.title' => &escape($Title), |
| $id.'.xlabel' => &Apache::lonnet::escape($xlabel), |
$id.'.xlabel' => &escape($xlabel), |
| $id.'.ylabel' => &Apache::lonnet::escape($ylabel), |
$id.'.ylabel' => &escape($ylabel), |
| $id.'.labels' => join(',',@$Xlabels), |
$id.'.labels' => join(',',@$Xlabels), |
| $id.'.PlotType' => 'XY', |
$id.'.PlotType' => 'XY', |
| $id.'.NumSets' => 2, |
$id.'.NumSets' => 2, |
|
Line 4745 Inputs:
|
Line 4998 Inputs:
|
| sub chartlink { |
sub chartlink { |
| my ($linktext, $sname, $sdomain) = @_; |
my ($linktext, $sname, $sdomain) = @_; |
| my $link = '<a href="/adm/statistics?reportSelected=student_assessment'. |
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'). |
'&chartoutputmode='.HTML::Entities::encode('html, with all links'). |
| '">'.$linktext.'</a>'; |
'">'.$linktext.'</a>'; |
| } |
} |
|
Line 4808 sub store_course_settings {
|
Line 5061 sub store_course_settings {
|
| if (ref($env{'form.'.$setting})) { |
if (ref($env{'form.'.$setting})) { |
| $stored_form = join(',', |
$stored_form = join(',', |
| map { |
map { |
| &Apache::lonnet::escape($_); |
&escape($_); |
| } sort(@{$env{'form.'.$setting}})); |
} sort(@{$env{'form.'.$setting}})); |
| } else { |
} else { |
| $stored_form = |
$stored_form = |
| &Apache::lonnet::escape($env{'form.'.$setting}); |
&escape($env{'form.'.$setting}); |
| } |
} |
| # Determine if the array contents are the same. |
# Determine if the array contents are the same. |
| if ($stored_form ne $env{$envname}) { |
if ($stored_form ne $env{$envname}) { |
|
Line 4846 sub restore_course_settings {
|
Line 5099 sub restore_course_settings {
|
| } elsif ($type eq 'array') { |
} elsif ($type eq 'array') { |
| $env{'form.'.$setting} = [ |
$env{'form.'.$setting} = [ |
| map { |
map { |
| &Apache::lonnet::unescape($_); |
&unescape($_); |
| } split(',',$env{$envname}) |
} split(',',$env{$envname}) |
| ]; |
]; |
| } |
} |
|
Line 4919 sub escape_double {
|
Line 5172 sub escape_double {
|
| sub escape_url { |
sub escape_url { |
| my ($url) = @_; |
my ($url) = @_; |
| my @urlslices = split(/\//, $url,-1); |
my @urlslices = split(/\//, $url,-1); |
| my $lastitem = &Apache::lonnet::escape(pop(@urlslices)); |
my $lastitem = &escape(pop(@urlslices)); |
| return join('/',@urlslices).'/'.$lastitem; |
return join('/',@urlslices).'/'.$lastitem; |
| } |
} |
| =pod |
=pod |
![[BACK]](/icons/back.gif){kind=icon}
Return to loncommon.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface