--- loncom/interface/loncommon.pm 2002/06/24 20:17:55 1.39 +++ loncom/interface/loncommon.pm 2002/06/25 16:31:51 1.40 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.39 2002/06/24 20:17:55 matthew Exp $ +# $Id: loncommon.pm,v 1.40 2002/06/25 16:31:51 ng Exp $ # # Copyright Michigan State University Board of Trustees # @@ -65,7 +65,7 @@ Current things done: This is part of the LearningOnline Network with CAPA project described at http://www.lon-capa.org. -=head2 General Subroutines +=head2 Subroutines =over 4 @@ -79,13 +79,14 @@ use Apache::lonnet(); use POSIX qw(strftime); use Apache::Constants qw(:common); use Apache::lonmsg(); + my $readit; # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %cprtag; my %fe; my %fd; -my %category_extensions; +my %fc; # -------------------------------------------------------------- Thesaurus data my @therelated; @@ -98,9 +99,6 @@ my $thethreshold=0.1/$thefuzzy; my $theavecount; # ----------------------------------------------------------------------- BEGIN - -=pod - =item BEGIN() Initialize values from language.tab, copyright.tab, filetypes.tab, @@ -146,8 +144,8 @@ BEGIN { while (<$fh>) { next if /^\#/; chomp; - my ($extension,$category)=(split(/\s+/,$_,2)); - push @{$category_extensions{lc($category)}},$extension; + my ($key,$val)=(split(/\s+/,$_,2)); + push @{$fc{$key}},$val; } } } @@ -215,16 +213,14 @@ linked_select_forms takes the following =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 'select2' keys must appear as stated. keys(%menu) are the possible 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 $menu{$choice1}->{'select2'}. -my %menu = ( A1 => { text =>"Choice A1" , + my %menu = ( A1 => { text =>"Choice A1" , default => "B3", select2 => { B1 => "Choice B1", @@ -743,12 +739,12 @@ sub copyrightdescription { # ------------------------------------------------------------- File Categories sub filecategories { - return sort(keys(%category_extensions)); + return sort(keys(%fc)); } # -------------------------------------- File Types within a specified category sub filecategorytypes { - return @{$category_extensions{lc($_[0])}}; + return @{$fc{lc(shift(@_))}}; } # ------------------------------------------------------------------ File Types @@ -772,8 +768,18 @@ sub filedescriptionex { 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 { - my ($symb,$username,$domain,$course)=@_; + my ($symb,$username,$domain,$course,$getattempt)=@_; my $prevattempts=''; if ($symb) { my (%returnhash)= @@ -786,34 +792,33 @@ sub get_previous_attempt { $lasthash{$_}=$returnhash{$version.':'.$_}; } } - $prevattempts=''; + $prevattempts='
History
'; + $prevattempts.=''; foreach (sort(keys %lasthash)) { my ($ign,@parts) = split(/\./,$_); - if ($#parts > 0) { + if (@parts) { my $data=$parts[-1]; pop(@parts); - $prevattempts.=''; + $prevattempts.=''; } else { - if ($#parts == 0) { - $prevattempts.=''; - } else { - $prevattempts.=''; - } + $prevattempts.=''; } } - for ($version=1;$version<=$returnhash{'version'};$version++) { - $prevattempts.=''; - foreach (sort(keys %lasthash)) { - my $value; - if ($_ =~ /timestamp/) { - $value=scalar(localtime($returnhash{$version.':'.$_})); - } else { - $value=$returnhash{$version.':'.$_}; - } - $prevattempts.=''; - } + if ($getattempt eq '') { + for ($version=1;$version<=$returnhash{'version'};$version++) { + $prevattempts.=''; + foreach (sort(keys %lasthash)) { + my $value; + if ($_ =~ /timestamp/) { + $value=scalar(localtime($returnhash{$version.':'.$_})); + } else { + $value=$returnhash{$version.':'.$_}; + } + $prevattempts.=''; + } + } } - $prevattempts.=''; + $prevattempts.=''; foreach (sort(keys %lasthash)) { my $value; if ($_ =~ /timestamp/) { @@ -821,9 +826,9 @@ sub get_previous_attempt { } else { $value=$lasthash{$_}; } - $prevattempts.=''; + $prevattempts.=''; } - $prevattempts.='
HistoryPart '.join('.',@parts).'
'.$data.'		Part '.join('.',@parts).'
'.$data.' 		'.$parts[0].''.$ign.''.$ign.' 
Attempt '.$version.''.$value.'
Transaction '.$version.''.$value.' 
Current
Current'.$value.''.$value.' 
'; + $prevattempts.='
'; } else { $prevattempts='Nothing submitted - no attempts.'; } @@ -873,11 +878,31 @@ sub get_student_answers { foreach my $element (@elements) { $ENV{'form.grade_'.$element}=$old{$element}; } + $userview=~s/\]*\>//gi; + $userview=~s/\<\/body\>//gi; + $userview=~s/\//gi; + $userview=~s/\<\/html\>//gi; + $userview=~s/\//gi; + $userview=~s/\<\/head\>//gi; + $userview=~s/action\s*\=/would_be_action\=/gi; 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 { @@ -930,19 +955,11 @@ sub add_to_env { } } -=pod - -=head2 CSV Upload/Handling functions - -=over 4 - -=item upfile_store($r) +#---CSV Upload/Handling functions -Store uploaded file, $r should be the HTTP Request object, -needs $ENV{'form.upfile'} -returns $datatoken to be put into hidden field - -=cut +# ========================================================= Store uploaded file +# needs $ENV{'form.upfile'} +# return $datatoken to be put into hidden field sub upfile_store { my $r=shift; @@ -961,13 +978,9 @@ sub upfile_store { return $datatoken; } -=item load_tmp_file($r) - -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 +# ================================================= Load uploaded file from tmp +# needs $ENV{'form.datatoken'} +# sets $ENV{'form.upfile'} to the contents of the file sub load_tmp_file { my $r=shift; @@ -982,13 +995,10 @@ sub load_tmp_file { $ENV{'form.upfile'}=join('',@studentdata); } -=item upfile_record_sep() - -Separate uploaded file into records -returns array of records, -needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'} - -=cut +# ========================================= Separate uploaded file into records +# returns array of records +# needs $ENV{'form.upfile'} +# needs $ENV{'form.upfiletype'} sub upfile_record_sep { if ($ENV{'form.upfiletype'} eq 'xml') { @@ -997,12 +1007,9 @@ sub upfile_record_sep { } } -=item record_sep($record) - -Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'} - -=cut - +# =============================================== Separate a record into fields +# needs $ENV{'form.upfiletype'} +# takes $record as arg sub record_sep { my $record=shift; my %components=(); @@ -1047,12 +1054,7 @@ sub record_sep { return %components; } -=item upfile_select_html() - -return HTML code to select file and specify its type - -=cut - +# =============================== HTML code to select file and specify its type sub upfile_select_html { return (<<'ENDUPFORM'); @@ -1065,14 +1067,9 @@ sub upfile_select_html { ENDUPFORM } -=item csv_print_samples($r,$records) - -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 - +# ===================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 sub csv_print_samples { my ($r,$records) = @_; my (%sone,%stwo,%sthree); @@ -1095,15 +1092,10 @@ sub csv_print_samples { $r->print('
'."\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, -$records is an arrayref from &Apache::loncommon::upfile_record_sep, -$d is an array of 2 element arrays (internal name, displayed name) - -=cut - +# ======Prints a table to create associations between values and table columns +# $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) sub csv_print_select_table { my ($r,$records,$d) = @_; my $i=0;my %sone; @@ -1127,16 +1119,11 @@ sub csv_print_select_table { 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. - -$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 - +# ===================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 +# $d is an array of 2 element arrays (internal name, displayed name) sub csv_samples_select_table { my ($r,$records,$d) = @_; my %sone; my %stwo; my %sthree; @@ -1167,14 +1154,6 @@ sub csv_samples_select_table { 1; __END__; -=pod - -=back - -=head2 Access .tab File Data - -=over 4 - =item languageids() returns list of all language ids @@ -1213,12 +1192,6 @@ returns description for a specified file returns description for a specified file type with extra formatting -=back - -=head2 Alternate Problem Views - -=over 4 - =item get_previous_attempt() return string with previous attempt on problem @@ -1231,22 +1204,9 @@ show a snapshot of what student was look show a snapshot of how student was answering problem -=back - -=head2 HTTP Helper - -=over 4 +=item get_unprocessed_cgi() -=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. +get unparsed CGI parameters =item cacheheader()