Annotation of loncom/interface/loncommon.pm, revision 1.15
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.15 ! harris41 4: # $Id: loncommon.pm,v 1.14 2001/12/11 19:37:12 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
30: # 12/11 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.1 albertel 34:
35: package Apache::loncommon;
36:
37: use strict;
1.8 albertel 38: use POSIX qw(strftime);
1.1 albertel 39: use Apache::Constants qw(:common);
40: use Apache::lonmsg();
1.12 harris41 41:
42: my %language;
43: my %cprtag;
44: my %fe; my %fd;
1.15 ! harris41 45: my %fc;
1.12 harris41 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));
1.13 harris41 68: $cprtag{$key}=$val;
1.12 harris41 69: }
70: }
1.15 ! harris41 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: }
1.12 harris41 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: }
1.14 harris41 95: }
96:
97: # ---------------------------------------------------------------- Language IDs
98: sub languageids {
1.15 ! harris41 99: return keys(%language);
1.14 harris41 100: }
101:
102: # -------------------------------------------------------- Language Description
103: sub languagedescription {
1.15 ! harris41 104: return $language{shift};
1.14 harris41 105: }
106:
107: # --------------------------------------------------------------- Copyright IDs
108: sub copyrightids {
1.15 ! harris41 109: return keys(%cprtag);
1.14 harris41 110: }
111:
112: # ------------------------------------------------------- Copyright Description
113: sub copyrightdescription {
1.15 ! harris41 114: return $cprtag{shift};
1.14 harris41 115: }
116:
117: # ------------------------------------------------------------- File Categories
118: sub filecategories {
1.15 ! harris41 119: return keys(%fc);
! 120: }
1.14 harris41 121:
1.15 ! harris41 122: # ------------------------------------------------------------- File Categories
! 123: sub filecategorytypes {
! 124: return @{$fc{lc(shift)}};
1.14 harris41 125: }
126:
127: # ------------------------------------------------------------------ File Types
128: sub fileextensions {
1.15 ! harris41 129: return keys(%fe);
1.14 harris41 130: }
131:
132: # ------------------------------------------------------------- Embedding Style
133: sub fileembstyle {
1.15 ! harris41 134: return $fe{lc(shift)};
1.14 harris41 135: }
136:
137: # ------------------------------------------------------------ Description Text
138: sub filedescription {
1.15 ! harris41 139: return $fd{lc(shift)};
1.12 harris41 140: }
1.1 albertel 141:
142: sub get_previous_attempt {
1.2 albertel 143: my ($symb,$username,$domain,$course)=@_;
1.1 albertel 144: my $prevattempts='';
145: if ($symb) {
1.3 albertel 146: my (%returnhash)=
147: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 148: if ($returnhash{'version'}) {
149: my %lasthash=();
150: my $version;
151: for ($version=1;$version<=$returnhash{'version'};$version++) {
152: map {
153: $lasthash{$_}=$returnhash{$version.':'.$_};
1.4 albertel 154: } sort(split(/\:/,$returnhash{$version.':keys'}));
1.1 albertel 155: }
156: $prevattempts='<table border=2></tr><th>History</th>';
157: map {
158: $prevattempts.='<th>'.$_.'</th>';
1.4 albertel 159: } sort(keys %lasthash);
1.1 albertel 160: for ($version=1;$version<=$returnhash{'version'};$version++) {
161: $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
162: map {
1.5 albertel 163: my $value;
164: if ($_ =~ /timestamp/) {
165: $value=scalar(localtime($returnhash{$version.':'.$_}));
166: } else {
167: $value=$returnhash{$version.':'.$_};
168: }
169: $prevattempts.='<td>'.$value.'</td>';
1.4 albertel 170: } sort(keys %lasthash);
1.1 albertel 171: }
172: $prevattempts.='</tr><tr><th>Current</th>';
173: map {
1.5 albertel 174: my $value;
175: if ($_ =~ /timestamp/) {
176: $value=scalar(localtime($lasthash{$_}));
177: } else {
178: $value=$lasthash{$_};
179: }
180: $prevattempts.='<td>'.$value.'</td>';
1.4 albertel 181: } sort(keys %lasthash);
1.1 albertel 182: $prevattempts.='</tr></table>';
183: } else {
184: $prevattempts='Nothing submitted - no attempts.';
185: }
186: } else {
187: $prevattempts='No data.';
188: }
1.10 albertel 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: }
1.11 albertel 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';
1.10 albertel 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;
1.1 albertel 240: }
241:
1.6 albertel 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:
1.7 albertel 252: sub cacheheader {
1.8 albertel 253: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7 albertel 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:
1.9 albertel 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: }
1.1 albertel 267: 1;
268: __END__;
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