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

version 1.40, 2002/06/25 16:31:51 version 1.41, 2002/06/25 17:09:38
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 Subroutines  =head2 General 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
 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 98  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 146  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 213  linked_select_forms takes the following Line 215  linked_select_forms takes the following
   
 =item $hashref, a reference to a hash containing the data for the menus.  =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   Below is an example of such a hash.  Only the 'text', 'default', and 
 'select2' keys must appear as stated.  keys(%menu) are the possible   'select2' keys must appear as stated.  keys(%menu) are the possible 
 values for the first select menu.  The text that coincides with the   values for the first select menu.  The text that coincides with the 
 first menu values is given in $menu{$choice1}->{'text'}.  The values   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   and text for the second menu are given in the hash pointed to by 
 $menu{$choice1}->{'select2'}.    $menu{$choice1}->{'select2'}.  
   
  my %menu = ( A1 => { text =>"Choice A1" ,  my %menu = ( A1 => { text =>"Choice A1" ,
                       default => "B3",                        default => "B3",
                       select2 => {                         select2 => { 
                           B1 => "Choice B1",                            B1 => "Choice B1",
Line 739  sub copyrightdescription { Line 743  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 796  sub get_previous_attempt { Line 800  sub get_previous_attempt {
       $prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>';        $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.='<td>Part '.join('.',@parts).'<br />'.$data.'&nbsp;</td>';    $prevattempts.='<td>Part '.join('.',@parts).'<br />'.$data.'&nbsp;</td>';
  } else {   } else {
   $prevattempts.='<td>'.$ign.'&nbsp;</td>';    if ($#parts == 0) {
       $prevattempts.='<th>'.$parts[0].'</th>';
     } else {
       $prevattempts.='<th>'.$ign.'</th>';
     }
  }   }
       }        }
       if ($getattempt eq '') {        if ($getattempt eq '') {
Line 878  sub get_student_answers { Line 886  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 955  sub add_to_env { Line 943  sub add_to_env {
   }    }
 }  }
   
 #---CSV Upload/Handling functions  =pod
   
   =head2 CSV Upload/Handling functions
   
 # ========================================================= Store uploaded file  =over 4
 # needs $ENV{'form.upfile'}  
 # 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 978  sub upfile_store { Line 974  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 995  sub load_tmp_file { Line 995  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 1007  sub upfile_record_sep { Line 1010  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 1054  sub record_sep { Line 1060  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 1067  sub upfile_select_html { Line 1078  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 1092  sub csv_print_samples { Line 1108  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 1119  sub csv_print_select_table { Line 1140  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 1154  sub csv_samples_select_table { Line 1180  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 1192  returns description for a specified file Line 1226  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 1204  show a snapshot of what student was look Line 1244  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)
   
   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.
   
 get unparsed CGI parameters  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.40  
changed lines
  Added in v.1.41


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