Return to loncommon.pm CVS log

Up to [LON-CAPA] / loncom / interface

Annotation of loncom/interface/loncommon.pm, revision 1.9

1.1       albertel    1: # The LearningOnline Network
                      2: # a pile of common routines
                      3: # 2/13 Guy Albertelli
                      4: 
                      5: # Makes a table out of the previous attempts
1.2       albertel    6: # Inputs result_from_symbread, user, domain, course_id
1.1       albertel    7: 
                      8: package Apache::loncommon;
                      9: 
                     10: use strict;
1.8       albertel   11: use POSIX qw(strftime);
1.1       albertel   12: use Apache::Constants qw(:common);
                     13: use Apache::lonmsg();
                     14: 
                     15: sub get_previous_attempt {
1.2       albertel   16:   my ($symb,$username,$domain,$course)=@_;
1.1       albertel   17:   my $prevattempts='';
                     18:   if ($symb) {
1.3       albertel   19:     my (%returnhash)=
                     20:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel   21:     if ($returnhash{'version'}) {
                     22:       my %lasthash=();
                     23:       my $version;
                     24:       for ($version=1;$version<=$returnhash{'version'};$version++) {
                     25:         map {
                     26: 	  $lasthash{$_}=$returnhash{$version.':'.$_};
1.4       albertel   27:         } sort(split(/\:/,$returnhash{$version.':keys'}));
1.1       albertel   28:       }
                     29:       $prevattempts='<table border=2></tr><th>History</th>';
                     30:       map {
                     31:         $prevattempts.='<th>'.$_.'</th>';
1.4       albertel   32:       } sort(keys %lasthash);
1.1       albertel   33:       for ($version=1;$version<=$returnhash{'version'};$version++) {
                     34:         $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
                     35:         map {
1.5       albertel   36: 	  my $value;
                     37: 	  if ($_ =~ /timestamp/) {
                     38: 	    $value=scalar(localtime($returnhash{$version.':'.$_}));
                     39: 	  } else {
                     40: 	    $value=$returnhash{$version.':'.$_};
                     41: 	  }
                     42: 	  $prevattempts.='<td>'.$value.'</td>';   
1.4       albertel   43:         } sort(keys %lasthash);
1.1       albertel   44:       }
                     45:       $prevattempts.='</tr><tr><th>Current</th>';
                     46:       map {
1.5       albertel   47: 	my $value;
                     48: 	if ($_ =~ /timestamp/) {
                     49: 	  $value=scalar(localtime($lasthash{$_}));
                     50: 	} else {
                     51: 	  $value=$lasthash{$_};
                     52: 	}
                     53: 	$prevattempts.='<td>'.$value.'</td>';
1.4       albertel   54:       } sort(keys %lasthash);
1.1       albertel   55:       $prevattempts.='</tr></table>';
                     56:     } else {
                     57:       $prevattempts='Nothing submitted - no attempts.';
                     58:     }
                     59:   } else {
                     60:     $prevattempts='No data.';
                     61:   }
                     62: }
                     63: 
1.6       albertel   64: sub get_unprocessed_cgi {
                     65:   my ($query)= @_;
                     66:   map {
                     67:     my ($name, $value) = split(/=/,$_);
                     68:     $value =~ tr/+/ /;
                     69:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                     70:     if (!defined($ENV{'form.'.$name})) { $ENV{'form.'.$name}=$value; }
                     71:   } (split(/&/,$query));
                     72: }
                     73: 
1.7       albertel   74: sub cacheheader {
1.8       albertel   75:   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7       albertel   76:   my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
                     77:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                     78:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
                     79:   return $output;
                     80: }
                     81: 
1.9     ! albertel   82: sub no_cache {
        !            83:   my ($r) = @_;
        !            84:   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
        !            85:   $r->no_cache(1);
        !            86:   $r->header_out("Pragma" => "no-cache");
        !            87:   $r->header_out("Expires" => $date);
        !            88: }
1.1       albertel   89: 1;
                     90: __END__;