1: # The LearningOnline Network with CAPA
2: # a pile of common routines
3: #
4: # $Id: loncommon.pm,v 1.17 2001/12/17 14:16:35 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:
32: # Makes a table out of the previous attempts
33: # Inputs result_from_symbread, user, domain, course_id
34: # Reads in non-network-related .tab files
35:
36: package Apache::loncommon;
37:
38: use strict;
39: use POSIX qw(strftime);
40: use Apache::Constants qw(:common);
41: use Apache::lonmsg();
42:
43: my %language;
44: my %cprtag;
45: my %fe; my %fd;
46: my %fc;
47:
48: # ----------------------------------------------------------------------- BEGIN
49: sub BEGIN {
50: # ------------------------------------------------------------------- languages
51: {
52: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
53: '/language.tab');
54: if ($fh) {
55: while (<$fh>) {
56: next if /^\#/;
57: chomp;
58: my ($key,$val)=(split(/\s+/,$_,2));
59: $language{$key}=$val;
60: }
61: }
62: }
63: # ------------------------------------------------------------------ copyrights
64: {
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: }
74: }
75: }
76: # ------------------------------------------------------------- file categories
77: {
78: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
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: }
87: }
88: }
89: # ------------------------------------------------------------------ file types
90: {
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: }
102: }
103: }
104: }
105: }
106:
107: # ---------------------------------------------------------------- Language IDs
108: sub languageids {
109: return sort(keys(%language));
110: }
111:
112: # -------------------------------------------------------- Language Description
113: sub languagedescription {
114: return $language{shift(@_)};
115: }
116:
117: # --------------------------------------------------------------- Copyright IDs
118: sub copyrightids {
119: return sort(keys(%cprtag));
120: }
121:
122: # ------------------------------------------------------- Copyright Description
123: sub copyrightdescription {
124: return $cprtag{shift(@_)};
125: }
126:
127: # ------------------------------------------------------------- File Categories
128: sub filecategories {
129: return sort(keys(%fc));
130: }
131:
132: # -------------------------------------- File Types within a specified category
133: sub filecategorytypes {
134: return @{$fc{lc(shift(@_))}};
135: }
136:
137: # ------------------------------------------------------------------ File Types
138: sub fileextensions {
139: return sort(keys(%fe));
140: }
141:
142: # ------------------------------------------------------------- Embedding Style
143: sub fileembstyle {
144: return $fe{lc(shift(@_))};
145: }
146:
147: # ------------------------------------------------------------ Description Text
148: sub filedescription {
149: return $fd{lc(shift(@_))};
150: }
151:
152: # ------------------------------------------------------------ Description Text
153: sub filedescriptionex {
154: my $ex=shift;
155: return '.'.$ex.' '.$fd{lc($ex)};
156: }
157:
158: sub get_previous_attempt {
159: my ($symb,$username,$domain,$course)=@_;
160: my $prevattempts='';
161: if ($symb) {
162: my (%returnhash)=
163: &Apache::lonnet::restore($symb,$course,$domain,$username);
164: if ($returnhash{'version'}) {
165: my %lasthash=();
166: my $version;
167: for ($version=1;$version<=$returnhash{'version'};$version++) {
168: map {
169: $lasthash{$_}=$returnhash{$version.':'.$_};
170: } sort(split(/\:/,$returnhash{$version.':keys'}));
171: }
172: $prevattempts='<table border=2></tr><th>History</th>';
173: foreach (sort(keys %lasthash)) {
174: $prevattempts.='<th>'.$_.'</th>';
175: }
176: for ($version=1;$version<=$returnhash{'version'};$version++) {
177: $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
178: foreach (sort(keys %lasthash)) {
179: my $value;
180: if ($_ =~ /timestamp/) {
181: $value=scalar(localtime($returnhash{$version.':'.$_}));
182: } else {
183: $value=$returnhash{$version.':'.$_};
184: }
185: $prevattempts.='<td>'.$value.'</td>';
186: }
187: }
188: $prevattempts.='</tr><tr><th>Current</th>';
189: foreach (sort(keys %lasthash)) {
190: my $value;
191: if ($_ =~ /timestamp/) {
192: $value=scalar(localtime($lasthash{$_}));
193: } else {
194: $value=$lasthash{$_};
195: }
196: $prevattempts.='<td>'.$value.'</td>';
197: }
198: $prevattempts.='</tr></table>';
199: } else {
200: $prevattempts='Nothing submitted - no attempts.';
201: }
202: } else {
203: $prevattempts='No data.';
204: }
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: }
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';
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;
256: }
257:
258: sub get_unprocessed_cgi {
259: my ($query)= @_;
260: foreach (split(/&/,$query)) {
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; }
265: }
266: }
267:
268: sub cacheheader {
269: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
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:
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: }
283: 1;
284: __END__;
285:
286:
287: =head1 NAME
288:
289: Apache::loncommon - pile of common routines
290:
291: =head1 SYNOPSIS
292:
293: Referenced by other mod_perl Apache modules.
294:
295: Invocation:
296: &Apache::loncommon::SUBROUTINENAME(ARGUMENTS);
297:
298: =head1 INTRODUCTION
299:
300: Common collection of used subroutines. This collection helps remove
301: redundancy from other modules and increase efficiency of memory usage.
302:
303: Current things done:
304:
305: Makes a table out of the previous homework attempts
306: Inputs result_from_symbread, user, domain, course_id
307: Reads in non-network-related .tab files
308:
309: This is part of the LearningOnline Network with CAPA project
310: described at http://www.lon-capa.org.
311:
312: =head1 HANDLER SUBROUTINE
313:
314: There is no handler subroutine.
315:
316: =head1 OTHER SUBROUTINES
317:
318: =over 4
319:
320: =item *
321:
322: BEGIN() : initialize values from language.tab, copyright.tab, filetypes.tab,
323: and filecategories.tab.
324:
325: =item *
326:
327: languageids() : returns list of all language ids
328:
329: =item *
330:
331: languagedescription() : returns description of a specified language id
332:
333: =item *
334:
335: copyrightids() : returns list of all copyrights
336:
337: =item *
338:
339: copyrightdescription() : returns description of a specified copyright id
340:
341: =item *
342:
343: filecategories() : returns list of all file categories
344:
345: =item *
346:
347: filecategorytypes() : returns list of file types belonging to a given file
348: category
349:
350: =item *
351:
352: fileembstyle() : returns embedding style for a specified file type
353:
354: =item *
355:
356: filedescription() : returns description for a specified file type
357:
358: =item *
359:
360: filedescriptionex() : returns description for a specified file type with
361: extra formatting
362:
363: =item *
364:
365: get_previous_attempt() : return string with previous attempt on problem
366:
367: =item *
368:
369: get_student_view() : show a snapshot of what student was looking at
370:
371: =item *
372:
373: get_student_answers() : show a snapshot of how student was answering problem
374:
375: =item *
376:
377: get_unprocessed_cgi() : get unparsed CGI parameters
378:
379: =item *
380:
381: cacheheader() : returns cache-controlling header code
382:
383: =item *
384:
385: nocache() : specifies header code to not have cache
386:
387: =back
388:
389: =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