1: # The LearningOnline Network with CAPA
2: # a pile of common routines
3: #
4: # $Id: loncommon.pm,v 1.19 2001/12/21 17:06:56 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,12/12,12/17 Scott Harrison
31: # 12/21 Gerd Kortemeyer
32:
33: # Makes a table out of the previous attempts
34: # Inputs result_from_symbread, user, domain, course_id
35: # Reads in non-network-related .tab files
36:
37: package Apache::loncommon;
38:
39: use strict;
40: use POSIX qw(strftime);
41: use Apache::Constants qw(:common);
42: use Apache::lonmsg();
43:
44:
45: my %language;
46: my %cprtag;
47: my %fe; my %fd;
48: my %fc;
49:
50: # ----------------------------------------------------------------------- BEGIN
51: BEGIN {
52: # ------------------------------------------------------------------- languages
53: {
54: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
55: '/language.tab');
56: if ($fh) {
57: while (<$fh>) {
58: next if /^\#/;
59: chomp;
60: my ($key,$val)=(split(/\s+/,$_,2));
61: $language{$key}=$val;
62: }
63: }
64: }
65: # ------------------------------------------------------------------ copyrights
66: {
67: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.
68: '/copyright.tab');
69: if ($fh) {
70: while (<$fh>) {
71: next if /^\#/;
72: chomp;
73: my ($key,$val)=(split(/\s+/,$_,2));
74: $cprtag{$key}=$val;
75: }
76: }
77: }
78: # ------------------------------------------------------------- file categories
79: {
80: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
81: '/filecategories.tab');
82: if ($fh) {
83: while (<$fh>) {
84: next if /^\#/;
85: chomp;
86: my ($key,$val)=(split(/\s+/,$_,2));
87: push @{$fc{$key}},$val;
88: }
89: }
90: }
91: # ------------------------------------------------------------------ file types
92: {
93: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
94: '/filetypes.tab');
95: if ($fh) {
96: while (<$fh>) {
97: next if (/^\#/);
98: chomp;
99: my ($ending,$emb,$descr)=split(/\s+/,$_,3);
100: if ($descr ne '') {
101: $fe{$ending}=lc($emb);
102: $fd{$ending}=$descr;
103: }
104: }
105: }
106: }
107: }
108:
109: # ---------------------------------------------------------------- Language IDs
110: sub languageids {
111: return sort(keys(%language));
112: }
113:
114: # -------------------------------------------------------- Language Description
115: sub languagedescription {
116: return $language{shift(@_)};
117: }
118:
119: # --------------------------------------------------------------- Copyright IDs
120: sub copyrightids {
121: return sort(keys(%cprtag));
122: }
123:
124: # ------------------------------------------------------- Copyright Description
125: sub copyrightdescription {
126: return $cprtag{shift(@_)};
127: }
128:
129: # ------------------------------------------------------------- File Categories
130: sub filecategories {
131: return sort(keys(%fc));
132: }
133:
134: # -------------------------------------- File Types within a specified category
135: sub filecategorytypes {
136: return @{$fc{lc(shift(@_))}};
137: }
138:
139: # ------------------------------------------------------------------ File Types
140: sub fileextensions {
141: return sort(keys(%fe));
142: }
143:
144: # ------------------------------------------------------------- Embedding Style
145: sub fileembstyle {
146: return $fe{lc(shift(@_))};
147: }
148:
149: # ------------------------------------------------------------ Description Text
150: sub filedescription {
151: return $fd{lc(shift(@_))};
152: }
153:
154: # ------------------------------------------------------------ Description Text
155: sub filedescriptionex {
156: my $ex=shift;
157: return '.'.$ex.' '.$fd{lc($ex)};
158: }
159:
160: sub get_previous_attempt {
161: my ($symb,$username,$domain,$course)=@_;
162: my $prevattempts='';
163: if ($symb) {
164: my (%returnhash)=
165: &Apache::lonnet::restore($symb,$course,$domain,$username);
166: if ($returnhash{'version'}) {
167: my %lasthash=();
168: my $version;
169: for ($version=1;$version<=$returnhash{'version'};$version++) {
170: foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
171: $lasthash{$_}=$returnhash{$version.':'.$_};
172: }
173: }
174: $prevattempts='<table border=2></tr><th>History</th>';
175: foreach (sort(keys %lasthash)) {
176: $prevattempts.='<th>'.$_.'</th>';
177: }
178: for ($version=1;$version<=$returnhash{'version'};$version++) {
179: $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
180: foreach (sort(keys %lasthash)) {
181: my $value;
182: if ($_ =~ /timestamp/) {
183: $value=scalar(localtime($returnhash{$version.':'.$_}));
184: } else {
185: $value=$returnhash{$version.':'.$_};
186: }
187: $prevattempts.='<td>'.$value.'</td>';
188: }
189: }
190: $prevattempts.='</tr><tr><th>Current</th>';
191: foreach (sort(keys %lasthash)) {
192: my $value;
193: if ($_ =~ /timestamp/) {
194: $value=scalar(localtime($lasthash{$_}));
195: } else {
196: $value=$lasthash{$_};
197: }
198: $prevattempts.='<td>'.$value.'</td>';
199: }
200: $prevattempts.='</tr></table>';
201: } else {
202: $prevattempts='Nothing submitted - no attempts.';
203: }
204: } else {
205: $prevattempts='No data.';
206: }
207: }
208:
209: sub get_student_view {
210: my ($symb,$username,$domain,$courseid) = @_;
211: my ($map,$id,$feedurl) = split(/___/,$symb);
212: my (%old,%moreenv);
213: my @elements=('symb','courseid','domain','username');
214: foreach my $element (@elements) {
215: $old{$element}=$ENV{'form.grade_'.$element};
216: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
217: }
218: &Apache::lonnet::appenv(%moreenv);
219: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
220: &Apache::lonnet::delenv('form.grade_');
221: foreach my $element (@elements) {
222: $ENV{'form.grade_'.$element}=$old{$element};
223: }
224: $userview=~s/\<body[^\>]*\>//gi;
225: $userview=~s/\<\/body\>//gi;
226: $userview=~s/\<html\>//gi;
227: $userview=~s/\<\/html\>//gi;
228: $userview=~s/\<head\>//gi;
229: $userview=~s/\<\/head\>//gi;
230: $userview=~s/action\s*\=/would_be_action\=/gi;
231: return $userview;
232: }
233:
234: sub get_student_answers {
235: my ($symb,$username,$domain,$courseid) = @_;
236: my ($map,$id,$feedurl) = split(/___/,$symb);
237: my (%old,%moreenv);
238: my @elements=('symb','courseid','domain','username');
239: foreach my $element (@elements) {
240: $old{$element}=$ENV{'form.grade_'.$element};
241: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
242: }
243: $moreenv{'form.grade_target'}='answer';
244: &Apache::lonnet::appenv(%moreenv);
245: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
246: &Apache::lonnet::delenv('form.grade_');
247: foreach my $element (@elements) {
248: $ENV{'form.grade_'.$element}=$old{$element};
249: }
250: $userview=~s/\<body[^\>]*\>//gi;
251: $userview=~s/\<\/body\>//gi;
252: $userview=~s/\<html\>//gi;
253: $userview=~s/\<\/html\>//gi;
254: $userview=~s/\<head\>//gi;
255: $userview=~s/\<\/head\>//gi;
256: $userview=~s/action\s*\=/would_be_action\=/gi;
257: return $userview;
258: }
259:
260: sub get_unprocessed_cgi {
261: my ($query)= @_;
262: foreach (split(/&/,$query)) {
263: my ($name, $value) = split(/=/,$_);
264: $value =~ tr/+/ /;
265: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
266: if (!defined($ENV{'form.'.$name})) { $ENV{'form.'.$name}=$value; }
267: }
268: }
269:
270: sub cacheheader {
271: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
272: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
273: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
274: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
275: return $output;
276: }
277:
278: sub no_cache {
279: my ($r) = @_;
280: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
281: $r->no_cache(1);
282: $r->header_out("Pragma" => "no-cache");
283: $r->header_out("Expires" => $date);
284: }
285: 1;
286: __END__;
287:
288:
289: =head1 NAME
290:
291: Apache::loncommon - pile of common routines
292:
293: =head1 SYNOPSIS
294:
295: Referenced by other mod_perl Apache modules.
296:
297: Invocation:
298: &Apache::loncommon::SUBROUTINENAME(ARGUMENTS);
299:
300: =head1 INTRODUCTION
301:
302: Common collection of used subroutines. This collection helps remove
303: redundancy from other modules and increase efficiency of memory usage.
304:
305: Current things done:
306:
307: Makes a table out of the previous homework attempts
308: Inputs result_from_symbread, user, domain, course_id
309: Reads in non-network-related .tab files
310:
311: This is part of the LearningOnline Network with CAPA project
312: described at http://www.lon-capa.org.
313:
314: =head1 HANDLER SUBROUTINE
315:
316: There is no handler subroutine.
317:
318: =head1 OTHER SUBROUTINES
319:
320: =over 4
321:
322: =item *
323:
324: BEGIN() : initialize values from language.tab, copyright.tab, filetypes.tab,
325: and filecategories.tab.
326:
327: =item *
328:
329: languageids() : returns list of all language ids
330:
331: =item *
332:
333: languagedescription() : returns description of a specified language id
334:
335: =item *
336:
337: copyrightids() : returns list of all copyrights
338:
339: =item *
340:
341: copyrightdescription() : returns description of a specified copyright id
342:
343: =item *
344:
345: filecategories() : returns list of all file categories
346:
347: =item *
348:
349: filecategorytypes() : returns list of file types belonging to a given file
350: category
351:
352: =item *
353:
354: fileembstyle() : returns embedding style for a specified file type
355:
356: =item *
357:
358: filedescription() : returns description for a specified file type
359:
360: =item *
361:
362: filedescriptionex() : returns description for a specified file type with
363: extra formatting
364:
365: =item *
366:
367: get_previous_attempt() : return string with previous attempt on problem
368:
369: =item *
370:
371: get_student_view() : show a snapshot of what student was looking at
372:
373: =item *
374:
375: get_student_answers() : show a snapshot of how student was answering problem
376:
377: =item *
378:
379: get_unprocessed_cgi() : get unparsed CGI parameters
380:
381: =item *
382:
383: cacheheader() : returns cache-controlling header code
384:
385: =item *
386:
387: nocache() : specifies header code to not have cache
388:
389: =back
390:
391: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loncommon.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface