File:
[LON-CAPA] /
loncom /
interface /
loncommon.pm
Revision
1.15:
download - view:
text,
annotated -
select for diffs
Tue Dec 11 23:38:28 2001 UTC (23 years, 4 months ago) by
harris41
Branches:
MAIN
CVS tags:
HEAD
filling in contents of subroutines languageids, languagedescription,
copyrightids, copyrightdescription, filecategories, filecategorytypes,
fileextensions, fileembstyle, and filedescription -Scott Harrison
# The LearningOnline Network with CAPA
# a pile of common routines
#
# $Id: loncommon.pm,v 1.15 2001/12/11 23:38:28 harris41 Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# YEAR=2001
# 2/13-12/7 Guy Albertelli
# 12/11 Scott Harrison
# Makes a table out of the previous attempts
# Inputs result_from_symbread, user, domain, course_id
package Apache::loncommon;
use strict;
use POSIX qw(strftime);
use Apache::Constants qw(:common);
use Apache::lonmsg();
my %language;
my %cprtag;
my %fe; my %fd;
my %fc;
# ----------------------------------------------------------------------- BEGIN
sub BEGIN {
# ------------------------------------------------------------------- languages
{
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
'/language.tab');
while (<$fh>) {
next if /^\#/;
chomp;
my ($key,$val)=(split(/\s+/,$_,2));
$language{$key}=$val;
}
}
# ------------------------------------------------------------------ copyrights
{
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
'/copyright.tab');
while (<$fh>) {
next if /^\#/;
chomp;
my ($key,$val)=(split(/\s+/,$_,2));
$cprtag{$key}=$val;
}
}
# ------------------------------------------------------------- file categories
{
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
'/filecategories.tab');
while (<$fh>) {
next if /^\#/;
chomp;
my ($key,$val)=(split(/\s+/,$_,2));
push @{$fc{$key}},$val;
}
}
# ------------------------------------------------------------------ file types
{
my $fh=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");
while (<$fh>) {
next if (/^\#/);
chomp;
my ($ending,$emb,$descr)=split(/\s+/,$_,3);
if ($descr ne '') {
$fe{$ending}=lc($emb);
$fd{$ending}=join(' ',@descr);
}
}
}
}
# ---------------------------------------------------------------- Language IDs
sub languageids {
return keys(%language);
}
# -------------------------------------------------------- Language Description
sub languagedescription {
return $language{shift};
}
# --------------------------------------------------------------- Copyright IDs
sub copyrightids {
return keys(%cprtag);
}
# ------------------------------------------------------- Copyright Description
sub copyrightdescription {
return $cprtag{shift};
}
# ------------------------------------------------------------- File Categories
sub filecategories {
return keys(%fc);
}
# ------------------------------------------------------------- File Categories
sub filecategorytypes {
return @{$fc{lc(shift)}};
}
# ------------------------------------------------------------------ File Types
sub fileextensions {
return keys(%fe);
}
# ------------------------------------------------------------- Embedding Style
sub fileembstyle {
return $fe{lc(shift)};
}
# ------------------------------------------------------------ Description Text
sub filedescription {
return $fd{lc(shift)};
}
sub get_previous_attempt {
my ($symb,$username,$domain,$course)=@_;
my $prevattempts='';
if ($symb) {
my (%returnhash)=
&Apache::lonnet::restore($symb,$course,$domain,$username);
if ($returnhash{'version'}) {
my %lasthash=();
my $version;
for ($version=1;$version<=$returnhash{'version'};$version++) {
map {
$lasthash{$_}=$returnhash{$version.':'.$_};
} sort(split(/\:/,$returnhash{$version.':keys'}));
}
$prevattempts='<table border=2></tr><th>History</th>';
map {
$prevattempts.='<th>'.$_.'</th>';
} sort(keys %lasthash);
for ($version=1;$version<=$returnhash{'version'};$version++) {
$prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
map {
my $value;
if ($_ =~ /timestamp/) {
$value=scalar(localtime($returnhash{$version.':'.$_}));
} else {
$value=$returnhash{$version.':'.$_};
}
$prevattempts.='<td>'.$value.'</td>';
} sort(keys %lasthash);
}
$prevattempts.='</tr><tr><th>Current</th>';
map {
my $value;
if ($_ =~ /timestamp/) {
$value=scalar(localtime($lasthash{$_}));
} else {
$value=$lasthash{$_};
}
$prevattempts.='<td>'.$value.'</td>';
} sort(keys %lasthash);
$prevattempts.='</tr></table>';
} else {
$prevattempts='Nothing submitted - no attempts.';
}
} else {
$prevattempts='No data.';
}
}
sub get_student_view {
my ($symb,$username,$domain,$courseid) = @_;
my ($map,$id,$feedurl) = split(/___/,$symb);
my (%old,%moreenv);
my @elements=('symb','courseid','domain','username');
foreach my $element (@elements) {
$old{$element}=$ENV{'form.grade_'.$element};
$moreenv{'form.grade_'.$element}=eval '$'.$element #'
}
&Apache::lonnet::appenv(%moreenv);
my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
&Apache::lonnet::delenv('form.grade_');
foreach my $element (@elements) {
$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;
}
sub get_student_answers {
my ($symb,$username,$domain,$courseid) = @_;
my ($map,$id,$feedurl) = split(/___/,$symb);
my (%old,%moreenv);
my @elements=('symb','courseid','domain','username');
foreach my $element (@elements) {
$old{$element}=$ENV{'form.grade_'.$element};
$moreenv{'form.grade_'.$element}=eval '$'.$element #'
}
$moreenv{'form.grade_target'}='answer';
&Apache::lonnet::appenv(%moreenv);
my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
&Apache::lonnet::delenv('form.grade_');
foreach my $element (@elements) {
$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;
}
sub get_unprocessed_cgi {
my ($query)= @_;
map {
my ($name, $value) = split(/=/,$_);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
if (!defined($ENV{'form.'.$name})) { $ENV{'form.'.$name}=$value; }
} (split(/&/,$query));
}
sub cacheheader {
my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
<meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
<meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
return $output;
}
sub no_cache {
my ($r) = @_;
my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
$r->no_cache(1);
$r->header_out("Pragma" => "no-cache");
$r->header_out("Expires" => $date);
}
1;
__END__;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>