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

Diff for /loncom/interface/loncommon.pm between versions 1.36 and 1.39

version 1.36, 2002/04/26 18:57:27 version 1.39, 2002/06/24 20:17:55
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 336  END Line 340  END
 }   #  end of sub linked_select_forms {  }   #  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 721  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 767  sub get_previous_attempt { Line 789  sub get_previous_attempt {
       $prevattempts='<table border=2></tr><th>History</th>';        $prevattempts='<table border=2></tr><th>History</th>';
       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.='<th>Part '.join('.',@parts).'<br />'.$data.'</th>';
  } else {   } else {
   $prevattempts.='<th>'.$ign.'</th>';    if ($#parts == 0) {
       $prevattempts.='<th>'.$parts[0].'</th>';
     } else {
       $prevattempts.='<th>'.$ign.'</th>';
     }
  }   }
       }        }
       for ($version=1;$version<=$returnhash{'version'};$version++) {        for ($version=1;$version<=$returnhash{'version'};$version++) {
Line 847  sub get_student_answers { Line 873  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 907  sub add_to_env { Line 930  sub add_to_env {
   }    }
 }  }
   
 #---CSV Upload/Handling functions  =pod
   
   =head2 CSV Upload/Handling functions
   
   =over 4
   
 # ========================================================= Store uploaded file  =item  upfile_store($r)
 # needs $ENV{'form.upfile'}  
 # return $datatoken to be put into hidden field  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 930  sub upfile_store { Line 961  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 947  sub load_tmp_file { Line 982  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 959  sub upfile_record_sep { Line 997  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 1006  sub record_sep { Line 1047  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 1019  sub upfile_select_html { Line 1065  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 1044  sub csv_print_samples { Line 1095  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 1071  sub csv_print_select_table { Line 1127  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 1106  sub csv_samples_select_table { Line 1167  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 1144  returns description for a specified file Line 1213  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 1156  show a snapshot of what student was look Line 1231  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.36  
changed lines
  Added in v.1.39

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