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

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

version 1.39, 2002/06/24 20:17:55 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
 my %language;  my %language;
 my %cprtag;  my %cprtag;
 my %fe; my %fd;  my %fe; my %fd;
 my %category_extensions;  my %fc;
   
 # -------------------------------------------------------------- Thesaurus data  # -------------------------------------------------------------- Thesaurus data
 my @therelated;  my @therelated;
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 146  BEGIN { Line 144  BEGIN {
     while (<$fh>) {      while (<$fh>) {
  next if /^\#/;   next if /^\#/;
  chomp;   chomp;
  my ($extension,$category)=(split(/\s+/,$_,2));   my ($key,$val)=(split(/\s+/,$_,2));
  push @{$category_extensions{lc($category)}},$extension;   push @{$fc{$key}},$val;
     }      }
  }   }
     }      }
Line 215  linked_select_forms takes the following Line 213  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 value is given in $menu{$choice1}->{'text'}.  The values   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   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 743  sub copyrightdescription { Line 739  sub copyrightdescription {
   
 # ------------------------------------------------------------- File Categories  # ------------------------------------------------------------- File Categories
 sub filecategories {  sub filecategories {
     return sort(keys(%category_extensions));      return sort(keys(%fc));
 }  }
   
 # -------------------------------------- File Types within a specified category  # -------------------------------------- File Types within a specified category
 sub filecategorytypes {  sub filecategorytypes {
     return @{$category_extensions{lc($_[0])}};      return @{$fc{lc(shift(@_))}};
 }  }
   
 # ------------------------------------------------------------------ File Types  # ------------------------------------------------------------------ File Types
Line 772  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 786  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 821  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 873  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 930  sub add_to_env { Line 955  sub add_to_env {
   }    }
 }  }
   
 =pod  #---CSV Upload/Handling functions
   
 =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.39  
changed lines
  Added in v.1.40

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