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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.12    ! harris41    4: # $Id: loncommon.pm,v 1.11 2001/12/07 23:41:25 albertel Exp $
1.10      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.12    ! harris41   28: # YEAR=2001
        !            29: # 2/13-12/7 Guy Albertelli
        !            30: # 12/11 Scott Harrison
1.1       albertel   31: 
                     32: # Makes a table out of the previous attempts
1.2       albertel   33: # Inputs result_from_symbread, user, domain, course_id
1.1       albertel   34: 
                     35: package Apache::loncommon;
                     36: 
                     37: use strict;
1.8       albertel   38: use POSIX qw(strftime);
1.1       albertel   39: use Apache::Constants qw(:common);
                     40: use Apache::lonmsg();
1.12    ! harris41   41: 
        !            42: my %language;
        !            43: my %cprtag;
        !            44: my %fe; my %fd;
        !            45: 
        !            46: # ----------------------------------------------------------------------- BEGIN
        !            47: sub BEGIN {
        !            48: # ------------------------------------------------------------------- languages
        !            49:     {
        !            50: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
        !            51: 				 '/language.tab');
        !            52: 	while (<$fh>) {
        !            53: 	    next if /^\#/;
        !            54: 	    chomp;
        !            55: 	    my ($key,$val)=(split(/\s+/,$_,2));
        !            56: 	    $language{$key}=$val;
        !            57: 	}
        !            58:     }
        !            59: # ------------------------------------------------------------------ copyrights
        !            60:     {
        !            61: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
        !            62: 				 '/copyright.tab');
        !            63: 	while (<$fh>) {
        !            64: 	    next if /^\#/;
        !            65: 	    chomp;
        !            66: 	    my ($key,$val)=(split(/\s+/,$_,2));
        !            67: 	    $copyright{$key}=$val;
        !            68: 	}
        !            69:     }
        !            70: # ------------------------------------------------------------------ file types
        !            71:     {
        !            72: 	my $fh=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");
        !            73: 	while (<$fh>) {
        !            74: 	    next if (/^\#/);
        !            75: 	    chomp;
        !            76: 	    my ($ending,$emb,$descr)=split(/\s+/,$_,3);
        !            77: 	    if ($descr ne '') { 
        !            78: 		$fe{$ending}=lc($emb);
        !            79: 		$fd{$ending}=join(' ',@descr);
        !            80: 	    }
        !            81: 	}
        !            82:     }
        !            83: }
1.1       albertel   84: 
                     85: sub get_previous_attempt {
1.2       albertel   86:   my ($symb,$username,$domain,$course)=@_;
1.1       albertel   87:   my $prevattempts='';
                     88:   if ($symb) {
1.3       albertel   89:     my (%returnhash)=
                     90:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel   91:     if ($returnhash{'version'}) {
                     92:       my %lasthash=();
                     93:       my $version;
                     94:       for ($version=1;$version<=$returnhash{'version'};$version++) {
                     95:         map {
                     96: 	  $lasthash{$_}=$returnhash{$version.':'.$_};
1.4       albertel   97:         } sort(split(/\:/,$returnhash{$version.':keys'}));
1.1       albertel   98:       }
                     99:       $prevattempts='<table border=2></tr><th>History</th>';
                    100:       map {
                    101:         $prevattempts.='<th>'.$_.'</th>';
1.4       albertel  102:       } sort(keys %lasthash);
1.1       albertel  103:       for ($version=1;$version<=$returnhash{'version'};$version++) {
                    104:         $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
                    105:         map {
1.5       albertel  106: 	  my $value;
                    107: 	  if ($_ =~ /timestamp/) {
                    108: 	    $value=scalar(localtime($returnhash{$version.':'.$_}));
                    109: 	  } else {
                    110: 	    $value=$returnhash{$version.':'.$_};
                    111: 	  }
                    112: 	  $prevattempts.='<td>'.$value.'</td>';   
1.4       albertel  113:         } sort(keys %lasthash);
1.1       albertel  114:       }
                    115:       $prevattempts.='</tr><tr><th>Current</th>';
                    116:       map {
1.5       albertel  117: 	my $value;
                    118: 	if ($_ =~ /timestamp/) {
                    119: 	  $value=scalar(localtime($lasthash{$_}));
                    120: 	} else {
                    121: 	  $value=$lasthash{$_};
                    122: 	}
                    123: 	$prevattempts.='<td>'.$value.'</td>';
1.4       albertel  124:       } sort(keys %lasthash);
1.1       albertel  125:       $prevattempts.='</tr></table>';
                    126:     } else {
                    127:       $prevattempts='Nothing submitted - no attempts.';
                    128:     }
                    129:   } else {
                    130:     $prevattempts='No data.';
                    131:   }
1.10      albertel  132: }
                    133: 
                    134: sub get_student_view {
                    135:   my ($symb,$username,$domain,$courseid) = @_;
                    136:   my ($map,$id,$feedurl) = split(/___/,$symb);
                    137:   my (%old,%moreenv);
                    138:   my @elements=('symb','courseid','domain','username');
                    139:   foreach my $element (@elements) {
                    140:     $old{$element}=$ENV{'form.grade_'.$element};
                    141:     $moreenv{'form.grade_'.$element}=eval '$'.$element #'
                    142:   }
1.11      albertel  143:   &Apache::lonnet::appenv(%moreenv);
                    144:   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
                    145:   &Apache::lonnet::delenv('form.grade_');
                    146:   foreach my $element (@elements) {
                    147:     $ENV{'form.grade_'.$element}=$old{$element};
                    148:   }
                    149:   $userview=~s/\<body[^\>]*\>//gi;
                    150:   $userview=~s/\<\/body\>//gi;
                    151:   $userview=~s/\<html\>//gi;
                    152:   $userview=~s/\<\/html\>//gi;
                    153:   $userview=~s/\<head\>//gi;
                    154:   $userview=~s/\<\/head\>//gi;
                    155:   $userview=~s/action\s*\=/would_be_action\=/gi;
                    156:   return $userview;
                    157: }
                    158: 
                    159: sub get_student_answers {
                    160:   my ($symb,$username,$domain,$courseid) = @_;
                    161:   my ($map,$id,$feedurl) = split(/___/,$symb);
                    162:   my (%old,%moreenv);
                    163:   my @elements=('symb','courseid','domain','username');
                    164:   foreach my $element (@elements) {
                    165:     $old{$element}=$ENV{'form.grade_'.$element};
                    166:     $moreenv{'form.grade_'.$element}=eval '$'.$element #'
                    167:   }
                    168:   $moreenv{'form.grade_target'}='answer';
1.10      albertel  169:   &Apache::lonnet::appenv(%moreenv);
                    170:   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
                    171:   &Apache::lonnet::delenv('form.grade_');
                    172:   foreach my $element (@elements) {
                    173:     $ENV{'form.grade_'.$element}=$old{$element};
                    174:   }
                    175:   $userview=~s/\<body[^\>]*\>//gi;
                    176:   $userview=~s/\<\/body\>//gi;
                    177:   $userview=~s/\<html\>//gi;
                    178:   $userview=~s/\<\/html\>//gi;
                    179:   $userview=~s/\<head\>//gi;
                    180:   $userview=~s/\<\/head\>//gi;
                    181:   $userview=~s/action\s*\=/would_be_action\=/gi;
                    182:   return $userview;
1.1       albertel  183: }
                    184: 
1.6       albertel  185: sub get_unprocessed_cgi {
                    186:   my ($query)= @_;
                    187:   map {
                    188:     my ($name, $value) = split(/=/,$_);
                    189:     $value =~ tr/+/ /;
                    190:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                    191:     if (!defined($ENV{'form.'.$name})) { $ENV{'form.'.$name}=$value; }
                    192:   } (split(/&/,$query));
                    193: }
                    194: 
1.7       albertel  195: sub cacheheader {
1.8       albertel  196:   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7       albertel  197:   my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
                    198:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                    199:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
                    200:   return $output;
                    201: }
                    202: 
1.9       albertel  203: sub no_cache {
                    204:   my ($r) = @_;
                    205:   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                    206:   $r->no_cache(1);
                    207:   $r->header_out("Pragma" => "no-cache");
                    208:   $r->header_out("Expires" => $date);
                    209: }
1.1       albertel  210: 1;
                    211: __END__;

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