--- loncom/interface/loncommon.pm 2003/02/12 01:59:34 1.77 +++ loncom/interface/loncommon.pm 2003/03/10 20:21:45 1.87 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.77 2003/02/12 01:59:34 www Exp $ +# $Id: loncommon.pm,v 1.87 2003/03/10 20:21:45 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -81,6 +81,7 @@ use GDBM_File; use POSIX qw(strftime mktime); use Apache::Constants qw(:common); use Apache::lonmsg(); +use Apache::lonmenu(); my $readit; =pod @@ -518,6 +519,9 @@ sub help_open_topic { my ($topic, $text, $stayOnPage, $width, $height) = @_; $text = "" if (not defined $text); $stayOnPage = 0 if (not defined $stayOnPage); + if ($ENV{'browser.interface'} eq 'textual') { + $stayOnPage=1; + } $width = 350 if (not defined $width); $height = 400 if (not defined $height); my $filename = $topic; @@ -540,14 +544,14 @@ sub help_open_topic { { $template .= "". - "
$text"; + "$text"; } # Add the graphic $template .= <<"ENDTEMPLATE"; (Help: $topic) ENDTEMPLATE - if ($text ne '') { $template.='
' }; + if ($text ne '') { $template.='' }; return $template; } @@ -670,6 +674,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 ## ############################################################### ## @@ -711,11 +784,27 @@ See loncreateuser.pm for invocation and sub authform_header{ my %in = ( formname => 'cu', - kerb_def_dom => 'MSU.EDU', + kerb_def_dom => '', @_, ); $in{'formname'} = 'document.' . $in{'formname'}; 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"; var current = new Object(); current.radiovalue = 'nochange'; @@ -749,12 +838,7 @@ function changed_radio(choice,currentfor function changed_text(choice,currentform) { var choicearg = choice + 'arg'; if (currentform.elements[choicearg].value !='') { - switch (choice) { - case 'krb': currentform.elements[choicearg].value = - currentform.elements[choicearg].value.toUpperCase(); - break; - default: - } + $Javascript_toUpperCase // clear old field if ((current.argfield != choicearg) && (current.argfield != null)) { currentform.elements[current.argfield].value = ''; @@ -810,18 +894,26 @@ sub authform_kerberos{ my %in = ( formname => 'document.cu', kerb_def_dom => 'MSU.EDU', + kerb_def_auth => 'krb4', @_, ); my $result=''; + my $check4; + my $check5; + if ($in{'kerb_def_auth'} eq 'krb5') { + $check5 = " checked=\"on\""; + } else { + $check4 = " checked=\"on\""; + } $result.=<<"END"; Kerberos authenticated with domain - -Version 4 -Version 5 +Version 4 +Version 5 END return $result; } @@ -885,6 +977,89 @@ 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 ## ############################################################### @@ -998,7 +1173,17 @@ sub get_related_words { ############################################################### # -------------------------------------------------------------- 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 { my ($uname,$udom)=@_; my %names=&Apache::lonnet::get('environment', @@ -1012,7 +1197,21 @@ sub plainname { } # -------------------------------------------------------------------- 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)=@_; @@ -1033,6 +1232,14 @@ sub nickname { # ------------------------------------------------------------------ Screenname +=pod + +=item screenname($uname,$udom) + +Gets a users screenname and returns it as a string + +=cut + sub screenname { my ($uname,$udom)=@_; my %names= @@ -1344,8 +1551,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 { @@ -1390,6 +1599,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. @@ -1403,7 +1614,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)/) { @@ -1438,18 +1649,24 @@ sub bodytag { # Set messages my $messages=&domainlogo($domain); # Output + my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; + if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } my $bodytag = < END if ($bodyonly) { return $bodytag; + } elsif ($ENV{'browser.interface'} eq 'textual') { + return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', + $forcereg). + '

LON-CAPA: '.$title.'

'; } else { return(< - + $messages @@ -1775,6 +1992,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__;