Annotation of loncom/interface/loncommon.pm, revision 1.16
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.16 ! harris41 4: # $Id: loncommon.pm,v 1.15 2001/12/11 23:38:28 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.16 ! harris41 30: # 12/11,12/12 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.15 harris41 132: # ------------------------------------------------------------- File Categories
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__;
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