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