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

Diff for /loncom/interface/loncommon.pm between versions 1.37 and 1.44

version 1.37, 2002/05/09 15:56:02 version 1.44, 2002/07/05 16:12:31
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 188  BEGIN { Line 191  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(...)  =item linked_select_forms(...)
   
Line 213  linked_select_forms takes the following Line 302  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 337  END Line 428  END
   
 ###############################################################  ###############################################################
   
   
   =item help_open_topic($topic, $stayOnPage, $width, $height)
   
   Returns a string corresponding to an HTML link to the given help $topic, where $topic corresponds to the name of a .tex file in /home/httpd/html/adm/help/tex, with underscores replaced by spaces.
   
   $stayOnPage is a value that will be interpreted as a boolean. If true, the link will not open a new window. If false, the link will open a new window using Javascript. (Default is false.)
   
   $width and $height are optional numerical parameters that will override the width and height of the popped up window, which may be useful for certain help topics with big pictures included.
   
   =cut
   
   sub help_open_topic {
       my ($topic, $stayOnPage, $width, $height) = @_;
       $stayOnPage = 0 if (not defined $stayOnPage);
       $width = 350 if (not defined $width);
       $height = 400 if (not defined $height);
       my $filename = $topic;
       $filename =~ s/ /_/g;
   
       my $template;
   
       if (!$stayOnPage)
       {
           $template = <<"ENDTEMPLATE";
   <a href="javascript:void(open('/adm/help/${filename}.hlp', 'Help for $topic', 'menubar=0,s
   crollbars=1,width=$width,height=$height'))"><image
     src="/adm/help/gif/smallHelp.gif"
     border="0" alt="(Help: $topic)"></a>
   ENDTEMPLATE
       }
       else
       {
           $template = <<"ENDTEMPLATE";
   <a href="/adm/help/${filename}.hlp"><image
     src="/adm/help/gif/smallHelp.gif"
     border="0" alt="(Help: $topic)"></a>
   ENDTEMPLATE
       }
   
       return $template;
   
   }
   
 =item csv_translate($text)   =item csv_translate($text) 
   
 Translate $text to allow it to be output as a 'comma seperated values'   Translate $text to allow it to be output as a 'comma seperated values' 
Line 739  sub copyrightdescription { Line 873  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 768  sub filedescriptionex { Line 902  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 782  sub get_previous_attempt { Line 929  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 813  sub get_previous_attempt { Line 967  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 865  sub get_student_answers { Line 1020  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 942  sub add_to_env { Line 1077  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 965  sub upfile_store { Line 1108  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 982  sub load_tmp_file { Line 1129  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 994  sub upfile_record_sep { Line 1144  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 1041  sub record_sep { Line 1194  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 1054  sub upfile_select_html { Line 1212  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 1079  sub csv_print_samples { Line 1242  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 1106  sub csv_print_select_table { Line 1274  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 1141  sub csv_samples_select_table { Line 1314  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 1179  returns description for a specified file Line 1360  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 1191  show a snapshot of what student was look Line 1378  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.37  
changed lines
  Added in v.1.44

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