Annotation of loncom/interface/loncommon.pm, revision 1.18
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.18 ! www 4: # $Id: loncommon.pm,v 1.17 2001/12/17 14:16:35 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.17 harris41 30: # 12/11,12/12,12/17 Scott Harrison
1.18 ! www 31: # 12/21 Gerd Kortemeyer
1.1 albertel 32:
33: # Makes a table out of the previous attempts
1.2 albertel 34: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 35: # Reads in non-network-related .tab files
1.1 albertel 36:
37: package Apache::loncommon;
38:
39: use strict;
1.8 albertel 40: use POSIX qw(strftime);
1.1 albertel 41: use Apache::Constants qw(:common);
42: use Apache::lonmsg();
1.12 harris41 43:
1.18 ! www 44:
1.12 harris41 45: my %language;
46: my %cprtag;
47: my %fe; my %fd;
1.15 harris41 48: my %fc;
1.12 harris41 49:
50: # ----------------------------------------------------------------------- BEGIN
1.18 ! www 51: BEGIN {
1.12 harris41 52: # ------------------------------------------------------------------- languages
53: {
54: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
55: '/language.tab');
1.16 harris41 56: if ($fh) {
57: while (<$fh>) {
58: next if /^\#/;
59: chomp;
60: my ($key,$val)=(split(/\s+/,$_,2));
61: $language{$key}=$val;
62: }
1.12 harris41 63: }
64: }
65: # ------------------------------------------------------------------ copyrights
66: {
1.16 harris41 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: }
1.12 harris41 76: }
77: }
1.15 harris41 78: # ------------------------------------------------------------- file categories
79: {
80: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
1.16 harris41 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: }
1.15 harris41 89: }
90: }
1.12 harris41 91: # ------------------------------------------------------------------ file types
92: {
1.16 harris41 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: }
1.12 harris41 104: }
105: }
106: }
1.14 harris41 107: }
108:
109: # ---------------------------------------------------------------- Language IDs
110: sub languageids {
1.16 harris41 111: return sort(keys(%language));
1.14 harris41 112: }
113:
114: # -------------------------------------------------------- Language Description
115: sub languagedescription {
1.16 harris41 116: return $language{shift(@_)};
1.14 harris41 117: }
118:
119: # --------------------------------------------------------------- Copyright IDs
120: sub copyrightids {
1.16 harris41 121: return sort(keys(%cprtag));
1.14 harris41 122: }
123:
124: # ------------------------------------------------------- Copyright Description
125: sub copyrightdescription {
1.16 harris41 126: return $cprtag{shift(@_)};
1.14 harris41 127: }
128:
129: # ------------------------------------------------------------- File Categories
130: sub filecategories {
1.16 harris41 131: return sort(keys(%fc));
1.15 harris41 132: }
1.14 harris41 133:
1.17 harris41 134: # -------------------------------------- File Types within a specified category
1.15 harris41 135: sub filecategorytypes {
1.16 harris41 136: return @{$fc{lc(shift(@_))}};
1.14 harris41 137: }
138:
139: # ------------------------------------------------------------------ File Types
140: sub fileextensions {
1.16 harris41 141: return sort(keys(%fe));
1.14 harris41 142: }
143:
144: # ------------------------------------------------------------- Embedding Style
145: sub fileembstyle {
1.16 harris41 146: return $fe{lc(shift(@_))};
1.14 harris41 147: }
148:
149: # ------------------------------------------------------------ Description Text
150: sub filedescription {
1.16 harris41 151: return $fd{lc(shift(@_))};
152: }
153:
154: # ------------------------------------------------------------ Description Text
155: sub filedescriptionex {
156: my $ex=shift;
157: return '.'.$ex.' '.$fd{lc($ex)};
1.12 harris41 158: }
1.1 albertel 159:
160: sub get_previous_attempt {
1.2 albertel 161: my ($symb,$username,$domain,$course)=@_;
1.1 albertel 162: my $prevattempts='';
163: if ($symb) {
1.3 albertel 164: my (%returnhash)=
165: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 166: if ($returnhash{'version'}) {
167: my %lasthash=();
168: my $version;
169: for ($version=1;$version<=$returnhash{'version'};$version++) {
170: map {
171: $lasthash{$_}=$returnhash{$version.':'.$_};
1.4 albertel 172: } sort(split(/\:/,$returnhash{$version.':keys'}));
1.1 albertel 173: }
174: $prevattempts='<table border=2></tr><th>History</th>';
1.16 harris41 175: foreach (sort(keys %lasthash)) {
1.1 albertel 176: $prevattempts.='<th>'.$_.'</th>';
1.16 harris41 177: }
1.1 albertel 178: for ($version=1;$version<=$returnhash{'version'};$version++) {
179: $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
1.16 harris41 180: foreach (sort(keys %lasthash)) {
1.5 albertel 181: my $value;
182: if ($_ =~ /timestamp/) {
183: $value=scalar(localtime($returnhash{$version.':'.$_}));
184: } else {
185: $value=$returnhash{$version.':'.$_};
186: }
187: $prevattempts.='<td>'.$value.'</td>';
1.16 harris41 188: }
1.1 albertel 189: }
190: $prevattempts.='</tr><tr><th>Current</th>';
1.16 harris41 191: foreach (sort(keys %lasthash)) {
1.5 albertel 192: my $value;
193: if ($_ =~ /timestamp/) {
194: $value=scalar(localtime($lasthash{$_}));
195: } else {
196: $value=$lasthash{$_};
197: }
198: $prevattempts.='<td>'.$value.'</td>';
1.16 harris41 199: }
1.1 albertel 200: $prevattempts.='</tr></table>';
201: } else {
202: $prevattempts='Nothing submitted - no attempts.';
203: }
204: } else {
205: $prevattempts='No data.';
206: }
1.10 albertel 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: }
1.11 albertel 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';
1.10 albertel 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;
1.1 albertel 258: }
259:
1.6 albertel 260: sub get_unprocessed_cgi {
261: my ($query)= @_;
1.16 harris41 262: foreach (split(/&/,$query)) {
1.6 albertel 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; }
1.16 harris41 267: }
1.6 albertel 268: }
269:
1.7 albertel 270: sub cacheheader {
1.8 albertel 271: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7 albertel 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:
1.9 albertel 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: }
1.1 albertel 285: 1;
286: __END__;
1.17 harris41 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