[BACK]Return to loncommon.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.71 and 1.90

version 1.71, 2002/10/29 20:57:31 version 1.90, 2003/03/26 19:34:42
Line 27 Line 27
 #  #
 # YEAR=2001  # YEAR=2001
 # 2/13-12/7 Guy Albertelli  # 2/13-12/7 Guy Albertelli
 # 12/11,12/12,12/17 Scott Harrison  
 # 12/21 Gerd Kortemeyer  # 12/21 Gerd Kortemeyer
 # 12/21 Scott Harrison  
 # 12/25,12/28 Gerd Kortemeyer  # 12/25,12/28 Gerd Kortemeyer
 # YEAR=2002  # YEAR=2002
 # 1/4 Gerd Kortemeyer  # 1/4 Gerd Kortemeyer
Line 83  use GDBM_File; Line 81  use GDBM_File;
 use POSIX qw(strftime mktime);  use POSIX qw(strftime mktime);
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::lonmsg();  use Apache::lonmsg();
   use Apache::lonmenu();
 my $readit;  my $readit;
   
 =pod   =pod 
Line 311  sub browser_and_searcher_javascript { Line 310  sub browser_and_searcher_javascript {
 END  END
 }  }
   
   sub studentbrowser_javascript {
      unless ($ENV{'request.course.id'}) { return ''; }  
      unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
           return '';
      }
      return (<<'ENDSTDBRW');
   <script type="text/javascript" language="Javascript" >
       var stdeditbrowser;
       function openstdbrowser(formname,uname,udom) {
           var url = '/adm/pickstudent?';
           var filter;
           eval('filter=document.'+formname+'.'+uname+'.value;');
           if (filter != null) {
              if (filter != '') {
                  url += 'filter='+filter+'&';
      }
           }
           url += 'form=' + formname + '&unameelement='+uname+
                                       '&udomelement='+udom;
           var title = 'Student 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 selectstudent_link {
       my ($form,$unameele,$udomele)=@_;
      unless ($ENV{'request.course.id'}) { return ''; }  
      unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
           return '';
      }
       return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
           '","'.$udomele.'");'."'>Select</a>";
   }
   
 ###############################################################  ###############################################################
   
Line 483  sub help_open_topic { Line 519  sub help_open_topic {
     my ($topic, $text, $stayOnPage, $width, $height) = @_;      my ($topic, $text, $stayOnPage, $width, $height) = @_;
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 0 if (not defined $stayOnPage);
       if ($ENV{'browser.interface'} eq 'textual') {
    $stayOnPage=1;
       }
     $width = 350 if (not defined $width);      $width = 350 if (not defined $width);
     $height = 400 if (not defined $height);      $height = 400 if (not defined $height);
     my $filename = $topic;      my $filename = $topic;
Line 493  sub help_open_topic { Line 532  sub help_open_topic {
   
     if (!$stayOnPage)      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      else
     {      {
Line 503  sub help_open_topic { Line 542  sub help_open_topic {
     # Add the text      # Add the text
     if ($text ne "")      if ($text ne "")
     {      {
  $template .= "<a href=\"$link\">$text</a> ";   $template .= 
     "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
     "<td bgcolor='#5555FF'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
     }      }
   
     # Add the graphic      # Add the graphic
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
 <a href="$link"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>   <a href="$link"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
       if ($text ne '') { $template.='</td></tr></table>' };
     return $template;      return $template;
   
 }  }
Line 560  sub get_domains { Line 601  sub get_domains {
   
 =pod  =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   Returns a string containing a <select name='$name' size='1'> form to 
 allow a user to select the domain to preform an operation in.    allow a user to select the domain to preform an operation in.  
 See loncreateuser.pm for an example invocation and use.  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  =cut
   
 #-------------------------------------------  #-------------------------------------------
 sub select_dom_form {  sub select_dom_form {
     my ($defdom,$name) = @_;      my ($defdom,$name,$includeempty) = @_;
     my @domains = get_domains();      my @domains = get_domains();
       if ($includeempty) { @domains=('',@domains); }
     my $selectdomain = "<select name=\"$name\" size=\"1\">\n";      my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
     foreach (@domains) {      foreach (@domains) {
         $selectdomain.="<option value=\"$_\" ".          $selectdomain.="<option value=\"$_\" ".
Line 633  sub home_server_option_list { Line 704  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    ##  ##    Authentication changing form generation subroutines    ##
 ###############################################################  ###############################################################
 ##  ##
Line 674  See loncreateuser.pm for invocation and Line 814  See loncreateuser.pm for invocation and
 sub authform_header{    sub authform_header{  
     my %in = (      my %in = (
         formname => 'cu',          formname => 'cu',
         kerb_def_dom => 'MSU.EDU',          kerb_def_dom => '',
         @_,          @_,
     );      );
     $in{'formname'} = 'document.' . $in{'formname'};      $in{'formname'} = 'document.' . $in{'formname'};
     my $result='';      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";      $result.=<<"END";
 var current = new Object();  var current = new Object();
 current.radiovalue = 'nochange';  current.radiovalue = 'nochange';
Line 712  function changed_radio(choice,currentfor Line 868  function changed_radio(choice,currentfor
 function changed_text(choice,currentform) {  function changed_text(choice,currentform) {
     var choicearg = choice + 'arg';      var choicearg = choice + 'arg';
     if (currentform.elements[choicearg].value !='') {      if (currentform.elements[choicearg].value !='') {
         switch (choice) {          $Javascript_toUpperCase
             case 'krb': currentform.elements[choicearg].value =  
                 currentform.elements[choicearg].value.toUpperCase();  
                 break;  
             default:  
         }  
         // clear old field          // clear old field
         if ((current.argfield != choicearg) && (current.argfield != null)) {          if ((current.argfield != choicearg) && (current.argfield != null)) {
             currentform.elements[current.argfield].value = '';              currentform.elements[current.argfield].value = '';
Line 773  sub authform_kerberos{ Line 924  sub authform_kerberos{
     my %in = (      my %in = (
               formname => 'document.cu',                formname => 'document.cu',
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
                 kerb_def_auth => 'krb4',
               @_,                @_,
               );                );
     my $result='';      my $result='';
       my $check4;
       my $check5;
       if ($in{'kerb_def_auth'} eq 'krb5') {
          $check5 = " checked=\"on\"";
       } else {
          $check4 = " checked=\"on\"";
       }
     $result.=<<"END";      $result.=<<"END";
 <input type="radio" name="login" value="krb"   <input type="radio" name="login" value="krb" 
        onclick="javascript:changed_radio('krb',$in{'formname'});"         onclick="javascript:changed_radio('krb',$in{'formname'});"
        onchange="javascript:changed_radio('krb',$in{'formname'});" />         onchange="javascript:changed_radio('krb',$in{'formname'});" />
 Kerberos authenticated with domain  Kerberos authenticated with domain
 <input type="text" size="10" name="krbarg" value=""  <input type="text" size="10" name="krbarg" value="$in{'kerb_def_dom'}"
        onchange="javascript:changed_text('krb',$in{'formname'});" />         onchange="javascript:changed_text('krb',$in{'formname'});" />
 <input type="radio" name="krbver" value="4" checked="on" />Version 4  <input type="radio" name="krbver" value="4" $check4 />Version 4
 <input type="radio" name="krbver" value="5" />Version 5  <input type="radio" name="krbver" value="5" $check5 />Version 5
 END  END
     return $result;      return $result;
 }  }
Line 802  sub authform_internal{ Line 961  sub authform_internal{
        onclick="javascript:changed_radio('int',$args{'formname'});" />         onclick="javascript:changed_radio('int',$args{'formname'});" />
 Internally authenticated (with initial password   Internally authenticated (with initial password 
 <input type="text" size="10" name="intarg" value=""  <input type="text" size="10" name="intarg" value=""
        onchange="javascript:changed_text('int',$args{'formname'});" />         onchange="javascript:changed_text('int',$args{'formname'});" />)
 END  END
     return $result;      return $result;
 }  }
Line 838  sub authform_filesystem{ Line 997  sub authform_filesystem{
        onclick="javascript:changed_radio('fsys',$in{'formname'});" />         onclick="javascript:changed_radio('fsys',$in{'formname'});" />
 Filesystem authenticated (with initial password   Filesystem authenticated (with initial password 
 <input type="text" size="10" name="fsysarg" value=""  <input type="text" size="10" name="fsysarg" value=""
        onchange="javascript:changed_text('fsys',$in{'formname'});">         onchange="javascript:changed_text('fsys',$in{'formname'});">)
 END  END
     return $result;      return $result;
 }  }
Line 848  END Line 1007  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                        ##  ##                Thesaurus Functions                        ##
 ###############################################################  ###############################################################
   
Line 961  sub get_related_words { Line 1203  sub get_related_words {
 ###############################################################  ###############################################################
   
 # -------------------------------------------------------------- Plaintext name  # -------------------------------------------------------------- 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 {  sub plainname {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     my %names=&Apache::lonnet::get('environment',      my %names=&Apache::lonnet::get('environment',
Line 975  sub plainname { Line 1227  sub plainname {
 }  }
   
 # -------------------------------------------------------------------- Nickname  # -------------------------------------------------------------------- Nickname
   =pod
   
   =item nickname($uname,$udom)
   
   Gets a users name and returns it as a string as
   
   "&quot;nickname&quot;"
   
   if the user has a nickname or
   
   "first middle last generation"
   
   if the user does not
   
   =cut
   
 sub nickname {  sub nickname {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
Line 996  sub nickname { Line 1262  sub nickname {
   
 # ------------------------------------------------------------------ Screenname  # ------------------------------------------------------------------ Screenname
   
   =pod
   
   =item screenname($uname,$udom)
   
   Gets a users screenname and returns it as a string
   
   =cut
   
 sub screenname {  sub screenname {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     my %names=      my %names=
Line 1010  sub messagewrapper { Line 1284  sub messagewrapper {
     return       return 
 "<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>";  "<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>";
 }  }
   # --------------------------------------------------------------- Notes Wrapper
   
   sub noteswrapper {
       my ($link,$un,$do)=@_;
       return 
   "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
   }
 # ------------------------------------------------------------- Aboutme Wrapper  # ------------------------------------------------------------- Aboutme Wrapper
   
 sub aboutmewrapper {  sub aboutmewrapper {
Line 1021  sub aboutmewrapper { Line 1302  sub aboutmewrapper {
   
   
 sub syllabuswrapper {  sub syllabuswrapper {
     my ($link,$un,$do)=@_;      my ($link,$un,$do,$tf)=@_;
       if ($tf) { $link='<font color="'.$tf.'">'.$link.'</font>'; }
     return "<a href='/public/$do/$un/syllabus'>$link</a>";      return "<a href='/public/$do/$un/syllabus'>$link</a>";
 }  }
   
Line 1299  sub domainlogo { Line 1581  sub domainlogo {
     my $domain = &determinedomain(shift);          my $domain = &determinedomain(shift);    
      # See if there is a logo       # See if there is a logo
     if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {      if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
         return '<img src="http://'.$ENV{'HTTP_HOST'}.':8080/adm/lonDomLogos/'.   my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
                $domain.'.gif" />';   if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
           return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.
       '/adm/lonDomLogos/'.$domain.'.gif" />';
     } elsif(exists($Apache::lonnet::domaindescription{$domain})) {      } elsif(exists($Apache::lonnet::domaindescription{$domain})) {
         return $Apache::lonnet::domaindescription{$domain};          return $Apache::lonnet::domaindescription{$domain};
     } else {      } else {
Line 1345  Inputs: Line 1629  Inputs:
  $addentries, extra parameters for the <body> tag.   $addentries, extra parameters for the <body> tag.
  $bodyonly, if defined, only return the <body> tag.   $bodyonly, if defined, only return the <body> tag.
  $domain, if defined, force a given domain.   $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.    Returns: A uniform header for LON-CAPA web pages.  
 If $bodyonly is nonzero, a string containing a <body> tag will be returned.  If $bodyonly is nonzero, a string containing a <body> tag will be returned.
Line 1358  other decorations will be returned. Line 1644  other decorations will be returned.
   
 ###############################################  ###############################################
 sub bodytag {  sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain)=@_;      my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;
     unless ($function) {      unless ($function) {
  $function='student';   $function='student';
         if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {          if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
Line 1393  sub bodytag { Line 1679  sub bodytag {
 # Set messages  # Set messages
     my $messages=&domainlogo($domain);      my $messages=&domainlogo($domain);
 # Output  # Output
       my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
       if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
     my $bodytag = <<END;      my $bodytag = <<END;
 <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"  <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
 $addentries>  $addentries>
 END  END
     if ($bodyonly) {      if ($bodyonly) {
         return $bodytag;          return $bodytag;
       } elsif ($ENV{'browser.interface'} eq 'textual') {
           return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
                                                         $forcereg).
                  '<h1>LON-CAPA: '.$title.'</h1>';
     } else {      } else {
         return(<<ENDBODY);          return(<<ENDBODY);
 $bodytag  $bodytag
 <table width="100%" cellspacing="0" border="0" cellpadding="0">  <table width="100%" cellspacing="0" border="0" cellpadding="0">
 <tr><td bgcolor="$font">  <tr><td bgcolor="$font">
 <img src="http://$ENV{'HTTP_HOST'}:8080/$img" /></td>  <img src="http://$ENV{'HTTP_HOST'}:$lonhttpdPort$img" /></td>
 <td bgcolor="$font"><font color='$sidebg'>$messages</font></td>  <td bgcolor="$font"><font color='$sidebg'>$messages</font></td>
 </tr>  </tr>
 <tr>  <tr>
Line 1730  sub csv_samples_select_table { Line 2022  sub csv_samples_select_table {
     $i--;      $i--;
     return($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;  1;
 __END__;  __END__;
   
Removed from v.1.71  
changed lines
  Added in v.1.90

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>