--- loncom/interface/loncommon.pm 2003/02/13 23:02:42 1.81 +++ loncom/interface/loncommon.pm 2003/05/15 13:32:55 1.100 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.81 2003/02/13 23:02:42 albertel Exp $ +# $Id: loncommon.pm,v 1.100 2003/05/15 13:32:55 sakharuk Exp $ # # Copyright Michigan State University Board of Trustees # @@ -79,8 +79,9 @@ 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; =pod @@ -150,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; } } } @@ -345,7 +346,37 @@ sub selectstudent_link { return ''; } return "Select"; + '","'.$udomele.'");'."'>Select User"; +} + +sub coursebrowser_javascript { + return (<<'ENDSTDBRW'); + +ENDSTDBRW +} + +sub selectcourse_link { + my ($form,$unameele,$udomele)=@_; + return "Select Course"; } ############################################################### @@ -600,18 +631,48 @@ sub get_domains { =pod -=item select_dom_form($defdom,$name) +=item select_form($defdom,$name,%hash) + +Returns a string containing a 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 = "\n"; + foreach (sort keys %hash) { + $selectform.="".$hash{$_}."\n"; + } + $selectform.=""; + return $selectform; +} + + +#------------------------------------------- + +=pod + +=item select_dom_form($defdom,$name,$includeempty) Returns a string containing a 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 = "\n"; foreach (@domains) { $selectdomain.="=$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 ## ############################################################### ## @@ -1217,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)); @@ -1362,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'); @@ -1372,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}; @@ -1481,8 +1631,10 @@ sub domainlogo { my $domain = &determinedomain(shift); # See if there is a logo if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') { - return ''; + my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; + if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } + return ''; } elsif(exists($Apache::lonnet::domaindescription{$domain})) { return $Apache::lonnet::domaindescription{$domain}; } else { @@ -1503,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}; @@ -1527,6 +1682,8 @@ Inputs: $addentries, extra parameters for the tag. $bodyonly, if defined, only return the 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 tag will be returned. @@ -1540,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)/) { @@ -1575,22 +1732,38 @@ sub bodytag { # Set messages my $messages=&domainlogo($domain); # Output + my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; + if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } my $bodytag = < END + my $upperleft=''; if ($bodyonly) { return $bodytag; } elsif ($ENV{'browser.interface'} eq 'textual') { - return $bodytag.'LON-CAPA: '.$title. - 'Main Menu'; - } else { - return(<LON-CAPA: '.$title.''; + } elsif ($ENV{'environment.remote'} eq 'off') { +# No Remote + return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', + $forcereg). + ''.$title. +''; + } + +# +# Top frame rendering, Remote is up +# + return(< - - -$messages + +$upperleft +$messages @@ -1611,8 +1784,79 @@ $bodytag $realm 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 { @@ -1915,6 +2159,37 @@ sub csv_samples_select_table { $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; __END__;