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

Diff for /loncom/interface/loncommon.pm between versions 1.35 and 1.43

version 1.35, 2002/04/23 21:42:01 version 1.43, 2002/07/03 21:12:38
Line 33 Line 33
 # 12/25,12/28 Gerd Kortemeyer  # 12/25,12/28 Gerd Kortemeyer
 # YEAR=2002  # YEAR=2002
 # 1/4 Gerd Kortemeyer  # 1/4 Gerd Kortemeyer
   # 6/24,7/2 H. K. Ng
   
 # Makes a table out of the previous attempts  # Makes a table out of the previous attempts
 # Inputs result_from_symbread, user, domain, course_id  # Inputs result_from_symbread, user, domain, course_id
Line 65  Current things done: Line 66  Current things done:
 This is part of the LearningOnline Network with CAPA project  This is part of the LearningOnline Network with CAPA project
 described at http://www.lon-capa.org.  described at http://www.lon-capa.org.
   
 =head2 Subroutines  =head2 General Subroutines
   
 =over 4  =over 4
   
Line 79  use Apache::lonnet(); Line 80  use Apache::lonnet();
 use POSIX qw(strftime);  use POSIX qw(strftime);
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::lonmsg();  use Apache::lonmsg();
   
 my $readit;  my $readit;
   
 # ----------------------------------------------- Filetypes/Languages/Copyright  # ----------------------------------------------- Filetypes/Languages/Copyright
 my %language;  my %language;
 my %cprtag;  my %cprtag;
 my %fe; my %fd;  my %fe; my %fd;
 my %fc;  my %category_extensions;
   
 # -------------------------------------------------------------- Thesaurus data  # -------------------------------------------------------------- Thesaurus data
 my @therelated;  my @therelated;
Line 99  my $thethreshold=0.1/$thefuzzy; Line 99  my $thethreshold=0.1/$thefuzzy;
 my $theavecount;  my $theavecount;
   
 # ----------------------------------------------------------------------- BEGIN  # ----------------------------------------------------------------------- BEGIN
   
   =pod
   
 =item BEGIN()   =item BEGIN() 
   
 Initialize values from language.tab, copyright.tab, filetypes.tab,  Initialize values from language.tab, copyright.tab, filetypes.tab,
Line 144  BEGIN { Line 147  BEGIN {
     while (<$fh>) {      while (<$fh>) {
  next if /^\#/;   next if /^\#/;
  chomp;   chomp;
  my ($key,$val)=(split(/\s+/,$_,2));   my ($extension,$category)=(split(/\s+/,$_,2));
  push @{$fc{$key}},$val;   push @{$category_extensions{lc($category)}},$extension;
     }      }
  }   }
     }      }
Line 189  BEGIN { Line 192  BEGIN {
 }  }
 # ============================================================= END BEGIN BLOCK  # ============================================================= END BEGIN BLOCK
 ###############################################################  ###############################################################
   ##           HTML and Javascript Helper Functions            ##
   ###############################################################
   
   =pod 
   
   =item browser_and_searcher_javascript 
   
   Returns scalar containing javascript to open a browser window
   or a searcher window.  Also creates 
   
   =over 4
   
   =item openbrowser(formname,elementname,only,omit) [javascript]
   
   inputs: formname, elementname, only, omit
   
   formname and elementname indicate the name of the html form and name of
   the element that the results of the browsing selection are to be placed in. 
   
   Specifying 'only' will restrict the browser to displaying only files
   with the given extension.  Can be a comma seperated list.
   
   Specifying 'omit' will restrict the browser to NOT displaying files
   with the given extension.  Can be a comma seperated list.
   
   =item opensearcher(formname, elementname) [javascript]
   
   Inputs: formname, elementname
   
   formname and elementname specify the name of the html form and the name
   of the element the selection from the search results will be placed in.
   
   =back
   
   =cut
   
   ###############################################################
   sub browser_and_searcher_javascript {
       return <<END;
       var editbrowser;
       function openbrowser(formname,elementname,only,omit) {
           var url = '/res/?';
           if (editbrowser == null) {
               url += 'launch=1&';
           }
           url += 'catalogmode=interactive&';
           url += 'mode=edit&';
           url += 'form=' + formname + '&';
           if (only != null) {
               url += 'only=' + only + '&';
           } 
           if (omit != null) {
               url += 'omit=' + omit + '&';
           }
           url += 'element=' + elementname + '';
           var title = 'Browser';
           var options = 'scrollbars=1,resizable=1,menubar=0';
           options += ',width=700,height=600';
           editbrowser = open(url,title,options,'1');
           editbrowser.focus();
       }
       var editsearcher;
       function opensearcher(formname,elementname) {
           var url = '/adm/searchcat?';
           if (editsearcher == null) {
               url += 'launch=1&';
           }
           url += 'catalogmode=interactive&';
           url += 'mode=edit&';
           url += 'form=' + formname + '&';
           url += 'element=' + elementname + '';
           var title = 'Search';
           var options = 'scrollbars=1,resizable=1,menubar=0';
           options += ',width=700,height=600';
           editsearcher = open(url,title,options,'1');
           editsearcher.focus();
       }
   END
   }
   
   
   
   ###############################################################
   
   =pod
   
   =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.
   
   =back 
   
   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 value 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          ##
 ###############################################################  ###############################################################
 #-------------------------------------------  #-------------------------------------------
Line 574  sub copyrightdescription { Line 830  sub copyrightdescription {
   
 # ------------------------------------------------------------- File Categories  # ------------------------------------------------------------- File Categories
 sub filecategories {  sub filecategories {
     return sort(keys(%fc));      return sort(keys(%category_extensions));
 }  }
   
 # -------------------------------------- File Types within a specified category  # -------------------------------------- File Types within a specified category
 sub filecategorytypes {  sub filecategorytypes {
     return @{$fc{lc(shift(@_))}};      return @{$category_extensions{lc($_[0])}};
 }  }
   
 # ------------------------------------------------------------------ File Types  # ------------------------------------------------------------------ File Types
Line 603  sub filedescriptionex { Line 859  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.
   # $regexp           - regular expression. If string matches regexp send to
   # $gradesub         - routine that process the string if it matches regexp
   # 
   # 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,$regexp,$gradesub)=@_;
   my $prevattempts='';    my $prevattempts='';
     no strict 'refs';
   if ($symb) {    if ($symb) {
     my (%returnhash)=      my (%returnhash)=
       &Apache::lonnet::restore($symb,$course,$domain,$username);        &Apache::lonnet::restore($symb,$course,$domain,$username);
Line 617  sub get_previous_attempt { Line 886  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="#777777">';
         $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 > 0) {
   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>';    if ($#parts == 0) {
  }      $prevattempts.='<th>'.$parts[0].'</th>';
       }  
       for ($version=1;$version<=$returnhash{'version'};$version++) {  
         $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';  
         foreach (sort(keys %lasthash)) {  
   my $value;  
   if ($_ =~ /timestamp/) {  
     $value=scalar(localtime($returnhash{$version.':'.$_}));  
   } else {    } else {
     $value=$returnhash{$version.':'.$_};      $prevattempts.='<th>'.$ign.'</th>';
   }    }
   $prevattempts.='<td>'.$value.'</td>';      }
         }        }
         if ($getattempt eq '') {
    for ($version=1;$version<=$returnhash{'version'};$version++) {
     $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>';
       foreach (sort(keys %lasthash)) {
          my $value;
          if ($_ =~ /timestamp/) {
     $value=scalar(localtime($returnhash{$version.':'.$_}));
          } else {
     $value=$returnhash{$version.':'.$_};
          }
          $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 648  sub get_previous_attempt { Line 924  sub get_previous_attempt {
  } else {   } else {
   $value=$lasthash{$_};    $value=$lasthash{$_};
  }   }
  $prevattempts.='<td>'.$value.'</td>';   if ($_ =~/$regexp$/) {$value = &$gradesub($value)}
    $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 700  sub get_student_answers { Line 977  sub get_student_answers {
   foreach my $element (@elements) {    foreach my $element (@elements) {
     $ENV{'form.grade_'.$element}=$old{$element};      $ENV{'form.grade_'.$element}=$old{$element};
   }    }
   $userview=~s/\<body[^\>]*\>//gi;  
   $userview=~s/\<\/body\>//gi;  
   $userview=~s/\<html\>//gi;  
   $userview=~s/\<\/html\>//gi;  
   $userview=~s/\<head\>//gi;  
   $userview=~s/\<\/head\>//gi;  
   $userview=~s/action\s*\=/would_be_action\=/gi;  
   return $userview;    return $userview;
 }  }
   
   ###############################################
   
   ###############################################
   
 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 760  sub add_to_env { Line 1034  sub add_to_env {
   }    }
 }  }
   
 #---CSV Upload/Handling functions  =pod
   
 # ========================================================= Store uploaded file  =head2 CSV Upload/Handling functions
 # needs $ENV{'form.upfile'}  
 # return $datatoken to be put into hidden field  =over 4
   
   =item  upfile_store($r)
   
   Store uploaded file, $r should be the HTTP Request object,
   needs $ENV{'form.upfile'}
   returns $datatoken to be put into hidden field
   
   =cut
   
 sub upfile_store {  sub upfile_store {
     my $r=shift;      my $r=shift;
Line 783  sub upfile_store { Line 1065  sub upfile_store {
     return $datatoken;      return $datatoken;
 }  }
   
 # ================================================= Load uploaded file from tmp  =item load_tmp_file($r)
 # needs $ENV{'form.datatoken'}  
 # sets $ENV{'form.upfile'} to the contents of the file  Load uploaded file from tmp, $r should be the HTTP Request object,
   needs $ENV{'form.datatoken'},
   sets $ENV{'form.upfile'} to the contents of the file
   
   =cut
   
 sub load_tmp_file {  sub load_tmp_file {
     my $r=shift;      my $r=shift;
Line 800  sub load_tmp_file { Line 1086  sub load_tmp_file {
     $ENV{'form.upfile'}=join('',@studentdata);      $ENV{'form.upfile'}=join('',@studentdata);
 }  }
   
 # ========================================= Separate uploaded file into records  =item upfile_record_sep()
 # returns array of records  
 # needs $ENV{'form.upfile'}  Separate uploaded file into records
 # needs $ENV{'form.upfiletype'}  returns array of records,
   needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'}
   
   =cut
   
 sub upfile_record_sep {  sub upfile_record_sep {
     if ($ENV{'form.upfiletype'} eq 'xml') {      if ($ENV{'form.upfiletype'} eq 'xml') {
Line 812  sub upfile_record_sep { Line 1101  sub upfile_record_sep {
     }      }
 }  }
   
 # =============================================== Separate a record into fields  =item record_sep($record)
 # needs $ENV{'form.upfiletype'}  
 # takes $record as arg  Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}
   
   =cut
   
 sub record_sep {  sub record_sep {
     my $record=shift;      my $record=shift;
     my %components=();      my %components=();
Line 859  sub record_sep { Line 1151  sub record_sep {
     return %components;      return %components;
 }  }
   
 # =============================== HTML code to select file and specify its type  =item upfile_select_html()
   
   return HTML code to select file and specify its type
   
   =cut
   
 sub upfile_select_html {  sub upfile_select_html {
     return (<<'ENDUPFORM');      return (<<'ENDUPFORM');
 <input type="file" name="upfile" size="50">  <input type="file" name="upfile" size="50">
Line 872  sub upfile_select_html { Line 1169  sub upfile_select_html {
 ENDUPFORM  ENDUPFORM
 }  }
   
 # ===================Prints a table of sample values from each column uploaded  =item csv_print_samples($r,$records)
 # $r is an Apache Request ref  
 # $records is an arrayref from &Apache::loncommon::upfile_record_sep  Prints a table of sample values from each column uploaded $r is an
   Apache Request ref, $records is an arrayref from
   &Apache::loncommon::upfile_record_sep
   
   =cut
   
 sub csv_print_samples {  sub csv_print_samples {
     my ($r,$records) = @_;      my ($r,$records) = @_;
     my (%sone,%stwo,%sthree);      my (%sone,%stwo,%sthree);
Line 897  sub csv_print_samples { Line 1199  sub csv_print_samples {
     $r->print('</tr></table><br />'."\n");      $r->print('</tr></table><br />'."\n");
 }  }
   
 # ======Prints a table to create associations between values and table columns  =item csv_print_select_table($r,$records,$d)
 # $r is an Apache Request ref  
 # $records is an arrayref from &Apache::loncommon::upfile_record_sep  Prints a table to create associations between values and table columns.
 # $d is an array of 2 element arrays (internal name, displayed name)  $r is an Apache Request ref,
   $records is an arrayref from &Apache::loncommon::upfile_record_sep,
   $d is an array of 2 element arrays (internal name, displayed name)
   
   =cut
   
 sub csv_print_select_table {  sub csv_print_select_table {
     my ($r,$records,$d) = @_;      my ($r,$records,$d) = @_;
     my $i=0;my %sone;      my $i=0;my %sone;
Line 924  sub csv_print_select_table { Line 1231  sub csv_print_select_table {
     return $i;      return $i;
 }  }
   
 # ===================Prints a table of sample values from the upload and  =item csv_samples_select_table($r,$records,$d)
 #                      can make associate samples to internal names  
 # $r is an Apache Request ref  Prints a table of sample values from the upload and can make associate samples to internal names.
 # $records is an arrayref from &Apache::loncommon::upfile_record_sep  
 # $d is an array of 2 element arrays (internal name, displayed name)  $r is an Apache Request ref,
   $records is an arrayref from &Apache::loncommon::upfile_record_sep,
   $d is an array of 2 element arrays (internal name, displayed name)
   
   =cut
   
 sub csv_samples_select_table {  sub csv_samples_select_table {
     my ($r,$records,$d) = @_;      my ($r,$records,$d) = @_;
     my %sone; my %stwo; my %sthree;      my %sone; my %stwo; my %sthree;
Line 959  sub csv_samples_select_table { Line 1271  sub csv_samples_select_table {
 1;  1;
 __END__;  __END__;
   
   =pod
   
   =back
   
   =head2 Access .tab File Data
   
   =over 4
   
 =item languageids()   =item languageids() 
   
 returns list of all language ids  returns list of all language ids
Line 997  returns description for a specified file Line 1317  returns description for a specified file
 returns description for a specified file type with  returns description for a specified file type with
 extra formatting  extra formatting
   
   =back
   
   =head2 Alternate Problem Views
   
   =over 4
   
 =item get_previous_attempt()   =item get_previous_attempt() 
   
 return string with previous attempt on problem  return string with previous attempt on problem
Line 1009  show a snapshot of what student was look Line 1335  show a snapshot of what student was look
   
 show a snapshot of how student was answering problem  show a snapshot of how student was answering problem
   
 =item get_unprocessed_cgi()   =back
   
   =head2 HTTP Helper
   
   =over 4
   
   =item get_unprocessed_cgi($query,$possible_names)
   
 get unparsed CGI parameters  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.
   
 =item cacheheader()   =item cacheheader() 
   
Removed from v.1.35  
changed lines
  Added in v.1.43

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.