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

version 1.38, 2002/06/24 19:06:05 version 1.40, 2002/06/25 16:31:51
Line 65  Current things done: Line 65  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 General Subroutines  =head2 Subroutines
   
 =over 4  =over 4
   
Line 79  use Apache::lonnet(); Line 79  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
Line 98  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 770  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 784  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 > 0) {   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 {
   if ($#parts == 0) {    $prevattempts.='<td>'.$ign.'&nbsp;</td>';
     $prevattempts.='<th>'.$parts[0].'</th>';  
   } else {  
     $prevattempts.='<th>'.$ign.'</th>';  
   }  
  }   }
       }        }
       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 819  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 871  sub get_student_answers { Line 878  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;
 }  }
   
 ###############################################  ###############################################
   
   =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 {
Line 928  sub add_to_env { Line 955  sub add_to_env {
   }    }
 }  }
   
 =pod  #---CSV Upload/Handling functions
   
 =back  
   
 =head2 CSV Upload/Handling functions  # ========================================================= Store uploaded file
   # needs $ENV{'form.upfile'}
 =over 4  # return $datatoken to be put into hidden field
   
 =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 961  sub upfile_store { Line 978  sub upfile_store {
     return $datatoken;      return $datatoken;
 }  }
   
 =item load_tmp_file($r)  # ================================================= Load uploaded file from tmp
   # needs $ENV{'form.datatoken'}
 Load uploaded file from tmp, $r should be the HTTP Request object,  # sets $ENV{'form.upfile'} to the contents of the file
 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 982  sub load_tmp_file { Line 995  sub load_tmp_file {
     $ENV{'form.upfile'}=join('',@studentdata);      $ENV{'form.upfile'}=join('',@studentdata);
 }  }
   
 =item upfile_record_sep()  # ========================================= Separate uploaded file into records
   # returns array of records
 Separate uploaded file into records  # needs $ENV{'form.upfile'}
 returns array of records,  # needs $ENV{'form.upfiletype'}
 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 997  sub upfile_record_sep { Line 1007  sub upfile_record_sep {
     }      }
 }  }
   
 =item record_sep($record)  # =============================================== Separate a record into fields
   # needs $ENV{'form.upfiletype'}
 Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}  # takes $record as arg
   
 =cut  
   
 sub record_sep {  sub record_sep {
     my $record=shift;      my $record=shift;
     my %components=();      my %components=();
Line 1047  sub record_sep { Line 1054  sub record_sep {
     return %components;      return %components;
 }  }
   
 =item upfile_select_html()  # =============================== HTML code to select file and specify its type
   
 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 1065  sub upfile_select_html { Line 1067  sub upfile_select_html {
 ENDUPFORM  ENDUPFORM
 }  }
   
 =item csv_print_samples($r,$records)  # ===================Prints a table of sample values from each column uploaded
   # $r is an Apache Request ref
 Prints a table of sample values from each column uploaded $r is an  # $records is an arrayref from &Apache::loncommon::upfile_record_sep
 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 1095  sub csv_print_samples { Line 1092  sub csv_print_samples {
     $r->print('</tr></table><br />'."\n");      $r->print('</tr></table><br />'."\n");
 }  }
   
 =item csv_print_select_table($r,$records,$d)  # ======Prints a table to create associations between values and table columns
   # $r is an Apache Request ref
 Prints a table to create associations between values and table columns.  # $records is an arrayref from &Apache::loncommon::upfile_record_sep
 $r is an Apache Request ref,  # $d is an array of 2 element arrays (internal name, displayed name)
 $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 1127  sub csv_print_select_table { Line 1119  sub csv_print_select_table {
     return $i;      return $i;
 }  }
   
 =item csv_samples_select_table($r,$records,$d)  # ===================Prints a table of sample values from the upload and
   #                      can make associate samples to internal names
 Prints a table of sample values from the upload and can make associate samples to internal names.  # $r is an Apache Request ref
   # $records is an arrayref from &Apache::loncommon::upfile_record_sep
 $r is an Apache Request ref,  # $d is an array of 2 element arrays (internal name, displayed name)
 $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 1167  sub csv_samples_select_table { Line 1154  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 1213  returns description for a specified file Line 1192  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 1231  show a snapshot of what student was look Line 1204  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
   
 =back  =item get_unprocessed_cgi() 
   
 =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.38  
changed lines
  Added in v.1.40


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