--- loncom/interface/loncommon.pm 2002/10/29 20:57:31 1.71 +++ 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.71 2002/10/29 20:57:31 www Exp $ +# $Id: loncommon.pm,v 1.87 2003/03/10 20:21:45 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -27,9 +27,7 @@ # # YEAR=2001 # 2/13-12/7 Guy Albertelli -# 12/11,12/12,12/17 Scott Harrison # 12/21 Gerd Kortemeyer -# 12/21 Scott Harrison # 12/25,12/28 Gerd Kortemeyer # YEAR=2002 # 1/4 Gerd Kortemeyer @@ -83,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 @@ -311,7 +310,44 @@ sub browser_and_searcher_javascript { END } +sub studentbrowser_javascript { + unless ($ENV{'request.course.id'}) { return ''; } + unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) { + return ''; + } + return (<<'ENDSTDBRW'); + +ENDSTDBRW +} +sub selectstudent_link { + my ($form,$unameele,$udomele)=@_; + unless ($ENV{'request.course.id'}) { return ''; } + unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) { + return ''; + } + return "Select"; +} ############################################################### @@ -483,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; @@ -493,7 +532,7 @@ sub help_open_topic { if (!$stayOnPage) { - $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height'))"; + $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; } else { @@ -503,14 +542,16 @@ sub help_open_topic { # Add the text if ($text ne "") { - $template .= "$text "; + $template .= + "". + "
$text"; } # Add the graphic $template .= <<"ENDTEMPLATE"; -(Help: $topic) + (Help: $topic) ENDTEMPLATE - + if ($text ne '') { $template.='
' }; return $template; } @@ -633,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 ## ############################################################### ## @@ -674,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'; @@ -712,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 = ''; @@ -773,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; } @@ -802,7 +931,7 @@ sub authform_internal{ onclick="javascript:changed_radio('int',$args{'formname'});" /> Internally authenticated (with initial password + onchange="javascript:changed_text('int',$args{'formname'});" />) END return $result; } @@ -838,7 +967,7 @@ sub authform_filesystem{ onclick="javascript:changed_radio('fsys',$in{'formname'});" /> Filesystem authenticated (with initial password + onchange="javascript:changed_text('fsys',$in{'formname'});">) END return $result; } @@ -848,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 ## ############################################################### @@ -961,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', @@ -975,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)=@_; @@ -996,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= @@ -1010,6 +1254,13 @@ sub messagewrapper { return "$link"; } +# --------------------------------------------------------------- Notes Wrapper + +sub noteswrapper { + my ($link,$un,$do)=@_; + return +"$link"; +} # ------------------------------------------------------------- Aboutme Wrapper sub aboutmewrapper { @@ -1021,7 +1272,8 @@ sub aboutmewrapper { sub syllabuswrapper { - my ($link,$un,$do)=@_; + my ($link,$un,$do,$tf)=@_; + if ($tf) { $link=''.$link.''; } return "$link"; } @@ -1299,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 { @@ -1345,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. @@ -1358,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)/) { @@ -1393,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 @@ -1730,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__;