--- loncom/interface/loncommon.pm 2003/04/03 21:32:23 1.94 +++ loncom/interface/loncommon.pm 2003/06/24 22:16:32 1.107 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.94 2003/04/03 21:32:23 www Exp $ +# $Id: loncommon.pm,v 1.107 2003/06/24 22:16:32 albertel 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'); @@ -363,7 +363,7 @@ sub coursebrowser_javascript { } url += 'form=' + formname + '&cnumelement='+uname+ '&cdomelement='+udom; - var title = 'Course Browser'; + var title = 'Course_Browser'; var options = 'scrollbars=1,resizable=1,menubar=0'; options += ',width=700,height=600'; stdeditbrowser = open(url,title,options,'1'); @@ -586,6 +586,26 @@ ENDTEMPLATE } +# This is a quicky function for Latex cheatsheet editing, since it +# appears in at least four places +sub helpLatexCheatsheet { + my $other = shift; + my $addOther = ''; + if ($other) { + $addOther = Apache::loncommon::help_open_topic($other, shift, + undef, undef, 600) . + ''; + } + return '
'. + $addOther . + &Apache::loncommon::help_open_topic("Greek_Symbols",'Greek Symbols', + undef,undef,600) + .''. + &Apache::loncommon::help_open_topic("Other_Symbols",'Other Symbols', + undef,undef,600) + .'
'; +} + =pod =item csv_translate($text) @@ -1347,6 +1367,32 @@ 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; + } + } + if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) { + foreach (split(/\s*(\,|\;|\:)\s*/, + $ENV{'course.'.$ENV{'request.course.id'}.'.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)); @@ -1465,6 +1511,41 @@ sub get_previous_attempt { } } +sub relative_to_absolute { + my ($url,$output)=@_; + my $parser=HTML::TokeParser->new(\$output); + my $token; + my $thisdir=$url; + my @rlinks=(); + while ($token=$parser->get_token) { + if ($token->[0] eq 'S') { + if ($token->[1] eq 'a') { + if ($token->[2]->{'href'}) { + $rlinks[$#rlinks+1]=$token->[2]->{'href'}; + } + } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) { + $rlinks[$#rlinks+1]=$token->[2]->{'src'}; + } elsif ($token->[1] eq 'base') { + $thisdir=$token->[2]->{'href'}; + } + } + } + $thisdir=~s-/[^/]*$--; + foreach (@rlinks) { + unless (($_=~/^http:\/\//i) || + ($_=~/^\//) || + ($_=~/^javascript:/i) || + ($_=~/^mailto:/i) || + ($_=~/^\#/)) { + my $newlocation=&Apache::lonnet::hreflocation($thisdir,$_); + $output=~s/(\"|\'|\=\s*)$_(\"|\'|\s|\>)/$1$newlocation$2/; + } + } +# -------------------------------------------------- Deal with Applet codebases + $output=~s/(\]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei; + return $output; +} + sub get_student_view { my ($symb,$username,$domain,$courseid,$target) = @_; my ($map,$id,$feedurl) = split(/___/,$symb); @@ -1476,7 +1557,8 @@ sub get_student_view { } if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';} &Apache::lonnet::appenv(%moreenv); - my $userview=&Apache::lonnet::ssi('/res/'.$feedurl); + $feedurl=&Apache::lonnet::clutter($feedurl); + my $userview=&Apache::lonnet::ssi_body($feedurl); &Apache::lonnet::delenv('form.grade_'); foreach my $element (@elements) { $ENV{'form.grade_'.$element}=$old{$element}; @@ -1488,11 +1570,12 @@ sub get_student_view { $userview=~s/\//gi; $userview=~s/\<\/head\>//gi; $userview=~s/action\s*\=/would_be_action\=/gi; + $userview=&relative_to_absolute($feedurl,$userview); return $userview; } 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'); @@ -1502,7 +1585,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}; @@ -1635,6 +1718,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}; @@ -1708,9 +1794,10 @@ 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 = < @@ -1720,28 +1807,27 @@ END if ($bodyonly) { return $bodytag; } elsif ($ENV{'browser.interface'} eq 'textual') { -# -# Accessibility rendering -# +# Accessibility return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', $forcereg). '

LON-CAPA: '.$title.'

'; } elsif ($ENV{'environment.remote'} eq 'off') { -# -# No-Remote rendering -# - $upperleft=&Apache::lonmenu::menubuttons($forcereg,'web', - $forcereg); +# No Remote + return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', + $forcereg). + '
'.$title. +'
'; } + # -# Top frame rendering +# Top frame rendering, Remote is up # return(< - + $upperleft -$messages +$messages  @@ -1763,6 +1849,78 @@ $upperleft
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 {