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

Diff for /loncom/interface/loncommon.pm between versions 1.31 and 1.37

version 1.31, 2002/04/15 23:37:37 version 1.37, 2002/05/09 15:56:02
Line 38 Line 38
 # Inputs result_from_symbread, user, domain, course_id  # Inputs result_from_symbread, user, domain, course_id
 # Reads in non-network-related .tab files  # Reads in non-network-related .tab files
   
   # POD header:
   
   =head1 NAME
   
   Apache::loncommon - pile of common routines
   
   =head1 SYNOPSIS
   
   Referenced by other mod_perl Apache modules.
   
   Invocation:
    &Apache::loncommon::SUBROUTINENAME(ARGUMENTS);
   
   =head1 INTRODUCTION
   
   Common collection of used subroutines.  This collection helps remove
   redundancy from other modules and increase efficiency of memory usage.
   
   Current things done:
   
    Makes a table out of the previous homework attempts
    Inputs result_from_symbread, user, domain, course_id
    Reads in non-network-related .tab files
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =head2 Subroutines
   
   =over 4
   
   =cut 
   
   # End of POD header
 package Apache::loncommon;  package Apache::loncommon;
   
 use strict;  use strict;
Line 65  my $thethreshold=0.1/$thefuzzy; Line 99  my $thethreshold=0.1/$thefuzzy;
 my $theavecount;  my $theavecount;
   
 # ----------------------------------------------------------------------- BEGIN  # ----------------------------------------------------------------------- BEGIN
   =item BEGIN() 
   
   Initialize values from language.tab, copyright.tab, filetypes.tab,
   and filecategories.tab.
   
   =cut
   # ----------------------------------------------------------------------- BEGIN
   
 BEGIN {  BEGIN {
   
     unless ($readit) {      unless ($readit) {
Line 143  BEGIN { Line 185  BEGIN {
               "<font color=yellow>INFO: Read file types and thesaurus</font>");                "<font color=yellow>INFO: Read file types and thesaurus</font>");
     $readit=1;      $readit=1;
 }  }
       
 }  }
 # ============================================================= END BEGIN BLOCK  # ============================================================= END BEGIN BLOCK
   
   =item linked_select_forms(...)
   
   linked_select_forms returns a string containing a <script></script> block
   and html for two <select> menus.  The select menus will be linked in that
   changing the value of the first menu will result in new values being placed
   in the second menu.  The values in the select menu will appear in alphabetical
   order.
   
   linked_select_forms takes the following ordered inputs:
   
   =over 4
   
   =item $formname, the name of the <form> tag
   
   =item $middletext, the text which appears between the <select> tags
   
   =item $firstdefault, the default value for the first menu
   
   =item $firstselectname, the name of the first <select> tag
   
   =item $secondselectname, the name of the second <select> tag
   
   =item $hashref, a reference to a hash containing the data for the menus.
   
   Below is an example of such a hash.  Only the 'text', 'default', and 
   'select2' keys must appear as stated.  keys(%menu) are the possible 
   values for the first select menu.  The text that coincides with the 
   first menu values is given in $menu{$choice1}->{'text'}.  The values 
   and text for the second menu are given in the hash pointed to by 
   $menu{$choice1}->{'select2'}.  
   
    my %menu = ( A1 => { text =>"Choice A1" ,
                         default => "B3",
                         select2 => { 
                             B1 => "Choice B1",
                             B2 => "Choice B2",
                             B3 => "Choice B3",
                             B4 => "Choice B4"
                             }
                     },
                 A2 => { text =>"Choice A2" ,
                         default => "C2",
                         select2 => { 
                             C1 => "Choice C1",
                             C2 => "Choice C2",
                             C3 => "Choice C3"
                             }
                     },
                 A3 => { text =>"Choice A3" ,
                         default => "D6",
                         select2 => { 
                             D1 => "Choice D1",
                             D2 => "Choice D2",
                             D3 => "Choice D3",
                             D4 => "Choice D4",
                             D5 => "Choice D5",
                             D6 => "Choice D6",
                             D7 => "Choice D7"
                             }
                     }
                 );
   
   =back
   
   =cut
   
   # ------------------------------------------------
   
   sub linked_select_forms {
       my ($formname,
           $middletext,
           $firstdefault,
           $firstselectname,
           $secondselectname, 
           $hashref
           ) = @_;
       my $second = "document.$formname.$secondselectname";
       my $first = "document.$formname.$firstselectname";
       # output the javascript to do the changing
       my $result = '';
       $result.="<script>\n";
       $result.="var select2data = new Object();\n";
       $" = '","';
       my $debug = '';
       foreach my $s1 (sort(keys(%$hashref))) {
           $result.="select2data.d_$s1 = new Object();\n";        
           $result.="select2data.d_$s1.def = new String('".
               $hashref->{$s1}->{'default'}."');\n";
           $result.="select2data.d_$s1.values = new Array(";        
           my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
           $result.="\"@s2values\");\n";
           $result.="select2data.d_$s1.texts = new Array(";        
           my @s2texts;
           foreach my $value (@s2values) {
               push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
           }
           $result.="\"@s2texts\");\n";
       }
       $"=' ';
       $result.= <<"END";
   
   function select1_changed() {
       // Determine new choice
       var newvalue = "d_" + $first.value;
       // update select2
       var values     = select2data[newvalue].values;
       var texts      = select2data[newvalue].texts;
       var select2def = select2data[newvalue].def;
       var i;
       // out with the old
       for (i = 0; i < $second.options.length; i++) {
           $second.options[i] = null;
       }
       // in with the nuclear
       for (i=0;i<values.length; i++) {
           $second.options[i] = new Option(values[i]);
           $second.options[i].text = texts[i];
           if (values[i] == select2def) {
               $second.options[i].selected = true;
           }
       }
   }
   </script>
   END
       # output the initial values for the selection lists
       $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
       foreach my $value (sort(keys(%$hashref))) {
           $result.="    <option value=\"$value\" ";
           $result.=" selected=\"true\" " if ($value eq $firstdefault);
           $result.=">$hashref->{$value}->{'text'}</option>\n";
       }
       $result .= "</select>\n";
       my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
       $result .= $middletext;
       $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
       my $seconddefault = $hashref->{$firstdefault}->{'default'};
       foreach my $value (sort(keys(%select2))) {
           $result.="    <option value=\"$value\" ";        
           $result.=" selected=\"true\" " if ($value eq $seconddefault);
           $result.=">$select2{$value}</option>\n";
       }
       $result .= "</select>\n";
       #    return $debug;
       return $result;
   }   #  end of sub linked_select_forms {
   
   ###############################################################
   
   =item csv_translate($text) 
   
   Translate $text to allow it to be output as a 'comma seperated values' 
   format.
   
   =cut
   
   sub csv_translate {
       my $text = shift;
       $text =~ s/\"/\"\"/g;
       $text =~ s/\n//g;
       return $text;
   }
   
   ###############################################################
   
   ###############################################################
   ##        Home server <option> list generating code          ##
   ###############################################################
   #-------------------------------------------
   
   =item get_domains()
   
   Returns an array containing each of the domains listed in the hosts.tab
   file.
   
   =cut
   
   #-------------------------------------------
   sub get_domains {
       # The code below was stolen from "The Perl Cookbook", p 102, 1st ed.
       my @domains;
       my %seen;
       foreach (sort values(%Apache::lonnet::hostdom)) {
           push (@domains,$_) unless $seen{$_}++;
       }
       return @domains;
   }
   
   #-------------------------------------------
   
   =item select_dom_form($defdom,$name)
   
   Returns a string containing a <select name='$name' size='1'> form to 
   allow a user to select the domain to preform an operation in.  
   See loncreateuser.pm for an example invocation and use.
   
   =cut
   
   #-------------------------------------------
   sub select_dom_form {
       my ($defdom,$name) = @_;
       my @domains = get_domains();
       my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
       foreach (@domains) {
           $selectdomain.="<option value=\"$_\" ".
               ($_ eq $defdom ? 'selected' : '').
                   ">$_</option>\n";
       }
       $selectdomain.="</select>";
       return $selectdomain;
   }
   
   #-------------------------------------------
   
   =item get_home_servers($domain)
   
   Returns a hash which contains keys like '103l3' and values like 
   'kirk.lite.msu.edu'.  All of the keys will be for machines in the
   given $domain.
   
   =cut
   
   #-------------------------------------------
   sub get_home_servers {
       my $domain = shift;
       my %home_servers;
       foreach (keys(%Apache::lonnet::libserv)) {
           if ($Apache::lonnet::hostdom{$_} eq $domain) {
               $home_servers{$_} = $Apache::lonnet::hostname{$_};
           }
       }
       return %home_servers;
   }
   
   #-------------------------------------------
   
   =item home_server_option_list($domain)
   
   returns a string which contains an <option> list to be used in a 
   <select> form input.  See loncreateuser.pm for an example.
   
   =cut
   
   #-------------------------------------------
   sub home_server_option_list {
       my $domain = shift;
       my %servers = &get_home_servers($domain);
       my $result = '';
       foreach (sort keys(%servers)) {
           $result.=
               '<option value="'.$_.'">'.$_.' '.$servers{$_}."</option>\n";
       }
       return $result;
   }
   ###############################################################
   ##    End of home server <option> list generating code       ##
   ###############################################################
   
   ###############################################################
   ##    Authentication changing form generation subroutines    ##
   ###############################################################
   ##
   ## All of the authform_xxxxxxx subroutines take their inputs in a
   ## hash, and have reasonable default values.
   ##
   ##    formname = the name given in the <form> tag.
   #-------------------------------------------
   
   =item authform_xxxxxx
   
   The authform_xxxxxx subroutines provide javascript and html forms which 
   handle some of the conveniences required for authentication forms.  
   This is not an optimal method, but it works.  
   
   See loncreateuser.pm for invocation and use examples.
   
   =over 4
   
   =item authform_header
   
   =item authform_authorwarning
   
   =item authform_nochange
   
   =item authform_kerberos
   
   =item authform_internal
   
   =item authform_filesystem
   
   =back
   
   =cut
   
   #-------------------------------------------
   sub authform_header{  
       my %in = (
           formname => 'cu',
           kerb_def_dom => 'MSU.EDU',
           @_,
       );
       $in{'formname'} = 'document.' . $in{'formname'};
       my $result='';
       $result.=<<"END";
   var current = new Object();
   current.radiovalue = 'nochange';
   current.argfield = null;
   
   function changed_radio(choice,currentform) {
       var choicearg = choice + 'arg';
       // If a radio button in changed, we need to change the argfield
       if (current.radiovalue != choice) {
           current.radiovalue = choice;
           if (current.argfield != null) {
               currentform.elements[current.argfield].value = '';
           }
           if (choice == 'nochange') {
               current.argfield = null;
           } else {
               current.argfield = choicearg;
               switch(choice) {
                   case 'krb': 
                       currentform.elements[current.argfield].value = 
                           "$in{'kerb_def_dom'}";
                   break;
                 default:
                   break;
               }
           }
       }
       return;
   }
   
   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:
           }
           // clear old field
           if ((current.argfield != choicearg) && (current.argfield != null)) {
               currentform.elements[current.argfield].value = '';
           }
           current.argfield = choicearg;
       }
       set_auth_radio_buttons(choice,currentform);
       return;
   }
   
   function set_auth_radio_buttons(newvalue,currentform) {
       var i=0;
       while (i < currentform.login.length) {
           if (currentform.login[i].value == newvalue) { break; }
           i++;
       }
       if (i == currentform.login.length) {
           return;
       }
       current.radiovalue = newvalue;
       currentform.login[i].checked = true;
       return;
   }
   END
       return $result;
   }
   
   sub authform_authorwarning{
       my $result='';
       $result=<<"END";
   <i>As a general rule, only authors or co-authors should be filesystem
   authenticated (which allows access to the server filesystem).</i>
   END
       return $result;
   }
   
   sub authform_nochange{  
       my %in = (
                 formname => 'document.cu',
                 kerb_def_dom => 'MSU.EDU',
                 @_,
             );
       my $result='';
       $result.=<<"END";
   <input type="radio" name="login" value="nochange" checked="checked"
          onclick="javascript:changed_radio('nochange',$in{'formname'});">
   Do not change login data
   END
       return $result;
   }
   
   sub authform_kerberos{  
       my %in = (
                 formname => 'document.cu',
                 kerb_def_dom => 'MSU.EDU',
                 @_,
                 );
       my $result='';
       $result.=<<"END";
   <input type="radio" name="login" value="krb" 
          onclick="javascript:changed_radio('krb',$in{'formname'});"
          onchange="javascript:changed_radio('krb',$in{'formname'});">
   Kerberos authenticated with domain
   <input type="text" size="10" name="krbarg" value=""
          onchange="javascript:changed_text('krb',$in{'formname'});">
   END
       return $result;
   }
   
   sub authform_internal{  
       my %args = (
                   formname => 'document.cu',
                   kerb_def_dom => 'MSU.EDU',
                   @_,
                   );
       my $result='';
       $result.=<<"END";
   <input type="radio" name="login" value="int"
          onchange="javascript:changed_radio('int',$args{'formname'});"
          onclick="javascript:changed_radio('int',$args{'formname'});">
   Internally authenticated (with initial password 
   <input type="text" size="10" name="intarg" value=""
          onchange="javascript:changed_text('int',$args{'formname'});">
   END
       return $result;
   }
   
   sub authform_local{  
       my %in = (
                 formname => 'document.cu',
                 kerb_def_dom => 'MSU.EDU',
                 @_,
                 );
       my $result='';
       $result.=<<"END";
   <input type="radio" name="login" value="loc"
          onchange="javascript:changed_radio('loc',$in{'formname'});"
          onclick="javascript:changed_radio('loc',$in{'formname'});"> 
   Local Authentication with argument
   <input type="text" size="10" name="locarg" value=""
          onchange="javascript:changed_text('loc',$in{'formname'});">
   END
       return $result;
   }
   
   sub authform_filesystem{  
       my %in = (
                 formname => 'document.cu',
                 kerb_def_dom => 'MSU.EDU',
                 @_,
                 );
       my $result='';
       $result.=<<"END";
   <input type="radio" name="login" value="fsys" 
          onchange="javascript:changed_radio('fsys',$in{'formname'});"
          onclick="javascript:changed_radio('fsys',$in{'formname'});"> 
   Filesystem authenticated (with initial password 
   <input type="text" size="10" name="fsysarg" value=""
          onchange="javascript:changed_text('fsys',$in{'formname'});">
   END
       return $result;
   }
   
   ###############################################################
   ##   End Authentication changing form generation functions   ##
   ###############################################################
   
   
   
 # ---------------------------------------------------------- Is this a keyword?  # ---------------------------------------------------------- Is this a keyword?
   
Line 364  sub get_student_answers { Line 875  sub get_student_answers {
   return $userview;    return $userview;
 }  }
   
   ###############################################
   
   =item get_unprocessed_cgi($query,$possible_names)
   
   Modify the %ENV hash to contain unprocessed CGI form parameters held in
   $query.  The parameters listed in $possible_names (an array reference),
   will be set in $ENV{'form.name'} if they do not already exist.
   
   Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
   $possible_names is an ref to an array of form element names.  As an example:
   get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
   will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.
   
   =cut
   
   ###############################################
   
 sub get_unprocessed_cgi {  sub get_unprocessed_cgi {
   my ($query,$possible_names)= @_;    my ($query,$possible_names)= @_;
   # $Apache::lonxml::debug=1;    # $Apache::lonxml::debug=1;
Line 566  sub csv_print_select_table { Line 1094  sub csv_print_select_table {
  $r->print('<tr><td>'.$display.'</td>');   $r->print('<tr><td>'.$display.'</td>');
   
  $r->print('<td><select name=f'.$i.   $r->print('<td><select name=f'.$i.
   ' onChange="flip(this.form,'.$i.');">');    ' onchange="javascript:flip(this.form,'.$i.');">');
  $r->print('<option value="none"></option>');   $r->print('<option value="none"></option>');
  foreach (sort({$a <=> $b} keys(%sone))) {   foreach (sort({$a <=> $b} keys(%sone))) {
     $r->print('<option value="'.$_.'">Column '.($_+1).'</option>');      $r->print('<option value="'.$_.'">Column '.($_+1).'</option>');
Line 595  sub csv_samples_select_table { Line 1123  sub csv_samples_select_table {
   
     foreach (sort keys %sone) {      foreach (sort keys %sone) {
  $r->print('<tr><td><select name=f'.$i.   $r->print('<tr><td><select name=f'.$i.
   ' onChange="flip(this.form,'.$i.');">');    ' onchange="javascript:flip(this.form,'.$i.');">');
  foreach (@$d) {   foreach (@$d) {
     my ($value,$display)=@{ $_ };      my ($value,$display)=@{ $_ };
     $r->print('<option value='.$value.'>'.$display.'</option>');      $r->print('<option value='.$value.'>'.$display.'</option>');
Line 613  sub csv_samples_select_table { Line 1141  sub csv_samples_select_table {
 1;  1;
 __END__;  __END__;
   
   =item languageids() 
   
 =head1 NAME  returns list of all language ids
   
 Apache::loncommon - pile of common routines  
   
 =head1 SYNOPSIS  
   
 Referenced by other mod_perl Apache modules.  
   
 Invocation:  
  &Apache::loncommon::SUBROUTINENAME(ARGUMENTS);  
   
 =head1 INTRODUCTION  
   
 Common collection of used subroutines.  This collection helps remove  
 redundancy from other modules and increase efficiency of memory usage.  
   
 Current things done:  
   
  Makes a table out of the previous homework attempts  
  Inputs result_from_symbread, user, domain, course_id  
  Reads in non-network-related .tab files  
   
 This is part of the LearningOnline Network with CAPA project  
 described at http://www.lon-capa.org.  
   
 =head1 HANDLER SUBROUTINE  
   
 There is no handler subroutine.  
   
 =head1 OTHER SUBROUTINES  
   
 =over 4  
   
 =item *  
   
 BEGIN() : initialize values from language.tab, copyright.tab, filetypes.tab,  
 and filecategories.tab.  
   
 =item *  
   
 languageids() : returns list of all language ids  
   
 =item *  =item languagedescription() 
   
 languagedescription() : returns description of a specified language id  returns description of a specified language id
   
 =item *  =item copyrightids() 
   
 copyrightids() : returns list of all copyrights  returns list of all copyrights
   
 =item *  =item copyrightdescription() 
   
 copyrightdescription() : returns description of a specified copyright id  returns description of a specified copyright id
   
 =item *  =item filecategories() 
   
 filecategories() : returns list of all file categories  returns list of all file categories
   
 =item *  =item filecategorytypes() 
   
 filecategorytypes() : returns list of file types belonging to a given file  returns list of file types belonging to a given file
 category  category
   
 =item *  =item fileembstyle() 
   
 fileembstyle() : returns embedding style for a specified file type  returns embedding style for a specified file type
   
 =item *  =item filedescription() 
   
 filedescription() : returns description for a specified file type  returns description for a specified file type
   
 =item *  =item filedescriptionex() 
   
 filedescriptionex() : returns description for a specified file type with  returns description for a specified file type with
 extra formatting  extra formatting
   
 =item *  =item get_previous_attempt() 
   
 get_previous_attempt() : return string with previous attempt on problem  return string with previous attempt on problem
   
 =item *  =item get_student_view() 
   
 get_student_view() : show a snapshot of what student was looking at  show a snapshot of what student was looking at
   
 =item *  =item get_student_answers() 
   
 get_student_answers() : show a snapshot of how student was answering problem  show a snapshot of how student was answering problem
   
 =item *  =item get_unprocessed_cgi() 
   
 get_unprocessed_cgi() : get unparsed CGI parameters  get unparsed CGI parameters
   
 =item *  =item cacheheader() 
   
 cacheheader() : returns cache-controlling header code  returns cache-controlling header code
   
 =item *  =item nocache() 
   
 nocache() : specifies header code to not have cache  specifies header code to not have cache
   
 =item *  =item add_to_env($name,$value) 
   
 add_to_env($name,$value) : adds $name to the %ENV hash with value  adds $name to the %ENV hash with value
 $value, if $name already exists, the entry is converted to an array  $value, if $name already exists, the entry is converted to an array
 reference and $value is added to the array.  reference and $value is added to the array.
   
Removed from v.1.31  
changed lines
  Added in v.1.37

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