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