version 1.64, 2002/09/05 15:03:33
|
version 1.103, 2003/06/06 02:24:49
|
Line 27
|
Line 27
|
# |
# |
# YEAR=2001 |
# YEAR=2001 |
# 2/13-12/7 Guy Albertelli |
# 2/13-12/7 Guy Albertelli |
# 12/11,12/12,12/17 Scott Harrison |
|
# 12/21 Gerd Kortemeyer |
# 12/21 Gerd Kortemeyer |
# 12/21 Scott Harrison |
|
# 12/25,12/28 Gerd Kortemeyer |
# 12/25,12/28 Gerd Kortemeyer |
# YEAR=2002 |
# YEAR=2002 |
# 1/4 Gerd Kortemeyer |
# 1/4 Gerd Kortemeyer |
Line 81 use strict;
|
Line 79 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); |
use Apache::Constants qw(:common :http :methods); |
use Apache::lonmsg(); |
use Apache::lonmsg(); |
|
use Apache::lonmenu(); |
my $readit; |
my $readit; |
|
|
=pod |
=pod |
Line 152 BEGIN {
|
Line 151 BEGIN {
|
while (<$fh>) { |
while (<$fh>) { |
next if /^\#/; |
next if /^\#/; |
chomp; |
chomp; |
my ($key,$val)=(split(/\s+/,$_,2)); |
my ($key,$two,$country,$three,$enc,$val)=(split(/\t/,$_)); |
$language{$key}=$val; |
$language{$key}=$val.' - '.$enc; |
} |
} |
} |
} |
} |
} |
Line 311 sub browser_and_searcher_javascript {
|
Line 310 sub browser_and_searcher_javascript {
|
END |
END |
} |
} |
|
|
|
sub studentbrowser_javascript { |
|
unless ($ENV{'request.course.id'}) { return ''; } |
|
unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) { |
|
return ''; |
|
} |
|
return (<<'ENDSTDBRW'); |
|
<script type="text/javascript" language="Javascript" > |
|
var stdeditbrowser; |
|
function openstdbrowser(formname,uname,udom) { |
|
var url = '/adm/pickstudent?'; |
|
var filter; |
|
eval('filter=document.'+formname+'.'+uname+'.value;'); |
|
if (filter != null) { |
|
if (filter != '') { |
|
url += 'filter='+filter+'&'; |
|
} |
|
} |
|
url += 'form=' + formname + '&unameelement='+uname+ |
|
'&udomelement='+udom; |
|
var title = 'Student_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 selectstudent_link { |
|
my ($form,$unameele,$udomele)=@_; |
|
unless ($ENV{'request.course.id'}) { return ''; } |
|
unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) { |
|
return ''; |
|
} |
|
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
|
'","'.$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 483 sub help_open_topic {
|
Line 549 sub help_open_topic {
|
my ($topic, $text, $stayOnPage, $width, $height) = @_; |
my ($topic, $text, $stayOnPage, $width, $height) = @_; |
$text = "" if (not defined $text); |
$text = "" if (not defined $text); |
$stayOnPage = 0 if (not defined $stayOnPage); |
$stayOnPage = 0 if (not defined $stayOnPage); |
|
if ($ENV{'browser.interface'} eq 'textual') { |
|
$stayOnPage=1; |
|
} |
$width = 350 if (not defined $width); |
$width = 350 if (not defined $width); |
$height = 400 if (not defined $height); |
$height = 400 if (not defined $height); |
my $filename = $topic; |
my $filename = $topic; |
Line 493 sub help_open_topic {
|
Line 562 sub help_open_topic {
|
|
|
if (!$stayOnPage) |
if (!$stayOnPage) |
{ |
{ |
$link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height'))"; |
$link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; |
} |
} |
else |
else |
{ |
{ |
Line 503 sub help_open_topic {
|
Line 572 sub help_open_topic {
|
# Add the text |
# Add the text |
if ($text ne "") |
if ($text ne "") |
{ |
{ |
$template .= "<a href=\"$link\">$text</a> "; |
$template .= |
|
"<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>". |
|
"<td bgcolor='#5555FF'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>"; |
} |
} |
|
|
# Add the graphic |
# Add the graphic |
$template .= <<"ENDTEMPLATE"; |
$template .= <<"ENDTEMPLATE"; |
<a href="$link"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a> |
<a href="$link"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a> |
ENDTEMPLATE |
ENDTEMPLATE |
|
if ($text ne '') { $template.='</td></tr></table>' }; |
return $template; |
return $template; |
|
|
} |
} |
Line 560 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 633 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 674 See loncreateuser.pm for invocation and
|
Line 844 See loncreateuser.pm for invocation and
|
sub authform_header{ |
sub authform_header{ |
my %in = ( |
my %in = ( |
formname => 'cu', |
formname => 'cu', |
kerb_def_dom => 'MSU.EDU', |
kerb_def_dom => '', |
@_, |
@_, |
); |
); |
$in{'formname'} = 'document.' . $in{'formname'}; |
$in{'formname'} = 'document.' . $in{'formname'}; |
my $result=''; |
my $result=''; |
|
|
|
#---------------------------------------------- Code for upper case translation |
|
my $Javascript_toUpperCase; |
|
unless ($in{kerb_def_dom}) { |
|
$Javascript_toUpperCase =<<"END"; |
|
switch (choice) { |
|
case 'krb': currentform.elements[choicearg].value = |
|
currentform.elements[choicearg].value.toUpperCase(); |
|
break; |
|
default: |
|
} |
|
END |
|
} else { |
|
$Javascript_toUpperCase = ""; |
|
} |
|
|
$result.=<<"END"; |
$result.=<<"END"; |
var current = new Object(); |
var current = new Object(); |
current.radiovalue = 'nochange'; |
current.radiovalue = 'nochange'; |
Line 712 function changed_radio(choice,currentfor
|
Line 898 function changed_radio(choice,currentfor
|
function changed_text(choice,currentform) { |
function changed_text(choice,currentform) { |
var choicearg = choice + 'arg'; |
var choicearg = choice + 'arg'; |
if (currentform.elements[choicearg].value !='') { |
if (currentform.elements[choicearg].value !='') { |
switch (choice) { |
$Javascript_toUpperCase |
case 'krb': currentform.elements[choicearg].value = |
|
currentform.elements[choicearg].value.toUpperCase(); |
|
break; |
|
default: |
|
} |
|
// clear old field |
// clear old field |
if ((current.argfield != choicearg) && (current.argfield != null)) { |
if ((current.argfield != choicearg) && (current.argfield != null)) { |
currentform.elements[current.argfield].value = ''; |
currentform.elements[current.argfield].value = ''; |
Line 773 sub authform_kerberos{
|
Line 954 sub authform_kerberos{
|
my %in = ( |
my %in = ( |
formname => 'document.cu', |
formname => 'document.cu', |
kerb_def_dom => 'MSU.EDU', |
kerb_def_dom => 'MSU.EDU', |
|
kerb_def_auth => 'krb4', |
@_, |
@_, |
); |
); |
my $result=''; |
my $result=''; |
|
my $check4; |
|
my $check5; |
|
if ($in{'kerb_def_auth'} eq 'krb5') { |
|
$check5 = " checked=\"on\""; |
|
} else { |
|
$check4 = " checked=\"on\""; |
|
} |
$result.=<<"END"; |
$result.=<<"END"; |
<input type="radio" name="login" value="krb" |
<input type="radio" name="login" value="krb" |
onclick="javascript:changed_radio('krb',$in{'formname'});" |
onclick="javascript:changed_radio('krb',$in{'formname'});" |
onchange="javascript:changed_radio('krb',$in{'formname'});" /> |
onchange="javascript:changed_radio('krb',$in{'formname'});" /> |
Kerberos authenticated with domain |
Kerberos authenticated with domain |
<input type="text" size="10" name="krbarg" value="" |
<input type="text" size="10" name="krbarg" value="$in{'kerb_def_dom'}" |
onchange="javascript:changed_text('krb',$in{'formname'});" /> |
onchange="javascript:changed_text('krb',$in{'formname'});" /> |
<input type="radio" name="krbver" value="4" checked="on" />Version 4 |
<input type="radio" name="krbver" value="4" $check4 />Version 4 |
<input type="radio" name="krbver" value="5" />Version 5 |
<input type="radio" name="krbver" value="5" $check5 />Version 5 |
END |
END |
return $result; |
return $result; |
} |
} |
Line 802 sub authform_internal{
|
Line 991 sub authform_internal{
|
onclick="javascript:changed_radio('int',$args{'formname'});" /> |
onclick="javascript:changed_radio('int',$args{'formname'});" /> |
Internally authenticated (with initial password |
Internally authenticated (with initial password |
<input type="text" size="10" name="intarg" value="" |
<input type="text" size="10" name="intarg" value="" |
onchange="javascript:changed_text('int',$args{'formname'});" /> |
onchange="javascript:changed_text('int',$args{'formname'});" />) |
END |
END |
return $result; |
return $result; |
} |
} |
Line 838 sub authform_filesystem{
|
Line 1027 sub authform_filesystem{
|
onclick="javascript:changed_radio('fsys',$in{'formname'});" /> |
onclick="javascript:changed_radio('fsys',$in{'formname'});" /> |
Filesystem authenticated (with initial password |
Filesystem authenticated (with initial password |
<input type="text" size="10" name="fsysarg" value="" |
<input type="text" size="10" name="fsysarg" value="" |
onchange="javascript:changed_text('fsys',$in{'formname'});"> |
onchange="javascript:changed_text('fsys',$in{'formname'});">) |
END |
END |
return $result; |
return $result; |
} |
} |
Line 848 END
|
Line 1037 END
|
############################################################### |
############################################################### |
|
|
############################################################### |
############################################################### |
|
## Get Authentication Defaults for Domain ## |
|
############################################################### |
|
## |
|
## Returns default authentication type and an associated argument |
|
## as listed in file domain.tab |
|
## |
|
#------------------------------------------- |
|
|
|
=pod |
|
|
|
=item get_auth_defaults |
|
|
|
get_auth_defaults($target_domain) returns the default authentication |
|
type and an associated argument (initial password or a kerberos domain). |
|
These values are stored in lonTabs/domain.tab |
|
|
|
($def_auth, $def_arg) = &get_auth_defaults($target_domain); |
|
|
|
If target_domain is not found in domain.tab, returns nothing (''). |
|
|
|
=over 4 |
|
|
|
=item get_auth_defaults |
|
|
|
=back |
|
|
|
=cut |
|
|
|
#------------------------------------------- |
|
sub get_auth_defaults { |
|
my $domain=shift; |
|
return ($Apache::lonnet::domain_auth_def{$domain},$Apache::lonnet::domain_auth_arg_def{$domain}); |
|
} |
|
############################################################### |
|
## End Get Authentication Defaults for Domain ## |
|
############################################################### |
|
|
|
############################################################### |
|
## Get Kerberos Defaults for Domain ## |
|
############################################################### |
|
## |
|
## Returns default kerberos version and an associated argument |
|
## as listed in file domain.tab. If not listed, provides |
|
## appropriate default domain and kerberos version. |
|
## |
|
#------------------------------------------- |
|
|
|
=pod |
|
|
|
=item get_kerberos_defaults |
|
|
|
get_kerberos_defaults($target_domain) returns the default kerberos |
|
version and domain. If not found in domain.tabs, it defaults to |
|
version 4 and the domain of the server. |
|
|
|
($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain); |
|
|
|
=over 4 |
|
|
|
=item get_kerberos_defaults |
|
|
|
=back |
|
|
|
=cut |
|
|
|
#------------------------------------------- |
|
sub get_kerberos_defaults { |
|
my $domain=shift; |
|
my ($krbdef,$krbdefdom) = |
|
&Apache::loncommon::get_auth_defaults($domain); |
|
unless ($krbdef =~/^krb/ && $krbdefdom) { |
|
$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/; |
|
my $krbdefdom=$1; |
|
$krbdefdom=~tr/a-z/A-Z/; |
|
$krbdef = "krb4"; |
|
} |
|
return ($krbdef,$krbdefdom); |
|
} |
|
############################################################### |
|
## End Get Kerberos Defaults for Domain ## |
|
############################################################### |
|
|
|
############################################################### |
## Thesaurus Functions ## |
## Thesaurus Functions ## |
############################################################### |
############################################################### |
|
|
Line 961 sub get_related_words {
|
Line 1233 sub get_related_words {
|
############################################################### |
############################################################### |
|
|
# -------------------------------------------------------------- Plaintext name |
# -------------------------------------------------------------- Plaintext name |
|
=pod |
|
|
|
=item plainname($uname,$udom) |
|
|
|
Gets a users name and returns it as a string in |
|
"first middle last generation" |
|
form |
|
|
|
=cut |
|
|
|
############################################################### |
sub plainname { |
sub plainname { |
my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
my %names=&Apache::lonnet::get('environment', |
my %names=&Apache::lonnet::get('environment', |
Line 974 sub plainname {
|
Line 1256 sub plainname {
|
return $name; |
return $name; |
} |
} |
|
|
|
# -------------------------------------------------------------------- Nickname |
|
=pod |
|
|
|
=item nickname($uname,$udom) |
|
|
|
Gets a users name and returns it as a string as |
|
|
|
""nickname"" |
|
|
|
if the user has a nickname or |
|
|
|
"first middle last generation" |
|
|
|
if the user does not |
|
|
|
=cut |
|
|
|
sub nickname { |
|
my ($uname,$udom)=@_; |
|
my %names=&Apache::lonnet::get('environment', |
|
['nickname','firstname','middlename','lastname','generation'],$udom,$uname); |
|
my $name=$names{'nickname'}; |
|
if ($name) { |
|
$name='"'.$name.'"'; |
|
} else { |
|
$name=$names{'firstname'}.' '.$names{'middlename'}.' '. |
|
$names{'lastname'}.' '.$names{'generation'}; |
|
$name=~s/\s+$//; |
|
$name=~s/\s+/ /g; |
|
} |
|
return $name; |
|
} |
|
|
|
|
# ------------------------------------------------------------------ Screenname |
# ------------------------------------------------------------------ Screenname |
|
|
|
=pod |
|
|
|
=item screenname($uname,$udom) |
|
|
|
Gets a users screenname and returns it as a string |
|
|
|
=cut |
|
|
sub screenname { |
sub screenname { |
my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
my %names= |
my %names= |
Line 990 sub messagewrapper {
|
Line 1314 sub messagewrapper {
|
return |
return |
"<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>"; |
"<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>"; |
} |
} |
|
# --------------------------------------------------------------- Notes Wrapper |
|
|
|
sub noteswrapper { |
|
my ($link,$un,$do)=@_; |
|
return |
|
"<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>"; |
|
} |
# ------------------------------------------------------------- Aboutme Wrapper |
# ------------------------------------------------------------- Aboutme Wrapper |
|
|
sub aboutmewrapper { |
sub aboutmewrapper { |
my ($link,$un,$do)=@_; |
my ($link,$username,$domain)=@_; |
return "<a href='/adm/$do/$un/aboutme'>$link</a>"; |
return "<a href='/adm/$domain/$username/aboutme'>$link</a>"; |
} |
} |
|
|
# ------------------------------------------------------------ Syllabus Wrapper |
# ------------------------------------------------------------ Syllabus Wrapper |
|
|
|
|
sub syllabuswrapper { |
sub syllabuswrapper { |
my ($link,$un,$do)=@_; |
my ($link,$un,$do,$tf)=@_; |
|
if ($tf) { $link='<font color="'.$tf.'">'.$link.'</font>'; } |
return "<a href='/public/$do/$un/syllabus'>$link</a>"; |
return "<a href='/public/$do/$un/syllabus'>$link</a>"; |
} |
} |
|
|
Line 1015 sub languagedescription {
|
Line 1347 sub languagedescription {
|
return $language{shift(@_)}; |
return $language{shift(@_)}; |
} |
} |
|
|
|
# ----------------------------------------------------------- Display Languages |
|
# returns a hash with all desired display languages |
|
# |
|
|
|
sub display_languages { |
|
my %languages=(); |
|
if ($ENV{'environment.languages'}) { |
|
foreach (split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'})) { |
|
$languages{$_}=1; |
|
} |
|
} |
|
&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']); |
|
if ($ENV{'form.displaylanguage'}) { |
|
foreach (split(/\s*(\,|\;|\:)\s*/,$ENV{'form.displaylanguage'})) { |
|
$languages{$_}=1; |
|
} |
|
} |
|
return %languages; |
|
} |
|
|
# --------------------------------------------------------------- Copyright IDs |
# --------------------------------------------------------------- Copyright IDs |
sub copyrightids { |
sub copyrightids { |
return sort(keys(%cprtag)); |
return sort(keys(%cprtag)); |
Line 1160 sub get_student_view {
|
Line 1512 sub get_student_view {
|
} |
} |
|
|
sub get_student_answers { |
sub get_student_answers { |
my ($symb,$username,$domain,$courseid) = @_; |
my ($symb,$username,$domain,$courseid,%form) = @_; |
my ($map,$id,$feedurl) = split(/___/,$symb); |
my ($map,$id,$feedurl) = split(/___/,$symb); |
my (%old,%moreenv); |
my (%old,%moreenv); |
my @elements=('symb','courseid','domain','username'); |
my @elements=('symb','courseid','domain','username'); |
Line 1170 sub get_student_answers {
|
Line 1522 sub get_student_answers {
|
} |
} |
$moreenv{'form.grade_target'}='answer'; |
$moreenv{'form.grade_target'}='answer'; |
&Apache::lonnet::appenv(%moreenv); |
&Apache::lonnet::appenv(%moreenv); |
my $userview=&Apache::lonnet::ssi('/res/'.$feedurl); |
my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%form); |
&Apache::lonnet::delenv('form.grade_'); |
&Apache::lonnet::delenv('form.grade_'); |
foreach my $element (@elements) { |
foreach my $element (@elements) { |
$ENV{'form.grade_'.$element}=$old{$element}; |
$ENV{'form.grade_'.$element}=$old{$element}; |
Line 1202 sub maketime {
|
Line 1554 sub maketime {
|
} |
} |
|
|
|
|
|
######################################### |
|
# |
|
# Retro-fixing of un-backward-compatible time format |
|
|
|
sub unsqltime { |
|
my $timestamp=shift; |
|
if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) { |
|
$timestamp=&maketime( |
|
'year'=>$1,'month'=>$2,'day'=>$3, |
|
'hours'=>$4,'minutes'=>$5,'seconds'=>$6); |
|
} |
|
return $timestamp; |
|
} |
|
|
|
######################################### |
|
|
sub findallcourses { |
sub findallcourses { |
my %courses=(); |
my %courses=(); |
my $now=time; |
my $now=time; |
Line 1263 sub domainlogo {
|
Line 1631 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="/adm/lonDomLogos/'.$domain.'.gif" />'; |
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; |
|
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 1284 Returns: value of designparamter $which
|
Line 1655 Returns: value of designparamter $which
|
############################################## |
############################################## |
sub designparm { |
sub designparm { |
my ($which,$domain)=@_; |
my ($which,$domain)=@_; |
|
if ($ENV{'environment.color.'.$which}) { |
|
return $ENV{'environment.color.'.$which}; |
|
} |
$domain=&determinedomain($domain); |
$domain=&determinedomain($domain); |
if ($designhash{$domain.'.'.$which}) { |
if ($designhash{$domain.'.'.$which}) { |
return $designhash{$domain.'.'.$which}; |
return $designhash{$domain.'.'.$which}; |
Line 1308 Inputs:
|
Line 1682 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 1321 other decorations will be returned.
|
Line 1697 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 1355 sub bodytag {
|
Line 1731 sub bodytag {
|
unless ($realm) { $realm=' '; } |
unless ($realm) { $realm=' '; } |
# Set messages |
# Set messages |
my $messages=&domainlogo($domain); |
my $messages=&domainlogo($domain); |
# Output |
# Port for miniserver |
|
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; |
|
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } |
|
# construct main body tag |
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> |
END |
END |
|
my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'. |
|
$lonhttpdPort.$img.'" />'; |
if ($bodyonly) { |
if ($bodyonly) { |
return $bodytag; |
return $bodytag; |
} else { |
} elsif ($ENV{'browser.interface'} eq 'textual') { |
return(<<ENDBODY); |
# Accessibility |
|
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', |
|
$forcereg). |
|
'<h1>LON-CAPA: '.$title.'</h1>'; |
|
} elsif ($ENV{'environment.remote'} eq 'off') { |
|
# No Remote |
|
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', |
|
$forcereg). |
|
'<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td bgcolor="'.$tabbg.'"><font size="+3" color="'.$font.'"><b>'.$title. |
|
'</b></font></td></tr></table>'; |
|
} |
|
|
|
# |
|
# Top frame rendering, Remote is up |
|
# |
|
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="$sidebg"> |
<img src="$img" /></td> |
$upperleft</td> |
<td bgcolor="$font"><font color='$sidebg'>$messages</font></td> |
<td bgcolor="$sidebg" align="right">$messages </td> |
</tr> |
</tr> |
<tr> |
<tr> |
<td rowspan="3" bgcolor="$tabbg"> |
<td rowspan="3" bgcolor="$tabbg"> |
Line 1389 $bodytag
|
Line 1785 $bodytag
|
<td bgcolor="$tabbg" align="right"><font size="2">$realm</font> </td></tr> |
<td bgcolor="$tabbg" align="right"><font size="2">$realm</font> </td></tr> |
</table><br> |
</table><br> |
ENDBODY |
ENDBODY |
|
} |
|
|
|
############################################### |
|
|
|
sub get_posted_cgi { |
|
my $r=shift; |
|
|
|
my $buffer; |
|
|
|
$r->read($buffer,$r->header_in('Content-length'),0); |
|
unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) { |
|
my @pairs=split(/&/,$buffer); |
|
my $pair; |
|
foreach $pair (@pairs) { |
|
my ($name,$value) = split(/=/,$pair); |
|
$value =~ tr/+/ /; |
|
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
$name =~ tr/+/ /; |
|
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
&add_to_env("form.$name",$value); |
|
} |
|
} else { |
|
my $contentsep=$1; |
|
my @lines = split (/\n/,$buffer); |
|
my $name=''; |
|
my $value=''; |
|
my $fname=''; |
|
my $fmime=''; |
|
my $i; |
|
for ($i=0;$i<=$#lines;$i++) { |
|
if ($lines[$i]=~/^$contentsep/) { |
|
if ($name) { |
|
chomp($value); |
|
if ($fname) { |
|
$ENV{"form.$name.filename"}=$fname; |
|
$ENV{"form.$name.mimetype"}=$fmime; |
|
} else { |
|
$value=~s/\s+$//s; |
|
} |
|
&add_to_env("form.$name",$value); |
|
} |
|
if ($i<$#lines) { |
|
$i++; |
|
$lines[$i]=~ |
|
/Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i; |
|
$name=$1; |
|
$value=''; |
|
if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) { |
|
$fname=$1; |
|
if |
|
($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) { |
|
$fmime=$1; |
|
$i++; |
|
} else { |
|
$fmime=''; |
|
} |
|
} else { |
|
$fname=''; |
|
$fmime=''; |
|
} |
|
$i++; |
|
} |
|
} else { |
|
$value.=$lines[$i]."\n"; |
|
} |
|
} |
} |
} |
|
$ENV{'request.method'}=$ENV{'REQUEST_METHOD'}; |
|
$r->method_number(M_GET); |
|
$r->method('GET'); |
|
$r->headers_in->unset('Content-length'); |
} |
} |
|
|
############################################### |
############################################### |
|
|
sub get_unprocessed_cgi { |
sub get_unprocessed_cgi { |
Line 1693 sub csv_samples_select_table {
|
Line 2160 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__; |
|
|
Line 1781 will result in $ENV{'form.uname'} and $E
|
Line 2279 will result in $ENV{'form.uname'} and $E
|
|
|
returns cache-controlling header code |
returns cache-controlling header code |
|
|
=item nocache() |
=item no_cache($r) |
|
|
specifies header code to not have cache |
specifies header code to not have cache |
|
|