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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.16    ! harris41    4: # $Id: loncommon.pm,v 1.15 2001/12/11 23:38:28 harris41 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
1.16    ! harris41   30: # 12/11,12/12 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.16    ! harris41   34: # Reads in non-network-related .tab files
1.1       albertel   35: 
                     36: package Apache::loncommon;
                     37: 
                     38: use strict;
1.8       albertel   39: use POSIX qw(strftime);
1.1       albertel   40: use Apache::Constants qw(:common);
                     41: use Apache::lonmsg();
1.12      harris41   42: 
                     43: my %language;
                     44: my %cprtag;
                     45: my %fe; my %fd;
1.15      harris41   46: my %fc;
1.12      harris41   47: 
                     48: # ----------------------------------------------------------------------- BEGIN
                     49: sub BEGIN {
                     50: # ------------------------------------------------------------------- languages
                     51:     {
                     52: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
                     53: 				 '/language.tab');
1.16    ! harris41   54: 	if ($fh) {
        !            55: 	    while (<$fh>) {
        !            56: 		next if /^\#/;
        !            57: 		chomp;
        !            58: 		my ($key,$val)=(split(/\s+/,$_,2));
        !            59: 		$language{$key}=$val;
        !            60: 	    }
1.12      harris41   61: 	}
                     62:     }
                     63: # ------------------------------------------------------------------ copyrights
                     64:     {
1.16    ! harris41   65: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.
        !            66: 				  '/copyright.tab');
        !            67: 	if ($fh) {
        !            68: 	    while (<$fh>) {
        !            69: 		next if /^\#/;
        !            70: 		chomp;
        !            71: 		my ($key,$val)=(split(/\s+/,$_,2));
        !            72: 		$cprtag{$key}=$val;
        !            73: 	    }
1.12      harris41   74: 	}
                     75:     }
1.15      harris41   76: # ------------------------------------------------------------- file categories
                     77:     {
                     78: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
1.16    ! harris41   79: 				  '/filecategories.tab');
        !            80: 	if ($fh) {
        !            81: 	    while (<$fh>) {
        !            82: 		next if /^\#/;
        !            83: 		chomp;
        !            84: 		my ($key,$val)=(split(/\s+/,$_,2));
        !            85: 		push @{$fc{$key}},$val;
        !            86: 	    }
1.15      harris41   87: 	}
                     88:     }
1.12      harris41   89: # ------------------------------------------------------------------ file types
                     90:     {
1.16    ! harris41   91: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
        !            92: 	       '/filetypes.tab');
        !            93: 	if ($fh) {
        !            94:             while (<$fh>) {
        !            95: 		next if (/^\#/);
        !            96: 		chomp;
        !            97: 		my ($ending,$emb,$descr)=split(/\s+/,$_,3);
        !            98: 		if ($descr ne '') { 
        !            99: 		    $fe{$ending}=lc($emb);
        !           100: 		    $fd{$ending}=$descr;
        !           101: 		}
1.12      harris41  102: 	    }
                    103: 	}
                    104:     }
1.14      harris41  105: }
                    106: 
                    107: # ---------------------------------------------------------------- Language IDs
                    108: sub languageids {
1.16    ! harris41  109:     return sort(keys(%language));
1.14      harris41  110: }
                    111: 
                    112: # -------------------------------------------------------- Language Description
                    113: sub languagedescription {
1.16    ! harris41  114:     return $language{shift(@_)};
1.14      harris41  115: }
                    116: 
                    117: # --------------------------------------------------------------- Copyright IDs
                    118: sub copyrightids {
1.16    ! harris41  119:     return sort(keys(%cprtag));
1.14      harris41  120: }
                    121: 
                    122: # ------------------------------------------------------- Copyright Description
                    123: sub copyrightdescription {
1.16    ! harris41  124:     return $cprtag{shift(@_)};
1.14      harris41  125: }
                    126: 
                    127: # ------------------------------------------------------------- File Categories
                    128: sub filecategories {
1.16    ! harris41  129:     return sort(keys(%fc));
1.15      harris41  130: }
1.14      harris41  131: 
1.15      harris41  132: # ------------------------------------------------------------- File Categories
                    133: sub filecategorytypes {
1.16    ! harris41  134:     return @{$fc{lc(shift(@_))}};
1.14      harris41  135: }
                    136: 
                    137: # ------------------------------------------------------------------ File Types
                    138: sub fileextensions {
1.16    ! harris41  139:     return sort(keys(%fe));
1.14      harris41  140: }
                    141: 
                    142: # ------------------------------------------------------------- Embedding Style
                    143: sub fileembstyle {
1.16    ! harris41  144:     return $fe{lc(shift(@_))};
1.14      harris41  145: }
                    146: 
                    147: # ------------------------------------------------------------ Description Text
                    148: sub filedescription {
1.16    ! harris41  149:     return $fd{lc(shift(@_))};
        !           150: }
        !           151: 
        !           152: # ------------------------------------------------------------ Description Text
        !           153: sub filedescriptionex {
        !           154:     my $ex=shift;
        !           155:     return '.'.$ex.' '.$fd{lc($ex)};
1.12      harris41  156: }
1.1       albertel  157: 
                    158: sub get_previous_attempt {
1.2       albertel  159:   my ($symb,$username,$domain,$course)=@_;
1.1       albertel  160:   my $prevattempts='';
                    161:   if ($symb) {
1.3       albertel  162:     my (%returnhash)=
                    163:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel  164:     if ($returnhash{'version'}) {
                    165:       my %lasthash=();
                    166:       my $version;
                    167:       for ($version=1;$version<=$returnhash{'version'};$version++) {
                    168:         map {
                    169: 	  $lasthash{$_}=$returnhash{$version.':'.$_};
1.4       albertel  170:         } sort(split(/\:/,$returnhash{$version.':keys'}));
1.1       albertel  171:       }
                    172:       $prevattempts='<table border=2></tr><th>History</th>';
1.16    ! harris41  173:       foreach (sort(keys %lasthash)) {
1.1       albertel  174:         $prevattempts.='<th>'.$_.'</th>';
1.16    ! harris41  175:       }
1.1       albertel  176:       for ($version=1;$version<=$returnhash{'version'};$version++) {
                    177:         $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
1.16    ! harris41  178:         foreach (sort(keys %lasthash)) {
1.5       albertel  179: 	  my $value;
                    180: 	  if ($_ =~ /timestamp/) {
                    181: 	    $value=scalar(localtime($returnhash{$version.':'.$_}));
                    182: 	  } else {
                    183: 	    $value=$returnhash{$version.':'.$_};
                    184: 	  }
                    185: 	  $prevattempts.='<td>'.$value.'</td>';   
1.16    ! harris41  186:         }
1.1       albertel  187:       }
                    188:       $prevattempts.='</tr><tr><th>Current</th>';
1.16    ! harris41  189:       foreach (sort(keys %lasthash)) {
1.5       albertel  190: 	my $value;
                    191: 	if ($_ =~ /timestamp/) {
                    192: 	  $value=scalar(localtime($lasthash{$_}));
                    193: 	} else {
                    194: 	  $value=$lasthash{$_};
                    195: 	}
                    196: 	$prevattempts.='<td>'.$value.'</td>';
1.16    ! harris41  197:       }
1.1       albertel  198:       $prevattempts.='</tr></table>';
                    199:     } else {
                    200:       $prevattempts='Nothing submitted - no attempts.';
                    201:     }
                    202:   } else {
                    203:     $prevattempts='No data.';
                    204:   }
1.10      albertel  205: }
                    206: 
                    207: sub get_student_view {
                    208:   my ($symb,$username,$domain,$courseid) = @_;
                    209:   my ($map,$id,$feedurl) = split(/___/,$symb);
                    210:   my (%old,%moreenv);
                    211:   my @elements=('symb','courseid','domain','username');
                    212:   foreach my $element (@elements) {
                    213:     $old{$element}=$ENV{'form.grade_'.$element};
                    214:     $moreenv{'form.grade_'.$element}=eval '$'.$element #'
                    215:   }
1.11      albertel  216:   &Apache::lonnet::appenv(%moreenv);
                    217:   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
                    218:   &Apache::lonnet::delenv('form.grade_');
                    219:   foreach my $element (@elements) {
                    220:     $ENV{'form.grade_'.$element}=$old{$element};
                    221:   }
                    222:   $userview=~s/\<body[^\>]*\>//gi;
                    223:   $userview=~s/\<\/body\>//gi;
                    224:   $userview=~s/\<html\>//gi;
                    225:   $userview=~s/\<\/html\>//gi;
                    226:   $userview=~s/\<head\>//gi;
                    227:   $userview=~s/\<\/head\>//gi;
                    228:   $userview=~s/action\s*\=/would_be_action\=/gi;
                    229:   return $userview;
                    230: }
                    231: 
                    232: sub get_student_answers {
                    233:   my ($symb,$username,$domain,$courseid) = @_;
                    234:   my ($map,$id,$feedurl) = split(/___/,$symb);
                    235:   my (%old,%moreenv);
                    236:   my @elements=('symb','courseid','domain','username');
                    237:   foreach my $element (@elements) {
                    238:     $old{$element}=$ENV{'form.grade_'.$element};
                    239:     $moreenv{'form.grade_'.$element}=eval '$'.$element #'
                    240:   }
                    241:   $moreenv{'form.grade_target'}='answer';
1.10      albertel  242:   &Apache::lonnet::appenv(%moreenv);
                    243:   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
                    244:   &Apache::lonnet::delenv('form.grade_');
                    245:   foreach my $element (@elements) {
                    246:     $ENV{'form.grade_'.$element}=$old{$element};
                    247:   }
                    248:   $userview=~s/\<body[^\>]*\>//gi;
                    249:   $userview=~s/\<\/body\>//gi;
                    250:   $userview=~s/\<html\>//gi;
                    251:   $userview=~s/\<\/html\>//gi;
                    252:   $userview=~s/\<head\>//gi;
                    253:   $userview=~s/\<\/head\>//gi;
                    254:   $userview=~s/action\s*\=/would_be_action\=/gi;
                    255:   return $userview;
1.1       albertel  256: }
                    257: 
1.6       albertel  258: sub get_unprocessed_cgi {
                    259:   my ($query)= @_;
1.16    ! harris41  260:   foreach (split(/&/,$query)) {
1.6       albertel  261:     my ($name, $value) = split(/=/,$_);
                    262:     $value =~ tr/+/ /;
                    263:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                    264:     if (!defined($ENV{'form.'.$name})) { $ENV{'form.'.$name}=$value; }
1.16    ! harris41  265:   }
1.6       albertel  266: }
                    267: 
1.7       albertel  268: sub cacheheader {
1.8       albertel  269:   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7       albertel  270:   my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
                    271:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                    272:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
                    273:   return $output;
                    274: }
                    275: 
1.9       albertel  276: sub no_cache {
                    277:   my ($r) = @_;
                    278:   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                    279:   $r->no_cache(1);
                    280:   $r->header_out("Pragma" => "no-cache");
                    281:   $r->header_out("Expires" => $date);
                    282: }
1.1       albertel  283: 1;
                    284: __END__;

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