version 1.118, 2003/09/17 14:30:13
|
version 1.147, 2003/11/10 01:59:55
|
Line 69 use Apache::Constants qw(:common :http :
|
Line 69 use Apache::Constants qw(:common :http :
|
use Apache::lonmsg(); |
use Apache::lonmsg(); |
use Apache::lonmenu(); |
use Apache::lonmenu(); |
use Apache::lonlocal; |
use Apache::lonlocal; |
|
use HTML::Entities; |
|
|
my $readit; |
my $readit; |
|
|
Line 80 my $readit;
|
Line 81 my $readit;
|
|
|
# ----------------------------------------------- Filetypes/Languages/Copyright |
# ----------------------------------------------- Filetypes/Languages/Copyright |
my %language; |
my %language; |
|
my %supported_language; |
my %cprtag; |
my %cprtag; |
my %fe; my %fd; |
my %fe; my %fd; |
my %category_extensions; |
my %category_extensions; |
Line 89 my %category_extensions;
|
Line 91 my %category_extensions;
|
my %designhash; |
my %designhash; |
|
|
# ---------------------------------------------- Thesaurus variables |
# ---------------------------------------------- Thesaurus variables |
|
# |
# FIXME: I don't think it's necessary to document these things; |
# %Keywords: |
# they're privately used - Jeremy |
# A hash used by &keyword to determine if a word is considered a keyword. |
|
# $thesaurus_db_file |
=pod |
# Scalar containing the full path to the thesaurus database. |
|
|
=over 4 |
|
|
|
=item * %Keywords |
|
|
|
A hash used by &keyword to determine if a word is considered a keyword. |
|
|
|
=item * $thesaurus_db_file |
|
|
|
Scalar containing the full path to the thesaurus database. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
my %Keywords; |
my %Keywords; |
my $thesaurus_db_file; |
my $thesaurus_db_file; |
|
|
# ----------------------------------------------------------------------- BEGIN |
# |
|
# Initialize values from language.tab, copyright.tab, filetypes.tab, |
# FIXME: I don't think this needs to be documented, it prepares |
# thesaurus.tab, and filecategories.tab. |
# private data structures - Jeremy |
# |
=pod |
|
|
|
=head1 General Subroutines |
|
|
|
=over 4 |
|
|
|
=item * BEGIN() |
|
|
|
Initialize values from language.tab, copyright.tab, filetypes.tab, |
|
thesaurus.tab, and filecategories.tab. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
# ----------------------------------------------------------------------- BEGIN |
|
|
|
BEGIN { |
BEGIN { |
# Variable initialization |
# Variable initialization |
$thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db"; |
$thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db"; |
Line 146 BEGIN {
|
Line 117 BEGIN {
|
while (<$fh>) { |
while (<$fh>) { |
next if /^\#/; |
next if /^\#/; |
chomp; |
chomp; |
my ($key,$two,$country,$three,$enc,$val)=(split(/\t/,$_)); |
my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_)); |
$language{$key}=$val.' - '.$enc; |
$language{$key}=$val.' - '.$enc; |
|
if ($sup) { |
|
$supported_language{$key}=$sup; |
|
} |
} |
} |
} |
} |
} |
} |
Line 230 BEGIN {
|
Line 204 BEGIN {
|
|
|
=pod |
=pod |
|
|
|
=head1 General Subroutines |
|
|
|
=over 4 |
|
|
=head1 HTML and Javascript Functions |
=head1 HTML and Javascript Functions |
|
|
=over 4 |
=over 4 |
Line 270 of the element the selection from the se
|
Line 248 of the element the selection from the se
|
sub browser_and_searcher_javascript { |
sub browser_and_searcher_javascript { |
return <<END; |
return <<END; |
var editbrowser = null; |
var editbrowser = null; |
function openbrowser(formname,elementname,only,omit) { |
function openbrowser(formname,elementname,only,omit,titleelement) { |
var url = '/res/?'; |
var url = '/res/?'; |
if (editbrowser == null) { |
if (editbrowser == null) { |
url += 'launch=1&'; |
url += 'launch=1&'; |
Line 284 sub browser_and_searcher_javascript {
|
Line 262 sub browser_and_searcher_javascript {
|
if (omit != null) { |
if (omit != null) { |
url += 'omit=' + omit + '&'; |
url += 'omit=' + omit + '&'; |
} |
} |
|
if (titleelement != null) { |
|
url += 'titleelement=' + titleelement + '&'; |
|
} |
url += 'element=' + elementname + ''; |
url += 'element=' + elementname + ''; |
var title = 'Browser'; |
var title = 'Browser'; |
var options = 'scrollbars=1,resizable=1,menubar=0'; |
var options = 'scrollbars=1,resizable=1,menubar=0'; |
Line 292 sub browser_and_searcher_javascript {
|
Line 273 sub browser_and_searcher_javascript {
|
editbrowser.focus(); |
editbrowser.focus(); |
} |
} |
var editsearcher; |
var editsearcher; |
function opensearcher(formname,elementname) { |
function opensearcher(formname,elementname,titleelement) { |
var url = '/adm/searchcat?'; |
var url = '/adm/searchcat?'; |
if (editsearcher == null) { |
if (editsearcher == null) { |
url += 'launch=1&'; |
url += 'launch=1&'; |
Line 300 sub browser_and_searcher_javascript {
|
Line 281 sub browser_and_searcher_javascript {
|
url += 'catalogmode=interactive&'; |
url += 'catalogmode=interactive&'; |
url += 'mode=edit&'; |
url += 'mode=edit&'; |
url += 'form=' + formname + '&'; |
url += 'form=' + formname + '&'; |
|
if (titleelement != null) { |
|
url += 'titleelement=' + titleelement + '&'; |
|
} |
url += 'element=' + elementname + ''; |
url += 'element=' + elementname + ''; |
var title = 'Search'; |
var title = 'Search'; |
var options = 'scrollbars=1,resizable=1,menubar=0'; |
var options = 'scrollbars=1,resizable=1,menubar=0'; |
Line 348 sub selectstudent_link {
|
Line 332 sub selectstudent_link {
|
return ''; |
return ''; |
} |
} |
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
'","'.$udomele.'");'."'>Select User</a>"; |
'","'.$udomele.'");'."'>".&mt('Select User')."</a>"; |
} |
} |
if ($ENV{'request.role'}=~/^(au|dc|su)/) { |
if ($ENV{'request.role'}=~/^(au|dc|su)/) { |
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
'","'.$udomele.'",1);'."'>Select User</a>"; |
'","'.$udomele.'",1);'."'>".&mt('Select User')."</a>"; |
} |
} |
return ''; |
return ''; |
} |
} |
|
|
sub coursebrowser_javascript { |
sub coursebrowser_javascript { |
return (<<'ENDSTDBRW'); |
my ($domainfilter)=@_; |
|
return (<<ENDSTDBRW); |
<script type="text/javascript" language="Javascript" > |
<script type="text/javascript" language="Javascript" > |
var stdeditbrowser; |
var stdeditbrowser; |
function opencrsbrowser(formname,uname,udom) { |
function opencrsbrowser(formname,uname,udom) { |
Line 369 sub coursebrowser_javascript {
|
Line 354 sub coursebrowser_javascript {
|
url += 'filter='+filter+'&'; |
url += 'filter='+filter+'&'; |
} |
} |
} |
} |
|
var domainfilter='$domainfilter'; |
|
if (domainfilter != null) { |
|
if (domainfilter != '') { |
|
url += 'domainfilter='+domainfilter+'&'; |
|
} |
|
} |
url += 'form=' + formname + '&cnumelement='+uname+ |
url += 'form=' + formname + '&cnumelement='+uname+ |
'&cdomelement='+udom; |
'&cdomelement='+udom; |
var title = 'Course_Browser'; |
var title = 'Course_Browser'; |
Line 384 ENDSTDBRW
|
Line 375 ENDSTDBRW
|
sub selectcourse_link { |
sub selectcourse_link { |
my ($form,$unameele,$udomele)=@_; |
my ($form,$unameele,$udomele)=@_; |
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele. |
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele. |
'","'.$udomele.'");'."'>Select Course</a>"; |
'","'.$udomele.'");'."'>".&mt('Select Course')."</a>"; |
} |
} |
|
|
=pod |
=pod |
Line 503 function select1_changed() {
|
Line 494 function select1_changed() {
|
// in with the nuclear |
// in with the nuclear |
for (i=0;i<values.length; i++) { |
for (i=0;i<values.length; i++) { |
$second.options[i] = new Option(values[i]); |
$second.options[i] = new Option(values[i]); |
|
$second.options[i].value = values[i]; |
$second.options[i].text = texts[i]; |
$second.options[i].text = texts[i]; |
if (values[i] == select2def) { |
if (values[i] == select2def) { |
$second.options[i].selected = true; |
$second.options[i].selected = true; |
Line 516 END
|
Line 508 END
|
foreach my $value (sort(keys(%$hashref))) { |
foreach my $value (sort(keys(%$hashref))) { |
$result.=" <option value=\"$value\" "; |
$result.=" <option value=\"$value\" "; |
$result.=" selected=\"true\" " if ($value eq $firstdefault); |
$result.=" selected=\"true\" " if ($value eq $firstdefault); |
$result.=">$hashref->{$value}->{'text'}</option>\n"; |
$result.=">".&mt($hashref->{$value}->{'text'})."</option>\n"; |
} |
} |
$result .= "</select>\n"; |
$result .= "</select>\n"; |
my %select2 = %{$hashref->{$firstdefault}->{'select2'}}; |
my %select2 = %{$hashref->{$firstdefault}->{'select2'}}; |
Line 526 END
|
Line 518 END
|
foreach my $value (sort(keys(%select2))) { |
foreach my $value (sort(keys(%select2))) { |
$result.=" <option value=\"$value\" "; |
$result.=" <option value=\"$value\" "; |
$result.=" selected=\"true\" " if ($value eq $seconddefault); |
$result.=" selected=\"true\" " if ($value eq $seconddefault); |
$result.=">$select2{$value}</option>\n"; |
$result.=">".&mt($select2{$value})."</option>\n"; |
} |
} |
$result .= "</select>\n"; |
$result .= "</select>\n"; |
# return $debug; |
# return $debug; |
Line 764 See lonrights.pm for an example invocati
|
Line 756 See lonrights.pm for an example invocati
|
sub select_form { |
sub select_form { |
my ($def,$name,%hash) = @_; |
my ($def,$name,%hash) = @_; |
my $selectform = "<select name=\"$name\" size=\"1\">\n"; |
my $selectform = "<select name=\"$name\" size=\"1\">\n"; |
foreach (sort keys %hash) { |
my @keys; |
|
if (exists($hash{'select_form_order'})) { |
|
@keys=@{$hash{'select_form_order'}}; |
|
} else { |
|
@keys=sort(keys(%hash)); |
|
} |
|
foreach (@keys) { |
$selectform.="<option value=\"$_\" ". |
$selectform.="<option value=\"$_\" ". |
($_ eq $def ? 'selected' : ''). |
($_ eq $def ? 'selected' : ''). |
">".$hash{$_}."</option>\n"; |
">".&mt($hash{$_})."</option>\n"; |
} |
} |
$selectform.="</select>"; |
$selectform.="</select>"; |
return $selectform; |
return $selectform; |
Line 1063 END
|
Line 1061 END
|
|
|
sub authform_authorwarning{ |
sub authform_authorwarning{ |
my $result=''; |
my $result=''; |
$result=<<"END"; |
$result='<i>'. |
<i>As a general rule, only authors or co-authors should be filesystem |
&mt('As a general rule, only authors or co-authors should be '. |
authenticated (which allows access to the server filesystem).</i> |
'filesystem authenticated '. |
END |
'(which allows access to the server filesystem).')."</i>\n"; |
return $result; |
return $result; |
} |
} |
|
|
Line 1076 sub authform_nochange{
|
Line 1074 sub authform_nochange{
|
kerb_def_dom => 'MSU.EDU', |
kerb_def_dom => 'MSU.EDU', |
@_, |
@_, |
); |
); |
my $result=''; |
my $result = &mt('[_1] Do not change login data', |
$result.=<<"END"; |
'<input type="radio" name="login" value="nochange" '. |
<input type="radio" name="login" value="nochange" checked="checked" |
'checked="checked" onclick="'. |
onclick="javascript:changed_radio('nochange',$in{'formname'});" /> |
"javascript:changed_radio('nochange',$in{'formname'});".'" />'); |
Do not change login data |
|
END |
|
return $result; |
return $result; |
} |
} |
|
|
Line 1092 sub authform_kerberos{
|
Line 1088 sub authform_kerberos{
|
kerb_def_auth => 'krb4', |
kerb_def_auth => 'krb4', |
@_, |
@_, |
); |
); |
my $result=''; |
my ($check4,$check5); |
my $check4; |
|
my $check5; |
|
if ($in{'kerb_def_auth'} eq 'krb5') { |
if ($in{'kerb_def_auth'} eq 'krb5') { |
$check5 = " checked=\"on\""; |
$check5 = " checked=\"on\""; |
} else { |
} else { |
$check4 = " checked=\"on\""; |
$check4 = " checked=\"on\""; |
} |
} |
$result.=<<"END"; |
my $jscall = "javascript:changed_radio('krb',$in{'formname'});"; |
<input type="radio" name="login" value="krb" |
my $result .= &mt |
onclick="javascript:changed_radio('krb',$in{'formname'});" |
('[_1] Kerberos authenticated with domain [_2] '. |
onchange="javascript:changed_radio('krb',$in{'formname'});" /> |
'[_3] Version 4 [_4] Version 5', |
Kerberos authenticated with domain |
'<input type="radio" name="login" value="krb" '. |
<input type="text" size="10" name="krbarg" value="$in{'kerb_def_dom'}" |
'onclick="'.$jscall.'" onchange="'.$jscall.'" />', |
onchange="javascript:changed_text('krb',$in{'formname'});" /> |
'<input type="text" size="10" name="krbarg" '. |
<input type="radio" name="krbver" value="4" $check4 />Version 4 |
'value="'.$in{'kerb_def_dom'}.'" '. |
<input type="radio" name="krbver" value="5" $check5 />Version 5 |
'onchange="'.$jscall.'" />', |
END |
'<input type="radio" name="krbver" value="4" '.$check4.' />', |
|
'<input type="radio" name="krbver" value="5" '.$check5.' />'); |
return $result; |
return $result; |
} |
} |
|
|
Line 1119 sub authform_internal{
|
Line 1114 sub authform_internal{
|
kerb_def_dom => 'MSU.EDU', |
kerb_def_dom => 'MSU.EDU', |
@_, |
@_, |
); |
); |
my $result=''; |
my $jscall = "javascript:changed_radio('int',$args{'formname'});"; |
$result.=<<"END"; |
my $result.=&mt |
<input type="radio" name="login" value="int" |
('[_1] Internally authenticated (with initial password [_2])', |
onchange="javascript:changed_radio('int',$args{'formname'});" |
'<input type="radio" name="login" value="int" '. |
onclick="javascript:changed_radio('int',$args{'formname'});" /> |
'onchange="'.$jscall.'" onclick="'.$jscall.'" />', |
Internally authenticated (with initial password |
'<input type="text" size="10" name="intarg" value="" '. |
<input type="text" size="10" name="intarg" value="" |
'onchange="'.$jscall.'" />'); |
onchange="javascript:changed_text('int',$args{'formname'});" />) |
|
END |
|
return $result; |
return $result; |
} |
} |
|
|
Line 1137 sub authform_local{
|
Line 1130 sub authform_local{
|
kerb_def_dom => 'MSU.EDU', |
kerb_def_dom => 'MSU.EDU', |
@_, |
@_, |
); |
); |
my $result=''; |
my $jscall = "javascript:changed_radio('loc',$in{'formname'});"; |
$result.=<<"END"; |
my $result.=&mt('[_1] Local Authentication with arguement [_2]', |
<input type="radio" name="login" value="loc" |
'<input type="radio" name="login" value="loc" '. |
onchange="javascript:changed_radio('loc',$in{'formname'});" |
'onchange="'.$jscall.'" onclick="'.$jscall.'" />', |
onclick="javascript:changed_radio('loc',$in{'formname'});" /> |
'<input type="text" size="10" name="locarg" value="" '. |
Local Authentication with argument |
'onchange="'.$jscall.'" />'); |
<input type="text" size="10" name="locarg" value="" |
|
onchange="javascript:changed_text('loc',$in{'formname'});" /> |
|
END |
|
return $result; |
return $result; |
} |
} |
|
|
Line 1155 sub authform_filesystem{
|
Line 1145 sub authform_filesystem{
|
kerb_def_dom => 'MSU.EDU', |
kerb_def_dom => 'MSU.EDU', |
@_, |
@_, |
); |
); |
my $result=''; |
my $jscall = "javascript:changed_radio('fsys',$in{'formname'});"; |
$result.=<<"END"; |
my $result.= &mt |
<input type="radio" name="login" value="fsys" |
('[_1] Filesystem Authenticated (with initial password [_2])', |
onchange="javascript:changed_radio('fsys',$in{'formname'});" |
'<input type="radio" name="login" value="fsys" '. |
onclick="javascript:changed_radio('fsys',$in{'formname'});" /> |
'onchange="'.$jscall.'" onclick="'.$jscall.'" />', |
Filesystem authenticated (with initial password |
'<input type="text" size="10" name="fsysarg" value="" '. |
<input type="text" size="10" name="fsysarg" value="" |
'onchange="'.$jscall.'" />'); |
onchange="javascript:changed_text('fsys',$in{'formname'});">) |
|
END |
|
return $result; |
return $result; |
} |
} |
|
|
Line 1505 returns description of a specified langu
|
Line 1493 returns description of a specified langu
|
=cut |
=cut |
|
|
sub languagedescription { |
sub languagedescription { |
return $language{shift(@_)}; |
my $code=shift; |
|
return ($supported_language{$code}?'* ':''). |
|
$language{$code}. |
|
($supported_language{$code}?' ('.&mt('interface available').')':''); |
|
} |
|
|
|
sub plainlanguagedescription { |
|
my $code=shift; |
|
return $language{$code}; |
|
} |
|
|
|
sub supportedlanguagecode { |
|
my $code=shift; |
|
return $supported_language{$code}; |
} |
} |
|
|
=pod |
=pod |
Line 1661 sub preferred_languages {
|
Line 1662 sub preferred_languages {
|
push (@genlanguages,(split(/(\-|\_)/,$_))[0]); |
push (@genlanguages,(split(/(\-|\_)/,$_))[0]); |
} |
} |
} |
} |
&Apache::lonnet::logthis('Lang: '.join(',',@genlanguages)); |
|
return @genlanguages; |
return @genlanguages; |
} |
} |
|
|
Line 1745 sub get_previous_attempt {
|
Line 1745 sub get_previous_attempt {
|
} else { |
} else { |
$value=$returnhash{$version.':'.$_}; |
$value=$returnhash{$version.':'.$_}; |
} |
} |
$prevattempts.='<td>'.$value.' </td>'; |
$prevattempts.='<td>'.&Apache::lonnet::unescape($value).' </td>'; |
} |
} |
} |
} |
} |
} |
Line 1757 sub get_previous_attempt {
|
Line 1757 sub get_previous_attempt {
|
} else { |
} else { |
$value=$lasthash{$_}; |
$value=$lasthash{$_}; |
} |
} |
|
$value=&Apache::lonnet::unescape($value); |
if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)} |
if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)} |
$prevattempts.='<td>'.$value.' </td>'; |
$prevattempts.='<td>'.$value.' </td>'; |
} |
} |
Line 2117 sub bodytag {
|
Line 2118 sub bodytag {
|
my $sidebg=&designparm($function.'.sidebg',$domain); |
my $sidebg=&designparm($function.'.sidebg',$domain); |
# Accessibility font enhance |
# Accessibility font enhance |
unless ($addentries) { $addentries=''; } |
unless ($addentries) { $addentries=''; } |
|
my $addstyle=''; |
if ($ENV{'browser.fontenhance'} eq 'on') { |
if ($ENV{'browser.fontenhance'} eq 'on') { |
$addentries.=' style="font-size: x-large"'; |
$addstyle=' font-size: x-large;'; |
} |
} |
# role and realm |
# role and realm |
my ($role,$realm) |
my ($role,$realm) |
Line 2136 sub bodytag {
|
Line 2138 sub bodytag {
|
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } |
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } |
# construct main body tag |
# construct main body tag |
my $bodytag = <<END; |
my $bodytag = <<END; |
|
<style> |
|
h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif } |
|
a:hover { color: black; background: yellow } |
|
a:focus { color: red; background: yellow } |
|
</style> |
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link" |
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link" |
$addentries> |
style="border-color: $tabbg; border-width: 4px; border-style: solid; padding: 4px;$addstyle" $addentries> |
END |
END |
my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'. |
my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'. |
$lonhttpdPort.$img.'" />'; |
$lonhttpdPort.$img.'" />'; |
Line 2168 $upperleft</td>
|
Line 2175 $upperleft</td>
|
</tr> |
</tr> |
<tr> |
<tr> |
<td rowspan="3" bgcolor="$tabbg"> |
<td rowspan="3" bgcolor="$tabbg"> |
<font size="5"><b>$title</b></font> |
<font size="5" face="Arial, Helvetica, sans-serif"><b>$title</b></font> |
<td bgcolor="$tabbg" align="right"> |
<td bgcolor="$tabbg" align="right"> |
<font size="2"> |
<font size="2" face="Arial, Helvetica, sans-serif"> |
$ENV{'environment.firstname'} |
$ENV{'environment.firstname'} |
$ENV{'environment.middlename'} |
$ENV{'environment.middlename'} |
$ENV{'environment.lastname'} |
$ENV{'environment.lastname'} |
Line 2179 $upperleft</td>
|
Line 2186 $upperleft</td>
|
</td> |
</td> |
</tr> |
</tr> |
<tr><td bgcolor="$tabbg" align="right"> |
<tr><td bgcolor="$tabbg" align="right"> |
<font size="2">$role</font> |
<font size="2" face="Arial, Helvetica, sans-serif">$role</font> |
</td></tr> |
</td></tr> |
<tr> |
<tr> |
<td bgcolor="$tabbg" align="right"><font size="2">$realm</font> </td></tr> |
<td bgcolor="$tabbg" align="right"><font size="2">$realm</font> </td></tr> |
Line 2322 sub no_cache {
|
Line 2329 sub no_cache {
|
#$r->header_out("Expires" => $date); |
#$r->header_out("Expires" => $date); |
} |
} |
|
|
|
sub content_type { |
|
my ($r,$type,$charset) = @_; |
|
unless ($charset) { |
|
$charset=&Apache::lonlocal::current_encoding; |
|
} |
|
$r->content_type($type.($charset?'; charset='.$charset:'')); |
|
} |
|
|
=pod |
=pod |
|
|
=item * add_to_env($name,$value) |
=item * add_to_env($name,$value) |
Line 2474 sub record_sep {
|
Line 2489 sub record_sep {
|
return %components; |
return %components; |
} |
} |
|
|
|
###################################################### |
|
###################################################### |
|
|
=pod |
=pod |
|
|
=item * upfile_select_html() |
=item * upfile_select_html() |
|
|
return HTML code to select file and specify its type |
Return HTML code to select a file from the users machine and specify |
|
the file type. |
|
|
=cut |
=cut |
|
|
|
###################################################### |
|
###################################################### |
sub upfile_select_html { |
sub upfile_select_html { |
return (<<'ENDUPFORM'); |
my %Types = ( |
<input type="file" name="upfile" size="50" /> |
csv => &mt('CSV (comma separated values, spreadsheet)'), |
<br />Type: <select name="upfiletype"> |
space => &mt('Space separated'), |
<option value="csv">CSV (comma separated values, spreadsheet)</option> |
tab => &mt('Tabulator separated'), |
<option value="space">Space separated</option> |
# xml => &mt('HTML/XML'), |
<option value="tab">Tabulator separated</option> |
); |
<option value="xml">HTML/XML</option> |
my $Str = '<input type="file" name="upfile" size="50" />'. |
</select> |
'<br />Type: <select name="upfiletype">'; |
ENDUPFORM |
foreach my $type (sort(keys(%Types))) { |
|
$Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n"; |
|
} |
|
$Str .= "</select>\n"; |
|
return $Str; |
} |
} |
|
|
|
###################################################### |
|
###################################################### |
|
|
=pod |
=pod |
|
|
=item * csv_print_samples($r,$records) |
=item * csv_print_samples($r,$records) |
Line 2504 Apache Request ref, $records is an array
|
Line 2532 Apache Request ref, $records is an array
|
|
|
=cut |
=cut |
|
|
|
###################################################### |
|
###################################################### |
sub csv_print_samples { |
sub csv_print_samples { |
my ($r,$records) = @_; |
my ($r,$records) = @_; |
my (%sone,%stwo,%sthree); |
my (%sone,%stwo,%sthree); |
%sone=&record_sep($$records[0]); |
%sone=&record_sep($$records[0]); |
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} |
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} |
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} |
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} |
|
# |
$r->print('Samples<br /><table border="2"><tr>'); |
$r->print(&mt('Samples').'<br /><table border="2"><tr>'); |
foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column '.($_+1).'</th>'); } |
foreach (sort({$a <=> $b} keys(%sone))) { |
|
$r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); } |
$r->print('</tr>'); |
$r->print('</tr>'); |
foreach my $hash (\%sone,\%stwo,\%sthree) { |
foreach my $hash (\%sone,\%stwo,\%sthree) { |
$r->print('<tr>'); |
$r->print('<tr>'); |
Line 2526 sub csv_print_samples {
|
Line 2557 sub csv_print_samples {
|
$r->print('</tr></table><br />'."\n"); |
$r->print('</tr></table><br />'."\n"); |
} |
} |
|
|
|
###################################################### |
|
###################################################### |
|
|
=pod |
=pod |
|
|
=item * csv_print_select_table($r,$records,$d) |
=item * csv_print_select_table($r,$records,$d) |
|
|
Prints a table to create associations between values and table columns. |
Prints a table to create associations between values and table columns. |
|
|
$r is an Apache Request ref, |
$r is an Apache Request ref, |
$records is an arrayref from &Apache::loncommon::upfile_record_sep, |
$records is an arrayref from &Apache::loncommon::upfile_record_sep, |
$d is an array of 2 element arrays (internal name, displayed name) |
$d is an array of 2 element arrays (internal name, displayed name) |
|
|
=cut |
=cut |
|
|
|
###################################################### |
|
###################################################### |
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;my %sone; |
%sone=&record_sep($$records[0]); |
%sone=&record_sep($$records[0]); |
$r->print('Associate columns with student attributes.'."\n". |
$r->print(&mt('Associate columns with student attributes.')."\n". |
'<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n"); |
'<table border="2"><tr>'. |
|
'<th>'.&mt('Attribute').'</th>'. |
|
'<th>'.&mt('Column').'</th></tr>'."\n"); |
foreach (@$d) { |
foreach (@$d) { |
my ($value,$display)=@{ $_ }; |
my ($value,$display)=@{ $_ }; |
$r->print('<tr><td>'.$display.'</td>'); |
$r->print('<tr><td>'.$display.'</td>'); |
Line 2560 sub csv_print_select_table {
|
Line 2599 sub csv_print_select_table {
|
return $i; |
return $i; |
} |
} |
|
|
|
###################################################### |
|
###################################################### |
|
|
=pod |
=pod |
|
|
=item * csv_samples_select_table($r,$records,$d) |
=item * csv_samples_select_table($r,$records,$d) |
Line 2572 $d is an array of 2 element arrays (inte
|
Line 2614 $d is an array of 2 element arrays (inte
|
|
|
=cut |
=cut |
|
|
|
###################################################### |
|
###################################################### |
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 %sone; my %stwo; my %sthree; |
my $i=0; |
my $i=0; |
|
# |
$r->print('<table border=2><tr><th>Field</th><th>Samples</th></tr>'); |
$r->print('<table border=2><tr><th>'. |
|
&mt('Field').'</th><th>'.&mt('Samples').'</th></tr>'); |
%sone=&record_sep($$records[0]); |
%sone=&record_sep($$records[0]); |
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} |
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} |
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} |
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} |
|
# |
foreach (sort keys %sone) { |
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 (@$d) { |
my ($value,$display)=@{ $_ }; |
my ($value,$display)=@{ $_ }; |
$r->print('<option value='.$value.'>'.$display.'</option>'); |
$r->print('<option value="'.$value.'">'.$display.'</option>'); |
} |
} |
$r->print('</select></td><td>'); |
$r->print('</select></td><td>'); |
if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); } |
if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); } |
Line 2600 sub csv_samples_select_table {
|
Line 2645 sub csv_samples_select_table {
|
return($i); |
return($i); |
} |
} |
|
|
|
###################################################### |
|
###################################################### |
|
|
=pod |
=pod |
|
|
=item clean_excel_name($name) |
=item clean_excel_name($name) |
Line 2608 Returns a replacement for $name which do
|
Line 2656 Returns a replacement for $name which do
|
|
|
=cut |
=cut |
|
|
|
###################################################### |
|
###################################################### |
sub clean_excel_name { |
sub clean_excel_name { |
my ($name) = @_; |
my ($name) = @_; |
$name =~ s/[:\*\?\/\\]//g; |
$name =~ s/[:\*\?\/\\]//g; |
Line 2636 $uname, optional the username of the use
|
Line 2686 $uname, optional the username of the use
|
|
|
sub check_if_partid_hidden { |
sub check_if_partid_hidden { |
my ($id,$symb,$udom,$uname) = @_; |
my ($id,$symb,$udom,$uname) = @_; |
my $hiddenparts=&Apache::lonnet::EXT('resource.0.parameter_hiddenparts', |
my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts', |
$symb,$udom,$uname); |
$symb,$udom,$uname); |
|
my $truth=1; |
|
#if the string starts with !, then the list is the list to show not hide |
|
if ($hiddenparts=~s/^\s*!//) { $truth=undef; } |
my @hiddenlist=split(/,/,$hiddenparts); |
my @hiddenlist=split(/,/,$hiddenparts); |
foreach my $checkid (@hiddenlist) { |
foreach my $checkid (@hiddenlist) { |
if ($checkid =~ /^\s*\Q$id\E\s*$/) { return 1; } |
if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; } |
|
} |
|
return !$truth; |
|
} |
|
|
|
|
|
############################################################ |
|
############################################################ |
|
|
|
=pod |
|
|
|
=head1 cgi-bin script and graphing routines |
|
|
|
=item get_cgi_id |
|
|
|
Inputs: none |
|
|
|
Returns an id which can be used to pass environment variables |
|
to various cgi-bin scripts. These environment variables will |
|
be removed from the users environment after a given time by |
|
the routine &Apache::lonnet::transfer_profile_to_env. |
|
|
|
=cut |
|
|
|
############################################################ |
|
############################################################ |
|
|
|
sub get_cgi_id { |
|
return (time.'_'.int(rand(1000))); |
|
} |
|
|
|
############################################################ |
|
############################################################ |
|
|
|
=pod |
|
|
|
=item DrawBarGraph |
|
|
|
Facilitates the plotting of data in a (stacked) bar graph. |
|
Puts plot definition data into the users environment in order for |
|
graph.png to plot it. Returns an <img> tag for the plot. |
|
The bars on the plot are labeled '1','2',...,'n'. |
|
|
|
Inputs: |
|
|
|
=over 4 |
|
|
|
=item $Title: string, the title of the plot |
|
|
|
=item $xlabel: string, text describing the X-axis of the plot |
|
|
|
=item $ylabel: string, text describing the Y-axis of the plot |
|
|
|
=item $Max: scalar, the maximum Y value to use in the plot |
|
If $Max is < any data point, the graph will not be rendered. |
|
|
|
=item $colors: array ref holding the colors to be used for the data sets when |
|
they are plotted. If undefined, default values will be used. |
|
|
|
=item @Values: An array of array references. Each array reference holds data |
|
to be plotted in a stacked bar chart. |
|
|
|
=back |
|
|
|
Returns: |
|
|
|
An <img> tag which references graph.png and the appropriate identifying |
|
information for the plot. |
|
|
|
=cut |
|
|
|
############################################################ |
|
############################################################ |
|
sub DrawBarGraph { |
|
my ($Title,$xlabel,$ylabel,$Max,$colors,@Values)=@_; |
|
# |
|
if (! defined($colors)) { |
|
$colors = ['#33ff00', |
|
'#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933', |
|
'#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66', |
|
]; |
|
} |
|
# |
|
my $identifier = &get_cgi_id(); |
|
my $id = 'cgi.'.$identifier; |
|
if (! @Values || ref($Values[0]) ne 'ARRAY') { |
|
return ''; |
|
} |
|
my $NumBars = scalar(@{$Values[0]}); |
|
my %ValuesHash; |
|
my $NumSets=1; |
|
foreach my $array (@Values) { |
|
next if (! ref($array)); |
|
$ValuesHash{$id.'.data.'.$NumSets++} = |
|
join(',',@$array); |
|
} |
|
# |
|
my ($height,$width,$xskip,$bar_width) = (200,120,1,15); |
|
if ($NumBars < 10) { |
|
$width = 120+$NumBars*15; |
|
$xskip = 1; |
|
$bar_width = 15; |
|
} elsif ($NumBars <= 25) { |
|
$width = 120+$NumBars*11; |
|
$xskip = 5; |
|
$bar_width = 8; |
|
} elsif ($NumBars <= 50) { |
|
$width = 120+$NumBars*8; |
|
$xskip = 5; |
|
$bar_width = 4; |
|
} else { |
|
$width = 120+$NumBars*8; |
|
$xskip = 5; |
|
$bar_width = 4; |
|
} |
|
# |
|
my @Labels; |
|
for (my $i=0;$i<@{$Values[0]};$i++) { |
|
push (@Labels,$i+1); |
|
} |
|
# |
|
$Max = 1 if ($Max < 1); |
|
if ( int($Max) < $Max ) { |
|
$Max++; |
|
$Max = int($Max); |
|
} |
|
$Title = '' if (! defined($Title)); |
|
$xlabel = '' if (! defined($xlabel)); |
|
$ylabel = '' if (! defined($ylabel)); |
|
$ValuesHash{$id.'.title'} = &Apache::lonnet::escape($Title); |
|
$ValuesHash{$id.'.xlabel'} = &Apache::lonnet::escape($xlabel); |
|
$ValuesHash{$id.'.ylabel'} = &Apache::lonnet::escape($ylabel); |
|
$ValuesHash{$id.'.y_max_value'} = $Max; |
|
$ValuesHash{$id.'.NumBars'} = $NumBars; |
|
$ValuesHash{$id.'.NumSets'} = $NumSets; |
|
$ValuesHash{$id.'.PlotType'} = 'bar'; |
|
$ValuesHash{$id.'.Colors'} = join(',',@{$colors}); |
|
$ValuesHash{$id.'.height'} = $height; |
|
$ValuesHash{$id.'.width'} = $width; |
|
$ValuesHash{$id.'.xskip'} = $xskip; |
|
$ValuesHash{$id.'.bar_width'} = $bar_width; |
|
$ValuesHash{$id.'.labels'} = join(',',@Labels); |
|
# |
|
&Apache::lonnet::appenv(%ValuesHash); |
|
return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />'; |
|
} |
|
|
|
############################################################ |
|
############################################################ |
|
|
|
=pod |
|
|
|
=item DrawXYGraph |
|
|
|
Facilitates the plotting of data in an XY graph. |
|
Puts plot definition data into the users environment in order for |
|
graph.png to plot it. Returns an <img> tag for the plot. |
|
|
|
Inputs: |
|
|
|
=over 4 |
|
|
|
=item $Title: string, the title of the plot |
|
|
|
=item $xlabel: string, text describing the X-axis of the plot |
|
|
|
=item $ylabel: string, text describing the Y-axis of the plot |
|
|
|
=item $Max: scalar, the maximum Y value to use in the plot |
|
If $Max is < any data point, the graph will not be rendered. |
|
|
|
=item $colors: Array ref containing the hex color codes for the data to be |
|
plotted in. If undefined, default values will be used. |
|
|
|
=item $Xlabels: Array ref containing the labels to be used for the X-axis. |
|
|
|
=item $Ydata: Array ref containing Array refs. |
|
Each of the contained arrays will be plotted as a seperate curve. |
|
|
|
=item %Values: hash indicating or overriding any default values which are |
|
passed to graph.png. |
|
Possible values are: width, xskip, x_ticks, x_tick_offset, among others. |
|
|
|
=back |
|
|
|
Returns: |
|
|
|
An <img> tag which references graph.png and the appropriate identifying |
|
information for the plot. |
|
|
|
=cut |
|
|
|
############################################################ |
|
############################################################ |
|
sub DrawXYGraph { |
|
my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_; |
|
# |
|
# Create the identifier for the graph |
|
my $identifier = &get_cgi_id(); |
|
my $id = 'cgi.'.$identifier; |
|
# |
|
$Title = '' if (! defined($Title)); |
|
$xlabel = '' if (! defined($xlabel)); |
|
$ylabel = '' if (! defined($ylabel)); |
|
my %ValuesHash = |
|
( |
|
$id.'.title' => &Apache::lonnet::escape($Title), |
|
$id.'.xlabel' => &Apache::lonnet::escape($xlabel), |
|
$id.'.ylabel' => &Apache::lonnet::escape($ylabel), |
|
$id.'.y_max_value'=> $Max, |
|
$id.'.labels' => join(',',@$Xlabels), |
|
$id.'.PlotType' => 'XY', |
|
); |
|
# |
|
if (defined($colors) && ref($colors) eq 'ARRAY') { |
|
$ValuesHash{$id.'.Colors'} = join(',',@{$colors}); |
|
} |
|
# |
|
if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') { |
|
return ''; |
|
} |
|
my $NumSets=1; |
|
foreach my $array (@{$Ydata}){ |
|
next if (! ref($array)); |
|
$ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array); |
|
} |
|
$ValuesHash{$id.'.NumSets'} = $NumSets-1; |
|
# |
|
# Deal with other parameters |
|
while (my ($key,$value) = each(%Values)) { |
|
$ValuesHash{$id.'.'.$key} = $value; |
|
} |
|
# |
|
&Apache::lonnet::appenv(%ValuesHash); |
|
return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />'; |
|
} |
|
|
|
############################################################ |
|
############################################################ |
|
|
|
=pod |
|
|
|
=item DrawXYYGraph |
|
|
|
Facilitates the plotting of data in an XY graph with two Y axes. |
|
Puts plot definition data into the users environment in order for |
|
graph.png to plot it. Returns an <img> tag for the plot. |
|
|
|
Inputs: |
|
|
|
=over 4 |
|
|
|
=item $Title: string, the title of the plot |
|
|
|
=item $xlabel: string, text describing the X-axis of the plot |
|
|
|
=item $ylabel: string, text describing the Y-axis of the plot |
|
|
|
=item $colors: Array ref containing the hex color codes for the data to be |
|
plotted in. If undefined, default values will be used. |
|
|
|
=item $Xlabels: Array ref containing the labels to be used for the X-axis. |
|
|
|
=item $Ydata1: The first data set |
|
|
|
=item $Min1: The minimum value of the left Y-axis |
|
|
|
=item $Max1: The maximum value of the left Y-axis |
|
|
|
=item $Ydata2: The second data set |
|
|
|
=item $Min2: The minimum value of the right Y-axis |
|
|
|
=item $Max2: The maximum value of the left Y-axis |
|
|
|
=item %Values: hash indicating or overriding any default values which are |
|
passed to graph.png. |
|
Possible values are: width, xskip, x_ticks, x_tick_offset, among others. |
|
|
|
=back |
|
|
|
Returns: |
|
|
|
An <img> tag which references graph.png and the appropriate identifying |
|
information for the plot. |
|
|
|
=cut |
|
|
|
############################################################ |
|
############################################################ |
|
sub DrawXYYGraph { |
|
my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1, |
|
$Ydata2,$Min2,$Max2,%Values)=@_; |
|
# |
|
# Create the identifier for the graph |
|
my $identifier = &get_cgi_id(); |
|
my $id = 'cgi.'.$identifier; |
|
# |
|
$Title = '' if (! defined($Title)); |
|
$xlabel = '' if (! defined($xlabel)); |
|
$ylabel = '' if (! defined($ylabel)); |
|
my %ValuesHash = |
|
( |
|
$id.'.title' => &Apache::lonnet::escape($Title), |
|
$id.'.xlabel' => &Apache::lonnet::escape($xlabel), |
|
$id.'.ylabel' => &Apache::lonnet::escape($ylabel), |
|
$id.'.labels' => join(',',@$Xlabels), |
|
$id.'.PlotType' => 'XY', |
|
$id.'.NumSets' => 2, |
|
$id.'.two_axes' => 1, |
|
$id.'.y1_max_value' => $Max1, |
|
$id.'.y1_min_value' => $Min1, |
|
$id.'.y2_max_value' => $Max2, |
|
$id.'.y2_min_value' => $Min2, |
|
); |
|
# |
|
if (defined($colors) && ref($colors) eq 'ARRAY') { |
|
$ValuesHash{$id.'.Colors'} = join(',',@{$colors}); |
} |
} |
return undef; |
# |
|
if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' || |
|
! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){ |
|
return ''; |
|
} |
|
my $NumSets=1; |
|
foreach my $array ($Ydata1,$Ydata2){ |
|
next if (! ref($array)); |
|
$ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array); |
|
} |
|
# |
|
# Deal with other parameters |
|
while (my ($key,$value) = each(%Values)) { |
|
$ValuesHash{$id.'.'.$key} = $value; |
|
} |
|
# |
|
&Apache::lonnet::appenv(%ValuesHash); |
|
return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />'; |
} |
} |
|
|
|
############################################################ |
|
############################################################ |
|
|
|
=pod |
|
|
|
=head1 Statistics helper routines? |
|
|
|
Bad place for them but what the hell. |
|
|
|
=item &chartlink |
|
|
|
Returns a link to the chart for a specific student. |
|
|
|
Inputs: |
|
|
|
=over 4 |
|
|
|
=item $linktext: The text of the link |
|
|
|
=item $sname: The students username |
|
|
|
=item $sdomain: The students domain |
|
|
|
=back |
|
|
|
=cut |
|
|
|
############################################################ |
|
############################################################ |
|
sub chartlink { |
|
my ($linktext, $sname, $sdomain) = @_; |
|
my $link = '<a href="/adm/statistics?reportSelected=student_assessment'. |
|
'&SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain). |
|
'&chartoutputmode='.HTML::Entities::encode('html, with all links'). |
|
'">'.$linktext.'</a>'; |
|
} |
|
|
|
############################################################ |
|
############################################################ |
|
|
=pod |
=pod |
|
|
=back |
=back |