|
version 1.258, 2005/04/07 06:56:22
|
version 1.367, 2006/05/09 20:25:05
|
|
Line 58 use strict;
|
Line 58 use strict;
|
| use Apache::lonnet; |
use Apache::lonnet; |
| use GDBM_File; |
use GDBM_File; |
| use POSIX qw(strftime mktime); |
use POSIX qw(strftime mktime); |
| use Apache::Constants qw(:common :http :methods); |
|
| use Apache::lonmenu(); |
use Apache::lonmenu(); |
| use Apache::lonlocal; |
use Apache::lonlocal; |
| use HTML::Entities; |
use HTML::Entities; |
| |
use Apache::lonhtmlcommon(); |
| |
use Apache::loncoursedata(); |
| |
use Apache::lontexconvert(); |
| |
|
| my $readit; |
my $readit; |
| |
|
|
Line 74 my %language;
|
Line 76 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 105 BEGIN {
|
Line 107 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 122 BEGIN {
|
Line 124 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 152 BEGIN {
|
Line 154 BEGIN {
|
| my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; |
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; |
| opendir(DIR,$designdir); |
opendir(DIR,$designdir); |
| while ($filename=readdir(DIR)) { |
while ($filename=readdir(DIR)) { |
| |
if ($filename!~/\.tab$/) { next; } |
| my ($domain)=($filename=~/^(\w+)\./); |
my ($domain)=($filename=~/^(\w+)\./); |
| { |
{ |
| 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); |
| } |
} |
| } |
} |
| |
|
| } |
} |
| closedir(DIR); |
closedir(DIR); |
|
Line 175 BEGIN {
|
Line 178 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 190 BEGIN {
|
Line 193 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 330 sub storeresurl {
|
Line 334 sub storeresurl {
|
| sub studentbrowser_javascript { |
sub studentbrowser_javascript { |
| unless ( |
unless ( |
| (($env{'request.course.id'}) && |
(($env{'request.course.id'}) && |
| (&Apache::lonnet::allowed('srm',$env{'request.course.id'}))) |
(&Apache::lonnet::allowed('srm',$env{'request.course.id'}) |
| |
|| &Apache::lonnet::allowed('srm',$env{'request.course.id'}. |
| |
'/'.$env{'request.course.sec'}) |
| |
)) |
| || ($env{'request.role'}=~/^(au|dc|su)/) |
|| ($env{'request.role'}=~/^(au|dc|su)/) |
| ) { return ''; } |
) { return ''; } |
| return (<<'ENDSTDBRW'); |
return (<<'ENDSTDBRW'); |
|
Line 361 ENDSTDBRW
|
Line 368 ENDSTDBRW
|
| sub selectstudent_link { |
sub selectstudent_link { |
| my ($form,$unameele,$udomele)=@_; |
my ($form,$unameele,$udomele)=@_; |
| if ($env{'request.course.id'}) { |
if ($env{'request.course.id'}) { |
| unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) { |
if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'}) |
| |
&& !&Apache::lonnet::allowed('srm',$env{'request.course.id'}. |
| |
'/'.$env{'request.course.sec'})) { |
| return ''; |
return ''; |
| } |
} |
| return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
|
Line 379 sub coursebrowser_javascript {
|
Line 388 sub coursebrowser_javascript {
|
| return (<<ENDSTDBRW); |
return (<<ENDSTDBRW); |
| <script type="text/javascript" language="Javascript" > |
<script type="text/javascript" language="Javascript" > |
| var stdeditbrowser; |
var stdeditbrowser; |
| function opencrsbrowser(formname,uname,udom,desc,extra_element) { |
function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag) { |
| var url = '/adm/pickcourse?'; |
var url = '/adm/pickcourse?'; |
| var filter; |
var filter; |
| if (filter != null) { |
if (filter != null) { |
|
Line 402 sub coursebrowser_javascript {
|
Line 411 sub coursebrowser_javascript {
|
| url += '&domainfilter='+extra_element; |
url += '&domainfilter='+extra_element; |
| } |
} |
| } |
} |
| |
if (multflag !=null && multflag != '') { |
| |
url += '&multiple='+multflag; |
| |
} |
| var title = 'Course_Browser'; |
var title = 'Course_Browser'; |
| var options = 'scrollbars=1,resizable=1,menubar=0'; |
var options = 'scrollbars=1,resizable=1,menubar=0'; |
| options += ',width=700,height=600'; |
options += ',width=700,height=600'; |
|
Line 413 ENDSTDBRW
|
Line 425 ENDSTDBRW
|
| } |
} |
| |
|
| sub selectcourse_link { |
sub selectcourse_link { |
| my ($form,$unameele,$udomele,$desc,$extra_element)=@_; |
my ($form,$unameele,$udomele,$desc,$extra_element,$multflag)=@_; |
| return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele. |
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele. |
| '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."</a>"; |
'","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'");'."'>".&mt('Select Course')."</a>"; |
| |
} |
| |
|
| |
sub check_uncheck_jscript { |
| |
my $jscript = <<"ENDSCRT"; |
| |
function checkAll(field) { |
| |
if (field.length > 0) { |
| |
for (i = 0; i < field.length; i++) { |
| |
field[i].checked = true ; |
| |
} |
| |
} else { |
| |
field.checked = true |
| |
} |
| |
} |
| |
|
| |
function uncheckAll(field) { |
| |
if (field.length > 0) { |
| |
for (i = 0; i < field.length; i++) { |
| |
field[i].checked = false ; |
| |
} } else { |
| |
field.checked = false ; |
| |
} |
| } |
} |
| |
ENDSCRT |
| |
return $jscript; |
| |
} |
| |
|
| |
|
| =pod |
=pod |
| |
|
|
Line 670 sub help_open_menu {
|
Line 707 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 = &Apache::lonnet::escape($$datum); |
| } |
} |
| |
|
| if (!$stayOnPage) { |
if (!$stayOnPage) { |
| $link = "javascript:helpMenu('open')"; |
$link = "javascript:helpMenu('open')"; |
| } else { |
} else { |
|
Line 684 sub help_open_menu {
|
Line 721 sub help_open_menu {
|
| my $template; |
my $template; |
| if ($text ne "") { |
if ($text ne "") { |
| $template .= |
$template .= |
| "<table bgcolor='#773311' cellspacing='1' cellpadding='1' border='0'><tr>". |
"<table bgcolor='#CC3300' cellspacing='1' cellpadding='1' border='0'><tr>". |
| "<td bgcolor='#886622'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>"; |
"<td bgcolor='#CC6600'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>"; |
| } |
} |
| my $html=&Apache::lonxml::xmlbegin(); |
my $nothing=&Apache::lonhtmlcommon::javascript_nothing(); |
| my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif"); |
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"; |
$template .= <<"ENDTEMPLATE"; |
| <script type="text/javascript"> |
<script type="text/javascript"> |
| // <!-- BEGIN LON-CAPA Internal |
// <!-- BEGIN LON-CAPA Internal |
|
Line 698 function helpMenu(target) {
|
Line 746 function helpMenu(target) {
|
| if (target == 'open') { |
if (target == 'open') { |
| var newWindow = null; |
var newWindow = null; |
| try { |
try { |
| newWindow = window.open("/adm/rat/empty.html","helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" ) |
newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" ) |
| } |
} |
| catch(error) { |
catch(error) { |
| writeHelp(caller); |
writeHelp(caller); |
|
Line 712 function helpMenu(target) {
|
Line 760 function helpMenu(target) {
|
| return; |
return; |
| } |
} |
| function writeHelp(caller) { |
function writeHelp(caller) { |
| caller.document.write('$html<head><title>LON-CAPA Help Menu</title><meta http-equiv="pragma" content="no-cache"></head>') |
caller.document.writeln('$start_page<frame name="bannerframe" src="$banner_link" /><frame name="bodyframe" src="$details_link" /> $end_page') |
| caller.document.write("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>") |
|
| caller.document.write("</html>") |
|
| caller.document.close() |
caller.document.close() |
| caller.focus() |
caller.focus() |
| } |
} |
|
Line 1108 sub get_domains {
|
Line 1154 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 1123 sub domain_select {
|
Line 1169 sub domain_select {
|
| } &get_domains; |
} &get_domains; |
| if ($multiple) { |
if ($multiple) { |
| $domains{''}=&mt('Any domain'); |
$domains{''}=&mt('Any domain'); |
| return &multiple_select_form($name,$value,4,%domains); |
return &multiple_select_form($name,$value,4,\%domains); |
| } else { |
} else { |
| return &select_form($name,$value,%domains); |
return &select_form($name,$value,%domains); |
| } |
} |
| } |
} |
| |
|
| |
#------------------------------------------- |
| |
|
| |
=pod |
| |
|
| |
=item * multiple_select_form($name,$value,$size,$hash,$order) |
| |
|
| |
Returns a string containing a <select> element int multiple mode |
| |
|
| |
|
| |
Args: |
| |
$name - name of the <select> element |
| |
$value - sclara or array ref of values that should already be selected |
| |
$size - number of rows long the select element is |
| |
$hash - the elements should be 'option' => 'shown text' |
| |
(shown text should already have been &mt()) |
| |
$order - (optional) array ref of the order to show the elments in |
| |
|
| |
=cut |
| |
|
| |
#------------------------------------------- |
| sub multiple_select_form { |
sub multiple_select_form { |
| my ($name,$value,$size,%hash)=@_; |
my ($name,$value,$size,$hash,$order)=@_; |
| my %selected = map { $_ => 1 } ref($value)?@{$value}:($value); |
my %selected = map { $_ => 1 } ref($value)?@{$value}:($value); |
| my $output=''; |
my $output=''; |
| if (! defined($size)) { |
if (! defined($size)) { |
| $size = 4; |
$size = 4; |
| if (scalar(keys(%hash))<4) { |
if (scalar(keys(%$hash))<4) { |
| $size = scalar(keys(%hash)); |
$size = scalar(keys(%$hash)); |
| } |
} |
| } |
} |
| $output.="\n<select name='$name' size='$size' multiple='1'>"; |
$output.="\n<select name='$name' size='$size' multiple='1'>"; |
| foreach (sort(keys(%hash))) { |
my @order = ref($order) ? @$order |
| $output.='<option value="'.$_.'" '; |
: sort(keys(%$hash)); |
| $output.='selected="selected" ' if ($selected{$_}); |
foreach my $key (@order) { |
| $output.='>'.$hash{$_}."</option>\n"; |
$output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" '; |
| |
$output.='selected="selected" ' if ($selected{$key}); |
| |
$output.='>'.$hash->{$key}."</option>\n"; |
| } |
} |
| $output.="</select>\n"; |
$output.="</select>\n"; |
| return $output; |
return $output; |
|
Line 1171 sub select_form {
|
Line 1239 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 1238 sub select_dom_form {
|
Line 1307 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 1263 given $domain.
|
Line 1332 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 1287 sub home_server_option_list {
|
Line 1356 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 1539 sub authform_nochange{
|
Line 1609 sub authform_nochange{
|
| kerb_def_dom => 'MSU.EDU', |
kerb_def_dom => 'MSU.EDU', |
| @_, |
@_, |
| ); |
); |
| my $result = &mt('[_1] Do not change login data', |
my $result = '<label>'.&mt('[_1] Do not change login data', |
| '<input type="radio" name="login" value="nochange" '. |
'<input type="radio" name="login" value="nochange" '. |
| 'checked="checked" onclick="'. |
'checked="checked" onclick="'. |
| "javascript:changed_radio('nochange',$in{'formname'});".'" />'); |
"javascript:changed_radio('nochange',$in{'formname'});".'" />'). |
| |
'</label>'; |
| return $result; |
return $result; |
| } |
} |
| |
|
|
Line 1574 sub authform_kerberos{
|
Line 1645 sub authform_kerberos{
|
| my $jscall = "javascript:changed_radio('krb',$in{'formname'});"; |
my $jscall = "javascript:changed_radio('krb',$in{'formname'});"; |
| my $result .= &mt |
my $result .= &mt |
| ('[_1] Kerberos authenticated with domain [_2] '. |
('[_1] Kerberos authenticated with domain [_2] '. |
| '[_3] Version 4 [_4] Version 5', |
'[_3] Version 4 [_4] Version 5 [_5]', |
| '<input type="radio" name="login" value="krb" '. |
'<label><input type="radio" name="login" value="krb" '. |
| 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.$krbcheck.' />', |
'onclick="'.$jscall.'" onchange="'.$jscall.'"'.$krbcheck.' />', |
| '<input type="text" size="10" name="krbarg" '. |
'</label><input type="text" size="10" name="krbarg" '. |
| 'value="'.$krbarg.'" '. |
'value="'.$krbarg.'" '. |
| 'onchange="'.$jscall.'" />', |
'onchange="'.$jscall.'" />', |
| '<input type="radio" name="krbver" value="4" '.$check4.' />', |
'<label><input type="radio" name="krbver" value="4" '.$check4.' />', |
| '<input type="radio" name="krbver" value="5" '.$check5.' />'); |
'</label><label><input type="radio" name="krbver" value="5" '.$check5.' />', |
| |
'</label>'); |
| return $result; |
return $result; |
| } |
} |
| |
|
|
Line 1606 sub authform_internal{
|
Line 1678 sub authform_internal{
|
| my $jscall = "javascript:changed_radio('int',$args{'formname'});"; |
my $jscall = "javascript:changed_radio('int',$args{'formname'});"; |
| my $result.=&mt |
my $result.=&mt |
| ('[_1] Internally authenticated (with initial password [_2])', |
('[_1] Internally authenticated (with initial password [_2])', |
| '<input type="radio" name="login" value="int" '.$intcheck. |
'<label><input type="radio" name="login" value="int" '.$intcheck. |
| ' onchange="'.$jscall.'" onclick="'.$jscall.'" />', |
' onchange="'.$jscall.'" onclick="'.$jscall.'" />', |
| '<input type="text" size="10" name="intarg" '.$intarg. |
'</label><input type="text" size="10" name="intarg" '.$intarg. |
| ' onchange="'.$jscall.'" />'); |
' onchange="'.$jscall.'" />'); |
| return $result; |
return $result; |
| } |
} |
|
Line 1633 sub authform_local{
|
Line 1705 sub authform_local{
|
| |
|
| my $jscall = "javascript:changed_radio('loc',$in{'formname'});"; |
my $jscall = "javascript:changed_radio('loc',$in{'formname'});"; |
| my $result.=&mt('[_1] Local Authentication with argument [_2]', |
my $result.=&mt('[_1] Local Authentication with argument [_2]', |
| '<input type="radio" name="login" value="loc" '.$loccheck. |
'<label><input type="radio" name="login" value="loc" '.$loccheck. |
| ' onchange="'.$jscall.'" onclick="'.$jscall.'" />', |
' onchange="'.$jscall.'" onclick="'.$jscall.'" />', |
| '<input type="text" size="10" name="locarg" '.$locarg. |
'</label><input type="text" size="10" name="locarg" '.$locarg. |
| ' onchange="'.$jscall.'" />'); |
' onchange="'.$jscall.'" />'); |
| return $result; |
return $result; |
| } |
} |
|
Line 1649 sub authform_filesystem{
|
Line 1721 sub authform_filesystem{
|
| my $jscall = "javascript:changed_radio('fsys',$in{'formname'});"; |
my $jscall = "javascript:changed_radio('fsys',$in{'formname'});"; |
| my $result.= &mt |
my $result.= &mt |
| ('[_1] Filesystem Authenticated (with initial password [_2])', |
('[_1] Filesystem Authenticated (with initial password [_2])', |
| '<input type="radio" name="login" value="fsys" '. |
'<label><input type="radio" name="login" value="fsys" '. |
| 'onchange="'.$jscall.'" onclick="'.$jscall.'" />', |
'onchange="'.$jscall.'" onclick="'.$jscall.'" />', |
| '<input type="text" size="10" name="fsysarg" value="" '. |
'</label><input type="text" size="10" name="fsysarg" value="" '. |
| 'onchange="'.$jscall.'" />'); |
'onchange="'.$jscall.'" />'); |
| return $result; |
return $result; |
| } |
} |
|
Line 1777 sub initialize_keywords {
|
Line 1849 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 1834 sub get_related_words {
|
Line 1906 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 1867 if $first is set to 'lastname' then it r
|
Line 1939 if $first is set to 'lastname' then it r
|
| |
|
| =cut |
=cut |
| |
|
| |
|
| ############################################################### |
############################################################### |
| sub plainname { |
sub plainname { |
| my ($uname,$udom,$first)=@_; |
my ($uname,$udom,$first)=@_; |
| my %names=&Apache::lonnet::get('environment', |
my %names=&getnames($uname,$udom); |
| ['firstname','middlename','lastname','generation'], |
|
| $udom,$uname); |
|
| my $name=&Apache::lonnet::format_name($names{'firstname'}, |
my $name=&Apache::lonnet::format_name($names{'firstname'}, |
| $names{'middlename'}, |
$names{'middlename'}, |
| $names{'lastname'}, |
$names{'lastname'}, |
|
Line 1880 sub plainname {
|
Line 1951 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 1903 if the user does not
|
Line 1974 if the user does not
|
| |
|
| sub nickname { |
sub nickname { |
| my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
| my %names; |
my %names=&getnames($uname,$udom); |
| if ($uname eq $env{'user.name'} && |
|
| $udom eq $env{'user.domain'}) { |
|
| %names=('nickname' => $env{'environment.nickname'} , |
|
| 'firstname' => $env{'environment.firstname'} , |
|
| 'middlename' => $env{'environment.middlename'}, |
|
| 'lastname' => $env{'environment.lastname'} , |
|
| 'generation' => $env{'environment.generation'}); |
|
| } else { |
|
| %names=&Apache::lonnet::get('environment', |
|
| ['nickname','firstname','middlename', |
|
| 'lastname','generation'],$udom,$uname); |
|
| } |
|
| my $name=$names{'nickname'}; |
my $name=$names{'nickname'}; |
| if ($name) { |
if ($name) { |
| $name='"'.$name.'"'; |
$name='"'.$name.'"'; |
|
Line 1928 sub nickname {
|
Line 1987 sub nickname {
|
| return $name; |
return $name; |
| } |
} |
| |
|
| |
sub getnames { |
| |
my ($uname,$udom)=@_; |
| |
my $id=$uname.':'.$udom; |
| |
my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id); |
| |
if ($cached) { |
| |
return %{$names}; |
| |
} else { |
| |
my %loadnames=&Apache::lonnet::get('environment', |
| |
['firstname','middlename','lastname','generation','nickname'], |
| |
$udom,$uname); |
| |
&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames); |
| |
return %loadnames; |
| |
} |
| |
} |
| |
|
| # ------------------------------------------------------------------ Screenname |
# ------------------------------------------------------------------ Screenname |
| |
|
|
Line 1984 sub syllabuswrapper {
|
Line 2057 sub syllabuswrapper {
|
| } |
} |
| |
|
| sub track_student_link { |
sub track_student_link { |
| my ($linktext,$sname,$sdom,$target) = @_; |
my ($linktext,$sname,$sdom,$target,$start) = @_; |
| my $link ="/adm/trackstudent"; |
my $link ="/adm/trackstudent?"; |
| my $title = 'View recent activity'; |
my $title = 'View recent activity'; |
| if (defined($sname) && $sname !~ /^\s*$/ && |
if (defined($sname) && $sname !~ /^\s*$/ && |
| defined($sdom) && $sdom !~ /^\s*$/) { |
defined($sdom) && $sdom !~ /^\s*$/) { |
| $link .= "?selected_student=$sname:$sdom"; |
$link .= "selected_student=$sname:$sdom"; |
| $title .= ' of this student'; |
$title .= ' of this student'; |
| } |
} |
| if (defined($target) && $target !~ /^\s*$/) { |
if (defined($target) && $target !~ /^\s*$/) { |
| $target = qq{target="$target"}; |
$target = qq{target="$target"}; |
| } else { |
} else { |
| $target = ''; |
$target = ''; |
| } |
} |
| |
if ($start) { $link.='&start='.$start; } |
| return qq{<a href="$link" title="$title" $target>$linktext</a>}; |
return qq{<a href="$link" title="$title" $target>$linktext</a>}; |
| } |
} |
| |
|
| |
|
| |
|
| =pod |
=pod |
| |
|
| =back |
=back |
|
Line 2115 category
|
Line 2187 category
|
| =cut |
=cut |
| |
|
| sub filecategorytypes { |
sub filecategorytypes { |
| return @{$category_extensions{lc($_[0])}}; |
my ($cat) = @_; |
| |
return @{$category_extensions{lc($cat)}}; |
| } |
} |
| |
|
| =pod |
=pod |
|
Line 2130 sub fileembstyle {
|
Line 2203 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 2186 sub fileextensions {
|
Line 2263 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 2227 sub preferred_languages {
|
Line 2304 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 2287 sub get_previous_attempt {
|
Line 2364 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 2310 sub get_previous_attempt {
|
Line 2387 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>'.&Apache::lonnet::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=&Apache::lonnet::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 2362 sub relative_to_absolute {
|
Line 2439 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 2484 sub pgrdlink {
|
Line 2561 sub pgrdlink {
|
| Inputs: $text $uname $udom $symb $target |
Inputs: $text $uname $udom $symb $target |
| |
|
| Returns: A link to parmset.pm such as to see the PPRM view of a |
Returns: A link to parmset.pm such as to see the PPRM view of a |
| student andn resource |
student and a specific resource |
| |
|
| =cut |
=cut |
| |
|
|
Line 2537 sub maketime {
|
Line 2614 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 2549 sub findallcourses {
|
Line 2632 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 2679 Inputs:
|
Line 2762 Inputs:
|
| =item * $forcereg, if page should register as content page (relevant for |
=item * $forcereg, if page should register as content page (relevant for |
| text interface only) |
text interface only) |
| |
|
| |
=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 |
=back |
| |
|
| Returns: A uniform header for LON-CAPA web pages. |
Returns: A uniform header for LON-CAPA web pages. |
|
Line 2689 other decorations will be returned.
|
Line 2787 other decorations will be returned.
|
| =cut |
=cut |
| |
|
| sub bodytag { |
sub bodytag { |
| my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle)=@_; |
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle, |
| |
$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 $pgbg=&designparm($function.'.pgbg',$domain); |
my $font = &designparm($function.'.font',$domain); |
| my $tabbg=&designparm($function.'.tabbg',$domain); |
my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain); |
| my $font=&designparm($function.'.font',$domain); |
|
| my $link=&designparm($function.'.link',$domain); |
my %design = ( 'style' => 'margin-top: 0px', |
| my $alink=&designparm($function.'.alink',$domain); |
'bgcolor' => $pgbg, |
| my $vlink=&designparm($function.'.vlink',$domain); |
'text' => $font, |
| my $sidebg=&designparm($function.'.sidebg',$domain); |
'alink' => &designparm($function.'.alink',$domain), |
| # Accessibility font enhance |
'vlink' => &designparm($function.'.vlink',$domain), |
| unless ($addentries) { $addentries=''; } |
'link' => &designparm($function.'.link',$domain),); |
| my $addstyle=''; |
@$addentries{keys(%design)} = @design{keys(%design)}; |
| if ($env{'browser.fontenhance'} eq 'on') { |
|
| $addstyle=' font-size: x-large;'; |
|
| } |
|
| # 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 |
| my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; |
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; |
| if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } |
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } |
| |
|
| |
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>". |
| <style type="text/css"> |
&Apache::lontexconvert::init_math_support(); |
| h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif } |
|
| a:focus { color: red; background: yellow } |
|
| </style> |
|
| <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link" |
|
| style="margin-top: 0px;$addstyle" $addentries> |
|
| END |
|
| if ($env{'environment.texengine'} eq 'jsMath') { |
|
| $bodytag.='<script type="text/javascript"> |
|
| function NoFontMessage () {} |
|
| </script>'."\n". |
|
| '<script src="/adm/jsMath/jsMath.js"></script>'."\n"; |
|
| } |
|
| |
|
| my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'. |
if ($bodyonly |
| $lonhttpdPort.$img.'" alt="'.$function.'" />'; |
|| ($env{'request.state'} eq 'construct' |
| if ($bodyonly) { |
&& $env{'environment.remote'} ne 'off' )) { |
| return $bodytag; |
return $bodytag; |
| } elsif ($env{'browser.interface'} eq 'textual') { |
} elsif ($env{'browser.interface'} eq 'textual') { |
| # Accessibility |
# Accessibility |
| |
|
| return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', |
$bodytag.=&Apache::lonmenu::menubuttons($forcereg,$forcereg); |
| $forcereg). |
if (!$notitle) { |
| '<h1>LON-CAPA: '.$title.'</h1>'; |
$bodytag.='<h1>LON-CAPA: '.$title.'</h1>'; |
| } elsif ($env{'environment.remote'} eq 'off') { |
} |
| # No Remote |
return $bodytag; |
| 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-(.+/)([^/]*)$-) { |
| my $titletable = '<table bgcolor="'.$pgbg.'" width="100%" border="0" '. |
$parentpath = $1; |
| 'cellspacing="3" cellpadding="3">'. |
$lastitem = $2; |
| '<tr><td rowspan="3" bgcolor="'.$tabbg.'">'. |
} else { |
| $titleinfo.'</td>'.$roleinfo.'</tr></table>'; |
$lastitem = $thisdisfn; |
| if ($env{'request.state'} eq 'construct') { |
} |
| $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable); |
$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 { |
} else { |
| $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg). |
if ($env{'request.state'} eq 'construct') { |
| $titletable; |
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg, |
| |
$titletable); |
| |
} else { |
| |
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg). |
| |
$titletable; |
| |
} |
| } |
} |
| return $bodytag; |
return $bodytag; |
| } |
} |
|
Line 2810 ENDROLE
|
Line 2931 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.'" />'; |
| } |
|
| |
# Explicit link to get inline menu |
| |
my $menu= ($no_inline_link?'' |
| |
:'<br /><a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a>'); |
| # |
# |
| # Extra info if you are the DC |
if ($notitle) { |
| my $dc_info = ''; |
return $bodytag; |
| 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.')'; |
|
| } |
} |
| # |
|
| 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>$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 |
</table> |
| </td><td bgcolor="$tabbg" align="right"> |
|
| <font size="2" face="Arial, Helvetica, sans-serif"> |
|
| $env{'environment.firstname'} |
|
| $env{'environment.middlename'} |
|
| $env{'environment.lastname'} |
|
| $env{'environment.generation'} |
|
| </font> |
|
| </td> |
|
| </tr> |
|
| <tr><td bgcolor="$tabbg" align="right"> |
|
| <font size="2" face="Arial, Helvetica, sans-serif">$role</font> |
|
| </td></tr> |
|
| <tr> |
|
| <td bgcolor="$tabbg" align="right"><font size="2" face="Arial, Helvetica, sans-serif">$realm</font> </td></tr> |
|
| </table><br /> |
|
| ENDBODY |
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; |
| |
} |
| |
|
| |
|
| ############################################### |
############################################### |
| ############################################### |
############################################### |
| |
|
|
Line 2860 ENDBODY
|
Line 3017 ENDBODY
|
| |
|
| =back |
=back |
| |
|
| =head1 HTTP Helpers |
=head1 HTML Helpers |
| |
|
| =over 4 |
=over 4 |
| |
|
|
Line 2868 ENDBODY
|
Line 3025 ENDBODY
|
| |
|
| Returns a uniform footer for LON-CAPA web pages. |
Returns a uniform footer for LON-CAPA web pages. |
| |
|
| Inputs: |
Inputs: none |
| |
|
| =over 4 |
|
| |
|
| =back |
=back |
| |
|
| Returns: A uniform footer for LON-CAPA web pages. |
|
| |
|
| =cut |
=cut |
| |
|
| sub endbodytag { |
sub endbodytag { |
| my $endbodytag='</body>'; |
my $endbodytag='</body>'; |
| if ($env{'environment.texengine'} eq 'jsMath') { |
$endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag; |
| $endbodytag='<script type="text/javascript">jsMath.Process()</script>'. |
if ( exists( $env{'internal.head.redirect'} ) ) { |
| "\n".$endbodytag; |
$endbodytag= |
| |
"<br /><a href=\"$env{'internal.head.redirect'}\">". |
| |
&mt('Continue').'</a>'. |
| |
$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 { |
| |
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; |
| |
background: $pgbg; |
| |
font-family: $sans; |
| |
border-collapse: collapse; |
| |
} |
| |
table#LC_title_bar.LC_with_remote { |
| |
width: 100%; |
| |
border: 0; |
| |
border-spacing: 0; |
| |
background: $pgbg; |
| |
font-family: $sans; |
| |
border-collapse: collapse; |
| |
} |
| |
table#LC_title_bar td { |
| |
padding: 3px; |
| |
background: $tabbg; |
| |
} |
| |
table#LC_title_bar td.LC_title_bar_who { |
| |
background: $tabbg; |
| |
color: $font; |
| |
font: medium $sans; |
| |
text-align: right; |
| |
} |
| |
span.LC_title_bar_title { |
| |
font: bold xx-large $sans; |
| |
} |
| |
table#LC_title_bar td.LC_title_bar_domain_logo { |
| |
background: $sidebg; |
| |
text-align: right; |
| |
} |
| |
|
| |
table#LC_menubuttons_mainmenu { |
| |
background: $pgbg; |
| |
border: 0px; |
| |
border-spacing: 1px; |
| |
padding: 0px; |
| |
margin: 0px; |
| |
border-collapse: separate; |
| |
} |
| |
table#LC_menubuttons img, table#LC_menubuttons_mainmenu img { |
| |
border: 0px; |
| |
} |
| |
table#LC_top_nav td { |
| |
background: $tabbg; |
| |
} |
| |
table#LC_top_nav td a, div#LC_top_nav a { |
| |
color: $font; |
| |
font-family: $sans; |
| |
} |
| |
table#LC_top_nav td.LC_top_nav_logo { |
| |
background: $tabbg; |
| |
text-align: right; |
| |
} |
| |
table#LC_breadcrumbs td { |
| |
background: $tabbg; |
| |
color: $font; |
| |
font-family: $sans; |
| |
font-size: smaller; |
| |
} |
| |
table#LC_breadcrumbs td.LC_breadcrumb_component { |
| |
background: $tabbg; |
| |
color: $font; |
| |
font-family: $sans; |
| |
font-size: larger; |
| |
text-align: right; |
| |
} |
| |
.LC_menubuttons_inline_text { |
| |
color: $font; |
| |
font-family: $sans; |
| |
font-size: smaller; |
| |
} |
| |
|
| |
td.LC_menubuttons_text { |
| |
color: $font; |
| |
font-family: $sans; |
| |
} |
| |
td.LC_menubuttons_img { |
| |
background: $tabbg; |
| |
} |
| |
.LC_current_location { |
| |
font-family: $sans; |
| |
background: $tabbg; |
| |
} |
| |
.LC_new_mail { |
| |
font-family: $sans; |
| |
font-weight: bold; |
| |
} |
| |
|
| |
table.LC_data_table, table.LC_mail_list { |
| |
border: 1px solid #000000; |
| |
border-collapse: seperate; |
| |
} |
| |
table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th { |
| |
font-weight: bold; |
| |
background-color: $data_table_head; |
| |
} |
| |
table.LC_data_table tr td { |
| |
background-color: $data_table_light; |
| |
} |
| |
table.LC_data_table tr.LC_even_row td { |
| |
background-color: $data_table_dark; |
| |
} |
| |
table.LC_data_table tr.LC_empty td { |
| |
background-color: #FFFFFF; |
| |
} |
| |
|
| |
table.LC_calendar { |
| |
border: 1px solid #000000; |
| |
border-collapse: collapse; |
| |
} |
| |
table.LC_calendar_pickdate { |
| |
font-size: xx-small; |
| |
} |
| |
table.LC_calendar tr td { |
| |
border: 1px solid #000000; |
| |
vertical-align: top; |
| |
} |
| |
table.LC_calendar tr td.LC_calendar_day_empty { |
| |
background-color: $data_table_dark; |
| |
} |
| |
table.LC_calendar tr td.LC_calendar_day_current { |
| |
background-color: $data_table_highlight; |
| |
} |
| |
|
| |
table.LC_mail_list tr.LC_mail_new { |
| |
background-color: $mail_new; |
| |
} |
| |
table.LC_mail_list tr.LC_mail_new:hover { |
| |
background-color: $mail_new_hover; |
| |
} |
| |
table.LC_mail_list tr.LC_mail_read { |
| |
background-color: $mail_read; |
| |
} |
| |
table.LC_mail_list tr.LC_mail_read:hover { |
| |
background-color: $mail_read_hover; |
| |
} |
| |
table.LC_mail_list tr.LC_mail_replied { |
| |
background-color: $mail_replied; |
| |
} |
| |
table.LC_mail_list tr.LC_mail_replied:hover { |
| |
background-color: $mail_replied_hover; |
| |
} |
| |
table.LC_mail_list tr.LC_mail_other { |
| |
background-color: $mail_other; |
| |
} |
| |
table.LC_mail_list tr.LC_mail_other:hover { |
| |
background-color: $mail_other_hover; |
| |
} |
| |
END |
| |
} |
| |
|
| |
=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 |
| |
|
| |
=cut |
| |
|
| |
sub headtag { |
| |
my ($title,$head_extra,$args) = @_; |
| |
|
| |
my $function = $args->{'function'} || &get_users_function(); |
| |
my $domain = $args->{'domain'} || &determinedomain(); |
| |
my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain); |
| |
my $url = join(':',$env{'user.name'},$env{'user.domain'}, |
| |
$env{'environment.color.timestamp'}, |
| |
$function,$domain,$bgcolor); |
| |
|
| |
$url = '/adm/css/'.&Apache::lonnet::escape($url).'.css'; |
| |
|
| |
my $result = |
| |
'<head>'. |
| |
'<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="$time; url=$url" /> |
| |
ADDMETA |
| |
} |
| |
if (!defined($title)) { |
| |
$title = 'The LearningOnline Network with CAPA'; |
| |
} |
| |
|
| |
$result .= '<title> LON-CAPA '.&mt($title).'</title>'.$head_extra; |
| |
return $result; |
| |
} |
| |
|
| |
=pod |
| |
|
| |
=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. |
| |
|
| |
Inputs: none |
| |
|
| |
=back |
| |
|
| |
=cut |
| |
|
| |
sub endheadtag { |
| |
return '</head>'; |
| |
} |
| |
|
| |
=pod |
| |
|
| |
=over 4 |
| |
|
| |
=item * &head() |
| |
|
| |
Returns a uniform complete <head>..</head> section for LON-CAPA web pages. |
| |
|
| |
Inputs: $title - optional title for the page |
| |
$head_extra - optional extra HTML to put inside the <head> |
| |
=back |
| |
|
| |
=cut |
| |
|
| |
sub head { |
| |
my ($title,$head_extra,$args) = @_; |
| |
return &headtag($title,$head_extra,$args).&endheadtag(); |
| |
} |
| |
|
| |
=pod |
| |
|
| |
=over 4 |
| |
|
| |
=item * &start_page() |
| |
|
| |
Returns a complete <html> .. <body> section for LON-CAPA web pages. |
| |
|
| |
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 -> 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 |
| |
|
| |
=cut |
| |
|
| |
sub start_page { |
| |
my ($title,$head_extra,$args) = @_; |
| |
#&Apache::lonnet::logthis("start_page ".join(':',caller(0))); |
| |
my %head_args; |
| |
foreach my $arg ('redirect','force_register','domain','function', |
| |
'bgcolor') { |
| |
if (defined($args->{$arg})) { |
| |
$head_args{$arg} = $args->{$arg}; |
| |
} |
| |
} |
| |
|
| |
$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 |
| |
|
| |
=item * &head() |
| |
|
| |
Returns a complete </body></html> section for LON-CAPA web pages. |
| |
|
| |
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 { |
| |
my ($args) = @_; |
| |
#&Apache::lonnet::logthis("end_page ".join(':',caller(0))); |
| |
$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{</script>}{</scrip'+'t>}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 |
=pod |
| |
|
| |
=over 4 |
| |
|
| =item get_users_function |
=item get_users_function |
| |
|
| Used by &bodytag to determine the current users primary role. |
Used by &bodytag to determine the current users primary role. |
|
Line 2918 sub get_users_function {
|
Line 3689 sub get_users_function {
|
| |
|
| =pod |
=pod |
| |
|
| |
=item check_user_status |
| |
|
| |
Determines current status of supplied role for a |
| |
specific user. Roles can be active, previous or future. |
| |
|
| |
Inputs: |
| |
user's domain, user's username, course's domain, |
| |
course's number, optional section/group. |
| |
|
| |
Outputs: |
| |
role status: active, previous or future. |
| |
|
| |
=cut |
| |
|
| |
sub check_user_status { |
| |
my ($udom,$uname,$cdom,$crs,$role,$secgrp) = @_; |
| |
my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname); |
| |
my @uroles = keys %userinfo; |
| |
my $srchstr; |
| |
my $active_chk = 'none'; |
| |
if (@uroles > 0) { |
| |
if (($role eq 'cc') || ($secgrp eq '') || (!defined($secgrp))) { |
| |
$srchstr = '/'.$cdom.'/'.$crs.'_'.$role; |
| |
} else { |
| |
$srchstr = '/'.$cdom.'/'.$crs.'/'.$secgrp.'_'.$role; } |
| |
if (grep/^$srchstr$/,@uroles) { |
| |
my $role_end = 0; |
| |
my $role_start = 0; |
| |
$active_chk = 'active'; |
| |
if ($userinfo{$srchstr} =~ m/^($role)_(\d+)/) { |
| |
$role_end = $2; |
| |
if ($userinfo{$srchstr} =~ m/^($role)_($role_end)_(\d+)$/) { |
| |
$role_start = $3; |
| |
} |
| |
} |
| |
if ($role_start > 0) { |
| |
if (time < $role_start) { |
| |
$active_chk = 'future'; |
| |
} |
| |
} |
| |
if ($role_end > 0) { |
| |
if (time > $role_end) { |
| |
$active_chk = 'previous'; |
| |
} |
| |
} |
| |
} |
| |
} |
| |
return $active_chk; |
| |
} |
| |
|
| |
############################################### |
| |
|
| |
=pod |
| |
|
| =item get_sections |
=item get_sections |
| |
|
| Determines all the sections for a course including |
Determines all the sections for a course including |
|
Line 2934 Returns number of sections.
|
Line 3759 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 $cid = $cdom.'_'.$cnum; |
my $cid = $env{'request.course.id'}; |
| my $numsections = 0; |
|
| |
|
| if (!defined($possible_roles) || (grep/^st$/,@$possible_roles)) { |
return if (!defined($cid)); |
| my ($classlist) = &Apache::loncoursedata::get_classlist($cid,$cdom,$cnum); |
|
| |
$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 $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 2964 sub get_sections {
|
Line 3795 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; |
| } |
} |
| |
|
| |
############################################### |
| |
|
| |
=pod |
| |
|
| |
=item coursegroups |
| |
|
| sub get_posted_cgi { |
Retrieve information about groups in a course, |
| my $r=shift; |
|
| |
|
| my $buffer; |
Input: |
| |
1. Reference to hash to populate with group information. |
| $r->read($buffer,$r->header_in('Content-length'),0); |
2. Optional course domain |
| unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) { |
3. Optional course number |
| my @pairs=split(/&/,$buffer); |
4. Optional group name |
| my $pair; |
|
| foreach $pair (@pairs) { |
Course domain and number will be taken from user's |
| my ($name,$value) = split(/=/,$pair); |
environment if not supplied. Optional group name will' |
| $value =~ tr/+/ /; |
be passed to lonnet::get_coursegroups() as a regexp to |
| $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
use in the call to the dump function. |
| $name =~ tr/+/ /; |
|
| $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
Output |
| &add_to_env("form.$name",$value); |
Returns number of groups in the course (subject to the |
| } |
optional group name filter). |
| } else { |
|
| my $contentsep=$1; |
Side effects: |
| my @lines = split (/\n/,$buffer); |
Populates the referenced curr_groups hash, with key, |
| my $name=''; |
value pairs. Keys are group names, corresponding values |
| my $value=''; |
are scalars containing group information in XML. This |
| my $fname=''; |
can be sent to &get_group_settings() to be parsed. |
| my $fmime=''; |
|
| my $i; |
=cut |
| for ($i=0;$i<=$#lines;$i++) { |
|
| if ($lines[$i]=~/^$contentsep/) { |
############################################### |
| if ($name) { |
|
| chomp($value); |
sub coursegroups { |
| if ($fname) { |
my ($cdom,$cnum,$group) = @_; |
| $env{"form.$name.filename"}=$fname; |
if (!defined($cdom) || !defined($cnum)) { |
| $env{"form.$name.mimetype"}=$fmime; |
my $cid = $env{'request.course.id'}; |
| } else { |
|
| $value=~s/\s+$//s; |
return if (!defined($cid)); |
| } |
|
| &add_to_env("form.$name",$value); |
$cdom = $env{'course.'.$cid.'.domain'}; |
| |
$cnum = $env{'course.'.$cid.'.num'}; |
| |
} |
| |
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 %curr_groups; |
| |
} |
| |
|
| |
############################################### |
| |
|
| |
=pod |
| |
|
| |
=item get_group_settings |
| |
|
| |
Uses TokeParser to extract group information from the |
| |
XML used to describe course groups. |
| |
|
| |
Input: |
| |
Scalar containing XML - as retrieved from &coursegroups(). |
| |
|
| |
Output: |
| |
Hash containing group information as key=values for (a), and |
| |
hash of hashes for (b) |
| |
|
| |
Keys (in two categories): |
| |
(a) groupname, creator, creation, modified, startdate,enddate. |
| |
Corresponding values are name of the group, creator of the group |
| |
(username:domain), UNIX time for date group was created, and |
| |
settings were last modified, and default start and end access |
| |
times for group members. |
| |
|
| |
(b) functions returned in hash of hashes. |
| |
Outer hash key is functions. |
| |
Inner hash keys are chat,discussion,email,files,homepage,roster. |
| |
Corresponding values are either on or off, depending on |
| |
whether this type of functionality is available for the group. |
| |
|
| |
=cut |
| |
|
| |
############################################### |
| |
|
| |
sub get_group_settings { |
| |
my ($groupinfo)=@_; |
| |
my $parser=HTML::TokeParser->new(\$groupinfo); |
| |
my $token; |
| |
my $tool = ''; |
| |
my $role = ''; |
| |
my %content=(); |
| |
while ($token=$parser->get_token) { |
| |
if ($token->[0] eq 'S') { |
| |
my $entry=$token->[1]; |
| |
if ($entry eq 'functions' || $entry eq 'autosec') { |
| |
%{$content{$entry}} = (); |
| |
$tool = $entry; |
| |
} elsif ($entry eq 'role') { |
| |
if ($tool eq 'autosec') { |
| |
$role = $token->[2]{id}; |
| |
} |
| |
} else { |
| |
my $value=$parser->get_text('/'.$entry); |
| |
if ($entry eq 'name') { |
| |
if ($tool eq 'functions') { |
| |
my $function = $token->[2]{id}; |
| |
$content{$tool}{$function} = $value; |
| |
} |
| |
} elsif ($entry eq 'groupname') { |
| |
$content{$entry}=&Apache::lonnet::unescape($value); |
| |
} elsif (($entry eq 'roles') || ($entry eq 'types') || |
| |
($entry eq 'sectionpick') || ($entry eq 'defpriv')) { |
| |
push(@{$content{$entry}},$value); |
| |
} elsif ($entry eq 'section') { |
| |
if ($tool eq 'autosec' && $role ne '') { |
| |
push(@{$content{$tool}{$role}},$value); |
| |
} |
| |
} else { |
| |
$content{$entry}=$value; |
| |
} |
| |
} |
| |
} elsif ($token->[0] eq 'E') { |
| |
if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') { |
| |
$tool = ''; |
| |
} elsif ($token->[1] eq 'role') { |
| |
$role = ''; |
| |
} |
| |
|
| |
} |
| |
} |
| |
return %content; |
| |
} |
| |
|
| |
sub check_group_access { |
| |
my ($group) = @_; |
| |
my $access = 1; |
| |
my $now = time; |
| |
my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group}); |
| |
if (($end!=0) && ($end<$now)) { $access = 0; } |
| |
if (($start!=0) && ($start>$now)) { $access=0; } |
| |
return $access; |
| |
} |
| |
|
| |
############################################### |
| |
|
| |
=pod |
| |
|
| |
=item get_course_users |
| |
|
| |
Retrieves usernames:domains for users in the specified course |
| |
with specific role(s), and access status. |
| |
|
| |
Incoming parameters: |
| |
1. course domain |
| |
2. course number |
| |
3. access status: users must have - either active, |
| |
previous, future, or all. |
| |
4. reference to array of permissible roles |
| |
5. reference to array of section restrictions (optional) |
| |
6. reference to results object (hash of hashes). |
| |
7. reference to optional userdata hash |
| |
Keys of top level hash are roles. |
| |
Keys of inner hashes are username:domain, with |
| |
values set to access type. |
| |
Optional userdata hash returns an array with arguments in the |
| |
same order as loncoursedata::get_classlist() for student data. |
| |
|
| |
Entries for end, start, section and status are blank because |
| |
of the possibility of multiple values for non-student roles. |
| |
|
| |
=cut |
| |
|
| |
############################################### |
| |
|
| |
sub get_course_users { |
| |
my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_; |
| |
my %idx = (); |
| |
|
| |
$idx{udom} = &Apache::loncoursedata::CL_SDOM(); |
| |
$idx{uname} = &Apache::loncoursedata::CL_SNAME(); |
| |
$idx{end} = &Apache::loncoursedata::CL_END(); |
| |
$idx{start} = &Apache::loncoursedata::CL_START(); |
| |
$idx{id} = &Apache::loncoursedata::CL_ID(); |
| |
$idx{section} = &Apache::loncoursedata::CL_SECTION(); |
| |
$idx{fullname} = &Apache::loncoursedata::CL_FULLNAME(); |
| |
$idx{status} = &Apache::loncoursedata::CL_STATUS(); |
| |
|
| |
if (grep(/^st$/,@{$roles})) { |
| |
my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum); |
| |
my $now = time; |
| |
foreach my $student (keys(%{$classlist})) { |
| |
my $match = 0; |
| |
if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) { |
| |
unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/, |
| |
@{$sections})) { |
| |
next; |
| } |
} |
| if ($i<$#lines) { |
} |
| $i++; |
if (defined($$types{'active'})) { |
| $lines[$i]=~ |
if ($$classlist{$student}[$idx{status}] eq 'Active') { |
| /Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i; |
push(@{$$users{st}{$student}},'active'); |
| $name=$1; |
$match = 1; |
| $value=''; |
} |
| if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) { |
} |
| $fname=$1; |
if (defined($$types{'previous'})) { |
| if |
if ($$classlist{$student}[$idx{end}] <= $now) { |
| ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) { |
push(@{$$users{st}{$student}},'previous'); |
| $fmime=$1; |
$match = 1; |
| $i++; |
} |
| } else { |
} |
| $fmime=''; |
if (defined($$types{'future'})) { |
| } |
if (($$classlist{$student}[$idx{start}] > $now) && ($$classlist{$student}[$idx{end}] > $now) || ($$classlist{$student}[$idx{end}] == 0) || ($$classlist{$student}[$idx{end}] eq '')) { |
| } else { |
push(@{$$users{st}{$student}},'future'); |
| $fname=''; |
$match = 1; |
| $fmime=''; |
} |
| |
} |
| |
if ($match && defined($userdata)) { |
| |
$$userdata{$student} = $$classlist{$student}; |
| |
} |
| |
} |
| |
} |
| |
if ((@{$roles} > 0) && (@{$roles} ne "st")) { |
| |
my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum); |
| |
foreach my $person (@coursepersonnel) { |
| |
my $match = 0; |
| |
my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/); |
| |
$user =~ s/:$//; |
| |
if (($role) && (grep(/^\Q$role\E$/,@{$roles}))) { |
| |
my ($uname,$udom,$usec) = split(/:/,$user); |
| |
if ($usec ne '' && (ref($sections) eq 'ARRAY') && |
| |
@{$sections} > 0) { |
| |
unless(grep(/^\Q$usec\E$/,@{$sections})) { |
| |
next; |
| } |
} |
| $i++; |
} |
| } |
if ($uname ne '' && $udom ne '') { |
| } else { |
my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role); |
| $value.=$lines[$i]."\n"; |
foreach my $type (keys(%{$types})) { |
| } |
if ($status eq $type) { |
| } |
@{$$users{$role}{$user}} = $type; |
| |
$match = 1; |
| |
} |
| |
} |
| |
if ($match && defined($userdata) && |
| |
!exists($$userdata{$uname.':'.$udom})) { |
| |
&get_user_info($udom,$uname,\%idx,$userdata); |
| |
} |
| |
} |
| |
} |
| |
} |
| |
if (grep(/^ow$/,@{$roles})) { |
| |
if ((defined($cdom)) && (defined($cnum))) { |
| |
my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum); |
| |
if ( defined($csettings{'internal.courseowner'}) ) { |
| |
my $owner = $csettings{'internal.courseowner'}; |
| |
@{$$users{'ow'}{$owner.':'.$cdom}} = 'any'; |
| |
if (defined($userdata) && |
| |
!exists($$userdata{$owner.':'.$cdom})) { |
| |
&get_user_info($cdom,$owner,\%idx,$userdata); |
| |
} |
| |
} |
| |
} |
| |
} |
| } |
} |
| $env{'request.method'}=$ENV{'REQUEST_METHOD'}; |
return; |
| $r->method_number(M_GET); |
} |
| $r->method('GET'); |
|
| $r->headers_in->unset('Content-length'); |
sub get_user_info { |
| |
my ($udom,$uname,$idx,$userdata) = @_; |
| |
$$userdata{$uname.':'.$udom}[$$idx{fullname}] = |
| |
&plainname($uname,$udom,'lastname'); |
| |
$$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname; |
| |
$$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom; |
| |
return; |
| } |
} |
| |
|
| =pod |
=pod |
|
Line 3058 will result in $env{'form.uname'} and $e
|
Line 4097 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 = &Apache::lonnet::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; |
| &Apache::lonxml::debug("Seting :$name: to :$value:"); |
|
| unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) }; |
unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) }; |
| } |
} |
| } |
} |
|
Line 3107 sub no_cache {
|
Line 4145 sub no_cache {
|
| |
|
| sub content_type { |
sub content_type { |
| my ($r,$type,$charset) = @_; |
my ($r,$type,$charset) = @_; |
| |
if ($r) { |
| |
# Note that printout.pl calls this with undef for $r. |
| |
&no_cache($r); |
| |
} |
| if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; } |
if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; } |
| unless ($charset) { |
unless ($charset) { |
| $charset=&Apache::lonlocal::current_encoding; |
$charset=&Apache::lonlocal::current_encoding; |
|
Line 3135 sub add_to_env {
|
Line 4177 sub add_to_env {
|
| if (ref($env{$name})) { |
if (ref($env{$name})) { |
| #already have multiple values |
#already have multiple values |
| push(@{ $env{$name} },$value); |
push(@{ $env{$name} },$value); |
| push(@{ $ENV{$name} },$value); |
|
| } else { |
} else { |
| #first time seeing multiple values, convert hash entry to an arrayref |
#first time seeing multiple values, convert hash entry to an arrayref |
| my $first=$env{$name}; |
my $first=$env{$name}; |
| undef($env{$name}); |
undef($env{$name}); |
| undef($ENV{$name}); |
|
| push(@{ $env{$name} },$first,$value); |
push(@{ $env{$name} },$first,$value); |
| push(@{ $ENV{$name} },$first,$value); |
|
| } |
} |
| } else { |
} else { |
| $env{$name}=$value; |
$env{$name}=$value; |
| $ENV{$name}=$value; |
|
| } |
} |
| } |
} |
| |
|
|
Line 3266 Separate a record into fields $record sh
|
Line 4304 Separate a record into fields $record sh
|
| |
|
| =cut |
=cut |
| |
|
| |
sub takeleft { |
| |
my $index=shift; |
| |
return substr('0000'.$index,-4,4); |
| |
} |
| |
|
| sub record_sep { |
sub record_sep { |
| my $record=shift; |
my $record=shift; |
| my %components=(); |
my %components=(); |
| 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{$i}=$field; |
$components{&takeleft($i)}=$field; |
| $i++; |
$i++; |
| } |
} |
| } 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{$i}=$field; |
$components{&takeleft($i)}=$field; |
| $i++; |
$i++; |
| } |
} |
| } else { |
} else { |
|
Line 3303 sub record_sep {
|
Line 4344 sub record_sep {
|
| $field=~s/^\s*$delimiter//; |
$field=~s/^\s*$delimiter//; |
| $field=~s/$delimiter\s*$//; |
$field=~s/$delimiter\s*$//; |
| } |
} |
| $components{$i}=$field; |
$components{&takeleft($i)}=$field; |
| $i++; |
$i++; |
| } |
} |
| } |
} |
|
Line 3340 sub upfile_select_html {
|
Line 4381 sub upfile_select_html {
|
| return $Str; |
return $Str; |
| } |
} |
| |
|
| |
sub get_samples { |
| |
my ($records,$toget) = @_; |
| |
my @samples=({}); |
| |
my $got=0; |
| |
foreach my $rec (@$records) { |
| |
my %temp = &record_sep($rec); |
| |
if (! grep(/\S/, values(%temp))) { next; } |
| |
if (%temp) { |
| |
$samples[$got]=\%temp; |
| |
$got++; |
| |
if ($got == $toget) { last; } |
| |
} |
| |
} |
| |
return \@samples; |
| |
} |
| |
|
| ###################################################### |
###################################################### |
| ###################################################### |
###################################################### |
| |
|
|
Line 3357 Apache Request ref, $records is an array
|
Line 4414 Apache Request ref, $records is an array
|
| ###################################################### |
###################################################### |
| sub csv_print_samples { |
sub csv_print_samples { |
| my ($r,$records) = @_; |
my ($r,$records) = @_; |
| my (%sone,%stwo,%sthree); |
my $samples = &get_samples($records,3); |
| %sone=&record_sep($$records[0]); |
|
| if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} |
|
| if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} |
|
| # |
|
| $r->print(&mt('Samples').'<br /><table border="2"><tr>'); |
$r->print(&mt('Samples').'<br /><table border="2"><tr>'); |
| foreach (sort({$a <=> $b} keys(%sone))) { |
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 (\%sone,\%stwo,\%sthree) { |
foreach my $hash (@$samples) { |
| $r->print('<tr>'); |
$r->print('<tr>'); |
| foreach (sort({$a <=> $b} keys(%sone))) { |
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 3397 $d is an array of 2 element arrays (inte
|
Line 4451 $d is an array of 2 element arrays (inte
|
| ###################################################### |
###################################################### |
| sub csv_print_select_table { |
sub csv_print_select_table { |
| my ($r,$records,$d) = @_; |
my ($r,$records,$d) = @_; |
| my $i=0;my %sone; |
my $i=0; |
| %sone=&record_sep($$records[0]); |
my $samples = &get_samples($records,1); |
| $r->print(&mt('Associate columns with student attributes.')."\n". |
$r->print(&mt('Associate columns with student attributes.')."\n". |
| '<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(%sone))) { |
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 3441 $d is an array of 2 element arrays (inte
|
Line 4495 $d is an array of 2 element arrays (inte
|
| ###################################################### |
###################################################### |
| sub csv_samples_select_table { |
sub csv_samples_select_table { |
| my ($r,$records,$d) = @_; |
my ($r,$records,$d) = @_; |
| my %sone; my %stwo; my %sthree; |
|
| my $i=0; |
my $i=0; |
| # |
# |
| |
my $samples = &get_samples($records,3); |
| $r->print('<table border=2><tr><th>'. |
$r->print('<table border=2><tr><th>'. |
| &mt('Field').'</th><th>'.&mt('Samples').'</th></tr>'); |
&mt('Field').'</th><th>'.&mt('Samples').'</th></tr>'); |
| %sone=&record_sep($$records[0]); |
|
| if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} |
foreach my $key (sort(keys(%{ $samples->[0] }))) { |
| if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} |
|
| # |
|
| foreach (sort keys %sone) { |
|
| $r->print('<tr><td><select name="f'.$i.'"'. |
$r->print('<tr><td><select name="f'.$i.'"'. |
| ' onchange="javascript:flip(this.form,'.$i.');">'); |
' onchange="javascript:flip(this.form,'.$i.');">'); |
| foreach (@$d) { |
foreach my $option (@$d) { |
| my ($value,$display,$defaultcol)=@{ $_ }; |
my ($value,$display,$defaultcol)=@{ $option }; |
| $r->print('<option value="'.$value.'"'. |
$r->print('<option value="'.$value.'"'. |
| ($i eq $defaultcol ? ' selected="selected" ':'').'>'. |
($i eq $defaultcol ? ' selected="selected" ':'').'>'. |
| $display.'</option>'); |
$display.'</option>'); |
| } |
} |
| $r->print('</select></td><td>'); |
$r->print('</select></td><td>'); |
| if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); } |
foreach my $line (0..2) { |
| if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); } |
if (defined($samples->[$line]{$key})) { |
| if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); } |
$r->print($samples->[$line]{$key}."<br />\n"); |
| |
} |
| |
} |
| $r->print('</td></tr>'); |
$r->print('</td></tr>'); |
| $i++; |
$i++; |
| } |
} |
|
Line 3551 the routine &Apache::lonnet::transfer_pr
|
Line 4604 the routine &Apache::lonnet::transfer_pr
|
| my $uniq=0; |
my $uniq=0; |
| sub get_cgi_id { |
sub get_cgi_id { |
| $uniq=($uniq+1)%100000; |
$uniq=($uniq+1)%100000; |
| return (time.'_'.$uniq); |
return (time.'_'.$$.'_'.$uniq); |
| } |
} |
| |
|
| ############################################################ |
############################################################ |
|
Line 3971 sub store_course_settings {
|
Line 5024 sub store_course_settings {
|
| # save to the environment |
# save to the environment |
| # appenv the same items, just to be safe |
# appenv the same items, just to be safe |
| my $courseid = $env{'request.course.id'}; |
my $courseid = $env{'request.course.id'}; |
| my $coursedom = $env{'course.'.$courseid.'.domain'}; |
my $udom = $env{'user.domain'}; |
| |
my $uname = $env{'user.name'}; |
| my ($prefix,$Settings) = @_; |
my ($prefix,$Settings) = @_; |
| my %SaveHash; |
my %SaveHash; |
| my %AppHash; |
my %AppHash; |
| while (my ($setting,$type) = each(%$Settings)) { |
while (my ($setting,$type) = each(%$Settings)) { |
| my $basename = 'internal.'.$prefix.'.'.$setting; |
my $basename = join('.','internal',$courseid,$prefix,$setting); |
| my $envname = 'course.'.$courseid.'.'.$basename; |
my $envname = 'environment.'.$basename; |
| if (exists($env{'form.'.$setting})) { |
if (exists($env{'form.'.$setting})) { |
| # Save this value away |
# Save this value away |
| if ($type eq 'scalar' && |
if ($type eq 'scalar' && |
|
Line 4005 sub store_course_settings {
|
Line 5059 sub store_course_settings {
|
| } |
} |
| } |
} |
| my $put_result = &Apache::lonnet::put('environment',\%SaveHash, |
my $put_result = &Apache::lonnet::put('environment',\%SaveHash, |
| $coursedom, |
$udom,$uname); |
| $env{'course.'.$courseid.'.num'}); |
|
| if ($put_result !~ /^(ok|delayed)/) { |
if ($put_result !~ /^(ok|delayed)/) { |
| &Apache::lonnet::logthis('unable to save form parameters, '. |
&Apache::lonnet::logthis('unable to save form parameters, '. |
| 'got error:'.$put_result); |
'got error:'.$put_result); |
|
Line 4021 sub restore_course_settings {
|
Line 5074 sub restore_course_settings {
|
| my ($prefix,$Settings) = @_; |
my ($prefix,$Settings) = @_; |
| while (my ($setting,$type) = each(%$Settings)) { |
while (my ($setting,$type) = each(%$Settings)) { |
| next if (exists($env{'form.'.$setting})); |
next if (exists($env{'form.'.$setting})); |
| my $envname = 'course.'.$courseid.'.internal.'.$prefix. |
my $envname = 'environment.internal.'.$courseid.'.'.$prefix. |
| '.'.$setting; |
'.'.$setting; |
| if (exists($env{$envname})) { |
if (exists($env{$envname})) { |
| if ($type eq 'scalar') { |
if ($type eq 'scalar') { |
![[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