version 1.81, 2003/02/13 23:02:42
|
version 1.92, 2003/03/28 01:53:55
|
Line 81 use GDBM_File;
|
Line 81 use GDBM_File;
|
use POSIX qw(strftime mktime); |
use POSIX qw(strftime mktime); |
use Apache::Constants qw(:common); |
use Apache::Constants qw(:common); |
use Apache::lonmsg(); |
use Apache::lonmsg(); |
|
use Apache::lonmenu(); |
my $readit; |
my $readit; |
|
|
=pod |
=pod |
Line 345 sub selectstudent_link {
|
Line 346 sub selectstudent_link {
|
return ''; |
return ''; |
} |
} |
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
'","'.$udomele.'");'."'>Select</a>"; |
'","'.$udomele.'");'."'>Select User</a>"; |
|
} |
|
|
|
sub coursebrowser_javascript { |
|
return (<<'ENDSTDBRW'); |
|
<script type="text/javascript" language="Javascript" > |
|
var stdeditbrowser; |
|
function opencrsbrowser(formname,uname,udom) { |
|
var url = '/adm/pickcourse?'; |
|
var filter; |
|
if (filter != null) { |
|
if (filter != '') { |
|
url += 'filter='+filter+'&'; |
|
} |
|
} |
|
url += 'form=' + formname + '&cnumelement='+uname+ |
|
'&cdomelement='+udom; |
|
var title = 'Course Browser'; |
|
var options = 'scrollbars=1,resizable=1,menubar=0'; |
|
options += ',width=700,height=600'; |
|
stdeditbrowser = open(url,title,options,'1'); |
|
stdeditbrowser.focus(); |
|
} |
|
</script> |
|
ENDSTDBRW |
|
} |
|
|
|
sub selectcourse_link { |
|
my ($form,$unameele,$udomele)=@_; |
|
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele. |
|
'","'.$udomele.'");'."'>Select Course</a>"; |
} |
} |
|
|
############################################################### |
############################################################### |
Line 600 sub get_domains {
|
Line 631 sub get_domains {
|
|
|
=pod |
=pod |
|
|
=item select_dom_form($defdom,$name) |
=item select_form($defdom,$name,%hash) |
|
|
|
Returns a string containing a <select name='$name' size='1'> form to |
|
allow a user to select options from a hash option_name => displayed text. |
|
See lonrights.pm for an example invocation and use. |
|
|
|
=cut |
|
|
|
#------------------------------------------- |
|
sub select_form { |
|
my ($def,$name,%hash) = @_; |
|
my $selectform = "<select name=\"$name\" size=\"1\">\n"; |
|
foreach (sort keys %hash) { |
|
$selectform.="<option value=\"$_\" ". |
|
($_ eq $def ? 'selected' : ''). |
|
">".$hash{$_}."</option>\n"; |
|
} |
|
$selectform.="</select>"; |
|
return $selectform; |
|
} |
|
|
|
|
|
#------------------------------------------- |
|
|
|
=pod |
|
|
|
=item select_dom_form($defdom,$name,$includeempty) |
|
|
Returns a string containing a <select name='$name' size='1'> form to |
Returns a string containing a <select name='$name' size='1'> form to |
allow a user to select the domain to preform an operation in. |
allow a user to select the domain to preform an operation in. |
See loncreateuser.pm for an example invocation and use. |
See loncreateuser.pm for an example invocation and use. |
|
|
|
If the $includeempty flag is set, it also includes an empty choice ("no domain |
|
selected"); |
|
|
=cut |
=cut |
|
|
#------------------------------------------- |
#------------------------------------------- |
sub select_dom_form { |
sub select_dom_form { |
my ($defdom,$name) = @_; |
my ($defdom,$name,$includeempty) = @_; |
my @domains = get_domains(); |
my @domains = get_domains(); |
|
if ($includeempty) { @domains=('',@domains); } |
my $selectdomain = "<select name=\"$name\" size=\"1\">\n"; |
my $selectdomain = "<select name=\"$name\" size=\"1\">\n"; |
foreach (@domains) { |
foreach (@domains) { |
$selectdomain.="<option value=\"$_\" ". |
$selectdomain.="<option value=\"$_\" ". |
Line 673 sub home_server_option_list {
|
Line 734 sub home_server_option_list {
|
############################################################### |
############################################################### |
|
|
############################################################### |
############################################################### |
|
############################################################### |
|
|
|
=pod |
|
|
|
=item &decode_user_agent() |
|
|
|
Inputs: $r |
|
|
|
Outputs: |
|
|
|
=over 4 |
|
|
|
=item $httpbrowser |
|
|
|
=item $clientbrowser |
|
|
|
=item $clientversion |
|
|
|
=item $clientmathml |
|
|
|
=item $clientunicode |
|
|
|
=item $clientos |
|
|
|
=back |
|
|
|
=cut |
|
|
|
############################################################### |
|
############################################################### |
|
sub decode_user_agent { |
|
my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"}); |
|
my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"}); |
|
my $httpbrowser=$ENV{"HTTP_USER_AGENT"}; |
|
my $clientbrowser='unknown'; |
|
my $clientversion='0'; |
|
my $clientmathml=''; |
|
my $clientunicode='0'; |
|
for (my $i=0;$i<=$#browsertype;$i++) { |
|
my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]); |
|
if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) { |
|
$clientbrowser=$bname; |
|
$httpbrowser=~/$vreg/i; |
|
$clientversion=$1; |
|
$clientmathml=($clientversion>=$minv); |
|
$clientunicode=($clientversion>=$univ); |
|
} |
|
} |
|
my $clientos='unknown'; |
|
if (($httpbrowser=~/linux/i) || |
|
($httpbrowser=~/unix/i) || |
|
($httpbrowser=~/ux/i) || |
|
($httpbrowser=~/solaris/i)) { $clientos='unix'; } |
|
if (($httpbrowser=~/vax/i) || |
|
($httpbrowser=~/vms/i)) { $clientos='vms'; } |
|
if ($httpbrowser=~/next/i) { $clientos='next'; } |
|
if (($httpbrowser=~/mac/i) || |
|
($httpbrowser=~/powerpc/i)) { $clientos='mac'; } |
|
if ($httpbrowser=~/win/i) { $clientos='win'; } |
|
if ($httpbrowser=~/embed/i) { $clientos='pda'; } |
|
return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml, |
|
$clientunicode,$clientos,); |
|
} |
|
|
|
############################################################### |
|
############################################################### |
|
|
|
|
|
############################################################### |
## Authentication changing form generation subroutines ## |
## Authentication changing form generation subroutines ## |
############################################################### |
############################################################### |
## |
## |
Line 1481 sub domainlogo {
|
Line 1611 sub domainlogo {
|
my $domain = &determinedomain(shift); |
my $domain = &determinedomain(shift); |
# See if there is a logo |
# See if there is a logo |
if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') { |
if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') { |
return '<img src="http://'.$ENV{'HTTP_HOST'}.':8080/adm/lonDomLogos/'. |
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; |
$domain.'.gif" />'; |
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } |
|
return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort. |
|
'/adm/lonDomLogos/'.$domain.'.gif" />'; |
} elsif(exists($Apache::lonnet::domaindescription{$domain})) { |
} elsif(exists($Apache::lonnet::domaindescription{$domain})) { |
return $Apache::lonnet::domaindescription{$domain}; |
return $Apache::lonnet::domaindescription{$domain}; |
} else { |
} else { |
Line 1527 Inputs:
|
Line 1659 Inputs:
|
$addentries, extra parameters for the <body> tag. |
$addentries, extra parameters for the <body> tag. |
$bodyonly, if defined, only return the <body> tag. |
$bodyonly, if defined, only return the <body> tag. |
$domain, if defined, force a given domain. |
$domain, if defined, force a given domain. |
|
$forcereg, if page should register as content page (relevant for |
|
text interface only) |
|
|
Returns: A uniform header for LON-CAPA web pages. |
Returns: A uniform header for LON-CAPA web pages. |
If $bodyonly is nonzero, a string containing a <body> tag will be returned. |
If $bodyonly is nonzero, a string containing a <body> tag will be returned. |
Line 1540 other decorations will be returned.
|
Line 1674 other decorations will be returned.
|
|
|
############################################### |
############################################### |
sub bodytag { |
sub bodytag { |
my ($title,$function,$addentries,$bodyonly,$domain)=@_; |
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_; |
unless ($function) { |
unless ($function) { |
$function='student'; |
$function='student'; |
if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) { |
if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) { |
Line 1575 sub bodytag {
|
Line 1709 sub bodytag {
|
# Set messages |
# Set messages |
my $messages=&domainlogo($domain); |
my $messages=&domainlogo($domain); |
# Output |
# Output |
|
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; |
|
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } |
my $bodytag = <<END; |
my $bodytag = <<END; |
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link" |
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link" |
$addentries> |
$addentries> |
Line 1582 END
|
Line 1718 END
|
if ($bodyonly) { |
if ($bodyonly) { |
return $bodytag; |
return $bodytag; |
} elsif ($ENV{'browser.interface'} eq 'textual') { |
} elsif ($ENV{'browser.interface'} eq 'textual') { |
return $bodytag.'<h1>LON-CAPA: '.$title. |
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', |
'</h1><a href="/adm/menu">Main Menu</a><hr />'; |
$forcereg). |
|
'<h1>LON-CAPA: '.$title.'</h1>'; |
} else { |
} else { |
return(<<ENDBODY); |
return(<<ENDBODY); |
$bodytag |
$bodytag |
<table width="100%" cellspacing="0" border="0" cellpadding="0"> |
<table width="100%" cellspacing="0" border="0" cellpadding="0"> |
<tr><td bgcolor="$font"> |
<tr><td bgcolor="$font"> |
<img src="http://$ENV{'HTTP_HOST'}:8080/$img" /></td> |
<img src="http://$ENV{'HTTP_HOST'}:$lonhttpdPort$img" /></td> |
<td bgcolor="$font"><font color='$sidebg'>$messages</font></td> |
<td bgcolor="$font"><font color='$sidebg'>$messages</font></td> |
</tr> |
</tr> |
<tr> |
<tr> |
Line 1915 sub csv_samples_select_table {
|
Line 2052 sub csv_samples_select_table {
|
$i--; |
$i--; |
return($i); |
return($i); |
} |
} |
|
|
|
=pod |
|
|
|
=item check_if_partid_hidden($id,$symb,$udom,$uname) |
|
|
|
Returns either 1 or undef |
|
|
|
1 if the part is to be hidden, undef if it is to be shown |
|
|
|
Arguments are: |
|
|
|
$id the id of the part to be checked |
|
$symb, optional the symb of the resource to check |
|
$udom, optional the domain of the user to check for |
|
$uname, optional the username of the user to check for |
|
|
|
=cut |
|
|
|
sub check_if_partid_hidden { |
|
my ($id,$symb,$udom,$uname) = @_; |
|
my $hiddenparts=&Apache::lonnet::EXT('resource.0.parameter_hiddenparts', |
|
$symb,$udom,$uname); |
|
my @hiddenlist=split(/,/,$hiddenparts); |
|
foreach my $checkid (@hiddenlist) { |
|
if ($checkid =~ /^\s*\Q$id\E\s*$/) { return 1; } |
|
} |
|
return undef; |
|
} |
|
|
|
|
|
|
1; |
1; |
__END__; |
__END__; |
|
|