--- loncom/interface/loncommon.pm 2003/02/25 21:54:14 1.85
+++ loncom/interface/loncommon.pm 2003/06/06 02:24:49 1.103
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.85 2003/02/25 21:54:14 albertel Exp $
+# $Id: loncommon.pm,v 1.103 2003/06/06 02:24:49 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -79,7 +79,7 @@ use strict;
use Apache::lonnet();
use GDBM_File;
use POSIX qw(strftime mktime);
-use Apache::Constants qw(:common);
+use Apache::Constants qw(:common :http :methods);
use Apache::lonmsg();
use Apache::lonmenu();
my $readit;
@@ -151,8 +151,8 @@ BEGIN {
while (<$fh>) {
next if /^\#/;
chomp;
- my ($key,$val)=(split(/\s+/,$_,2));
- $language{$key}=$val;
+ my ($key,$two,$country,$three,$enc,$val)=(split(/\t/,$_));
+ $language{$key}=$val.' - '.$enc;
}
}
}
@@ -329,7 +329,7 @@ sub studentbrowser_javascript {
}
url += 'form=' + formname + '&unameelement='+uname+
'&udomelement='+udom;
- var title = 'Student Browser';
+ var title = 'Student_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';
options += ',width=700,height=600';
stdeditbrowser = open(url,title,options,'1');
@@ -346,7 +346,37 @@ sub selectstudent_link {
return '';
}
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>";
}
###############################################################
@@ -601,18 +631,48 @@ sub get_domains {
=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
allow a user to select the domain to preform an operation in.
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
#-------------------------------------------
sub select_dom_form {
- my ($defdom,$name) = @_;
+ my ($defdom,$name,$includeempty) = @_;
my @domains = get_domains();
+ if ($includeempty) { @domains=('',@domains); }
my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
foreach (@domains) {
$selectdomain.="<option value=\"$_\" ".
@@ -674,6 +734,75 @@ 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 ##
###############################################################
##
@@ -1218,6 +1347,26 @@ sub languagedescription {
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
sub copyrightids {
return sort(keys(%cprtag));
@@ -1363,7 +1512,7 @@ sub get_student_view {
}
sub get_student_answers {
- my ($symb,$username,$domain,$courseid) = @_;
+ my ($symb,$username,$domain,$courseid,%form) = @_;
my ($map,$id,$feedurl) = split(/___/,$symb);
my (%old,%moreenv);
my @elements=('symb','courseid','domain','username');
@@ -1373,7 +1522,7 @@ sub get_student_answers {
}
$moreenv{'form.grade_target'}='answer';
&Apache::lonnet::appenv(%moreenv);
- my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
+ my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%form);
&Apache::lonnet::delenv('form.grade_');
foreach my $element (@elements) {
$ENV{'form.grade_'.$element}=$old{$element};
@@ -1506,6 +1655,9 @@ Returns: value of designparamter $which
##############################################
sub designparm {
my ($which,$domain)=@_;
+ if ($ENV{'environment.color.'.$which}) {
+ return $ENV{'environment.color.'.$which};
+ }
$domain=&determinedomain($domain);
if ($designhash{$domain.'.'.$which}) {
return $designhash{$domain.'.'.$which};
@@ -1530,6 +1682,8 @@ Inputs:
$addentries, extra parameters for the <body> tag.
$bodyonly, if defined, only return the <body> tag.
$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.
If $bodyonly is nonzero, a string containing a <body> tag will be returned.
@@ -1543,7 +1697,7 @@ other decorations will be returned.
###############################################
sub bodytag {
- my ($title,$function,$addentries,$bodyonly,$domain)=@_;
+ my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;
unless ($function) {
$function='student';
if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
@@ -1577,25 +1731,40 @@ sub bodytag {
unless ($realm) { $realm=' '; }
# Set messages
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;
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
$addentries>
END
+ my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
+ $lonhttpdPort.$img.'" />';
if ($bodyonly) {
return $bodytag;
} elsif ($ENV{'browser.interface'} eq 'textual') {
- return $bodytag.&Apache::lonmenu::menubuttons(undef,'web').
+# Accessibility
+ return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
+ $forcereg).
'<h1>LON-CAPA: '.$title.'</h1>';
- } else {
- return(<<ENDBODY);
+ } 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
<table width="100%" cellspacing="0" border="0" cellpadding="0">
-<tr><td bgcolor="$font">
-<img src="http://$ENV{'HTTP_HOST'}:$lonhttpdPort$img" /></td>
-<td bgcolor="$font"><font color='$sidebg'>$messages</font></td>
+<tr><td bgcolor="$sidebg">
+$upperleft</td>
+<td bgcolor="$sidebg" align="right">$messages </td>
</tr>
<tr>
<td rowspan="3" bgcolor="$tabbg">
@@ -1616,8 +1785,79 @@ $bodytag
<td bgcolor="$tabbg" align="right"><font size="2">$realm</font> </td></tr>
</table><br>
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 {