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

Diff for /loncom/interface/loncommon.pm between versions 1.34 and 1.40

version 1.34, 2002/04/23 21:00:01 version 1.40, 2002/06/25 16:31:51
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 146  BEGIN { Line 188  BEGIN {
           
 }  }
 # ============================================================= 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          ##  ##        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 {  sub get_domains {
     # The code below was stolen from "The Perl Cookbook", p 102, 1st ed.      # The code below was stolen from "The Perl Cookbook", p 102, 1st ed.
     my @domains;      my @domains;
Line 159  sub get_domains { Line 376  sub get_domains {
     return @domains;      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 {  sub select_dom_form {
     my ($defdom,$name) = @_;      my ($defdom,$name) = @_;
     my @domains = get_domains();      my @domains = get_domains();
Line 172  sub select_dom_form { Line 400  sub select_dom_form {
     return $selectdomain;      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 {  sub get_home_servers {
     my $domain = shift;      my $domain = shift;
     my %home_servers;      my %home_servers;
Line 183  sub get_home_servers { Line 422  sub get_home_servers {
     return %home_servers;      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 {  sub home_server_option_list {
     my $domain = shift;      my $domain = shift;
     my %servers = &get_home_servers($domain);      my %servers = &get_home_servers($domain);
Line 205  sub home_server_option_list { Line 454  sub home_server_option_list {
 ## hash, and have reasonable default values.  ## hash, and have reasonable default values.
 ##  ##
 ##    formname = the name given in the <form> tag.  ##    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{    sub authform_header{  
     my %in = (      my %in = (
         formname => 'cu',          formname => 'cu',
Line 490  sub filedescriptionex { Line 768  sub filedescriptionex {
     return '.'.$ex.' '.$fd{lc($ex)};      return '.'.$ex.' '.$fd{lc($ex)};
 }  }
   
   # ---- Retrieve attempts by students
   # input
   # $symb             - problem including path
   # $username,$domain - that of the student
   # $course           - course name
   # $getattempt       - leave blank if want all attempts, else put something.
   # 
   # output
   # formatted as a table all the attempts, if any.
   #
 sub get_previous_attempt {  sub get_previous_attempt {
   my ($symb,$username,$domain,$course)=@_;    my ($symb,$username,$domain,$course,$getattempt)=@_;
   my $prevattempts='';    my $prevattempts='';
   if ($symb) {    if ($symb) {
     my (%returnhash)=      my (%returnhash)=
Line 504  sub get_previous_attempt { Line 792  sub get_previous_attempt {
   $lasthash{$_}=$returnhash{$version.':'.$_};    $lasthash{$_}=$returnhash{$version.':'.$_};
         }          }
       }        }
       $prevattempts='<table border=2></tr><th>History</th>';        $prevattempts='<table border="0" width="100%"><tr><td bgcolor="#000000">';
         $prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>';
       foreach (sort(keys %lasthash)) {        foreach (sort(keys %lasthash)) {
  my ($ign,@parts) = split(/\./,$_);   my ($ign,@parts) = split(/\./,$_);
  if (@parts) {   if (@parts) {
   my $data=$parts[-1];    my $data=$parts[-1];
   pop(@parts);    pop(@parts);
   $prevattempts.='<th>Part '.join('.',@parts).'<br />'.$data.'</th>';    $prevattempts.='<td>Part '.join('.',@parts).'<br />'.$data.'&nbsp;</td>';
  } else {   } else {
   $prevattempts.='<th>'.$ign.'</th>';    $prevattempts.='<td>'.$ign.'&nbsp;</td>';
  }   }
       }        }
       for ($version=1;$version<=$returnhash{'version'};$version++) {        if ($getattempt eq '') {
         $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';   for ($version=1;$version<=$returnhash{'version'};$version++) {
         foreach (sort(keys %lasthash)) {    $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>';
   my $value;      foreach (sort(keys %lasthash)) {
   if ($_ =~ /timestamp/) {         my $value;
     $value=scalar(localtime($returnhash{$version.':'.$_}));         if ($_ =~ /timestamp/) {
   } else {    $value=scalar(localtime($returnhash{$version.':'.$_}));
     $value=$returnhash{$version.':'.$_};         } else {
   }    $value=$returnhash{$version.':'.$_};
   $prevattempts.='<td>'.$value.'</td>';            }
         }         $prevattempts.='<td>'.$value.'&nbsp;</td>';   
       }
    }
       }        }
       $prevattempts.='</tr><tr><th>Current</th>';        $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Current</td>';
       foreach (sort(keys %lasthash)) {        foreach (sort(keys %lasthash)) {
  my $value;   my $value;
  if ($_ =~ /timestamp/) {   if ($_ =~ /timestamp/) {
Line 535  sub get_previous_attempt { Line 826  sub get_previous_attempt {
  } else {   } else {
   $value=$lasthash{$_};    $value=$lasthash{$_};
  }   }
  $prevattempts.='<td>'.$value.'</td>';   $prevattempts.='<td>'.$value.'&nbsp;</td>';
       }        }
       $prevattempts.='</tr></table>';        $prevattempts.='</tr></table></td></tr></table>';
     } else {      } else {
       $prevattempts='Nothing submitted - no attempts.';        $prevattempts='Nothing submitted - no attempts.';
     }      }
Line 597  sub get_student_answers { Line 888  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 846  sub csv_samples_select_table { Line 1154  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.34  
changed lines
  Added in v.1.40

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