Annotation of loncom/interface/loncommon.pm, revision 1.14
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.14 ! harris41 4: # $Id: loncommon.pm,v 1.13 2001/12/11 13:51:38 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;
45:
46: # ----------------------------------------------------------------------- BEGIN
47: sub BEGIN {
48: # ------------------------------------------------------------------- languages
49: {
50: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
51: '/language.tab');
52: while (<$fh>) {
53: next if /^\#/;
54: chomp;
55: my ($key,$val)=(split(/\s+/,$_,2));
56: $language{$key}=$val;
57: }
58: }
59: # ------------------------------------------------------------------ copyrights
60: {
61: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
62: '/copyright.tab');
63: while (<$fh>) {
64: next if /^\#/;
65: chomp;
66: my ($key,$val)=(split(/\s+/,$_,2));
1.13 harris41 67: $cprtag{$key}=$val;
1.12 harris41 68: }
69: }
70: # ------------------------------------------------------------------ file types
71: {
72: my $fh=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");
73: while (<$fh>) {
74: next if (/^\#/);
75: chomp;
76: my ($ending,$emb,$descr)=split(/\s+/,$_,3);
77: if ($descr ne '') {
78: $fe{$ending}=lc($emb);
79: $fd{$ending}=join(' ',@descr);
80: }
81: }
82: }
1.14 ! harris41 83: }
! 84:
! 85: # ---------------------------------------------------------------- Language IDs
! 86: sub languageids {
! 87:
! 88: }
! 89:
! 90: # -------------------------------------------------------- Language Description
! 91: sub languagedescription {
! 92:
! 93: }
! 94:
! 95: # --------------------------------------------------------------- Copyright IDs
! 96: sub copyrightids {
! 97:
! 98: }
! 99:
! 100: # ------------------------------------------------------- Copyright Description
! 101: sub copyrightdescription {
! 102:
! 103: }
! 104:
! 105: # ------------------------------------------------------------- File Categories
! 106: sub filecategories {
! 107:
! 108: }
! 109:
! 110: # ------------------------------------------------------------------ File Types
! 111: sub fileextensions {
! 112:
! 113: }
! 114:
! 115: # ------------------------------------------------------------- Embedding Style
! 116: sub fileembstyle {
! 117:
! 118: }
! 119:
! 120: # ------------------------------------------------------------ Description Text
! 121: sub filedescription {
! 122:
1.12 harris41 123: }
1.1 albertel 124:
125: sub get_previous_attempt {
1.2 albertel 126: my ($symb,$username,$domain,$course)=@_;
1.1 albertel 127: my $prevattempts='';
128: if ($symb) {
1.3 albertel 129: my (%returnhash)=
130: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 131: if ($returnhash{'version'}) {
132: my %lasthash=();
133: my $version;
134: for ($version=1;$version<=$returnhash{'version'};$version++) {
135: map {
136: $lasthash{$_}=$returnhash{$version.':'.$_};
1.4 albertel 137: } sort(split(/\:/,$returnhash{$version.':keys'}));
1.1 albertel 138: }
139: $prevattempts='<table border=2></tr><th>History</th>';
140: map {
141: $prevattempts.='<th>'.$_.'</th>';
1.4 albertel 142: } sort(keys %lasthash);
1.1 albertel 143: for ($version=1;$version<=$returnhash{'version'};$version++) {
144: $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
145: map {
1.5 albertel 146: my $value;
147: if ($_ =~ /timestamp/) {
148: $value=scalar(localtime($returnhash{$version.':'.$_}));
149: } else {
150: $value=$returnhash{$version.':'.$_};
151: }
152: $prevattempts.='<td>'.$value.'</td>';
1.4 albertel 153: } sort(keys %lasthash);
1.1 albertel 154: }
155: $prevattempts.='</tr><tr><th>Current</th>';
156: map {
1.5 albertel 157: my $value;
158: if ($_ =~ /timestamp/) {
159: $value=scalar(localtime($lasthash{$_}));
160: } else {
161: $value=$lasthash{$_};
162: }
163: $prevattempts.='<td>'.$value.'</td>';
1.4 albertel 164: } sort(keys %lasthash);
1.1 albertel 165: $prevattempts.='</tr></table>';
166: } else {
167: $prevattempts='Nothing submitted - no attempts.';
168: }
169: } else {
170: $prevattempts='No data.';
171: }
1.10 albertel 172: }
173:
174: sub get_student_view {
175: my ($symb,$username,$domain,$courseid) = @_;
176: my ($map,$id,$feedurl) = split(/___/,$symb);
177: my (%old,%moreenv);
178: my @elements=('symb','courseid','domain','username');
179: foreach my $element (@elements) {
180: $old{$element}=$ENV{'form.grade_'.$element};
181: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
182: }
1.11 albertel 183: &Apache::lonnet::appenv(%moreenv);
184: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
185: &Apache::lonnet::delenv('form.grade_');
186: foreach my $element (@elements) {
187: $ENV{'form.grade_'.$element}=$old{$element};
188: }
189: $userview=~s/\<body[^\>]*\>//gi;
190: $userview=~s/\<\/body\>//gi;
191: $userview=~s/\<html\>//gi;
192: $userview=~s/\<\/html\>//gi;
193: $userview=~s/\<head\>//gi;
194: $userview=~s/\<\/head\>//gi;
195: $userview=~s/action\s*\=/would_be_action\=/gi;
196: return $userview;
197: }
198:
199: sub get_student_answers {
200: my ($symb,$username,$domain,$courseid) = @_;
201: my ($map,$id,$feedurl) = split(/___/,$symb);
202: my (%old,%moreenv);
203: my @elements=('symb','courseid','domain','username');
204: foreach my $element (@elements) {
205: $old{$element}=$ENV{'form.grade_'.$element};
206: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
207: }
208: $moreenv{'form.grade_target'}='answer';
1.10 albertel 209: &Apache::lonnet::appenv(%moreenv);
210: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
211: &Apache::lonnet::delenv('form.grade_');
212: foreach my $element (@elements) {
213: $ENV{'form.grade_'.$element}=$old{$element};
214: }
215: $userview=~s/\<body[^\>]*\>//gi;
216: $userview=~s/\<\/body\>//gi;
217: $userview=~s/\<html\>//gi;
218: $userview=~s/\<\/html\>//gi;
219: $userview=~s/\<head\>//gi;
220: $userview=~s/\<\/head\>//gi;
221: $userview=~s/action\s*\=/would_be_action\=/gi;
222: return $userview;
1.1 albertel 223: }
224:
1.6 albertel 225: sub get_unprocessed_cgi {
226: my ($query)= @_;
227: map {
228: my ($name, $value) = split(/=/,$_);
229: $value =~ tr/+/ /;
230: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
231: if (!defined($ENV{'form.'.$name})) { $ENV{'form.'.$name}=$value; }
232: } (split(/&/,$query));
233: }
234:
1.7 albertel 235: sub cacheheader {
1.8 albertel 236: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7 albertel 237: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
238: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
239: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
240: return $output;
241: }
242:
1.9 albertel 243: sub no_cache {
244: my ($r) = @_;
245: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
246: $r->no_cache(1);
247: $r->header_out("Pragma" => "no-cache");
248: $r->header_out("Expires" => $date);
249: }
1.1 albertel 250: 1;
251: __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