Annotation of loncom/interface/loncommon.pm, revision 1.13
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.13 ! harris41 4: # $Id: loncommon.pm,v 1.12 2001/12/11 13:49:57 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: }
83: }
1.1 albertel 84:
85: sub get_previous_attempt {
1.2 albertel 86: my ($symb,$username,$domain,$course)=@_;
1.1 albertel 87: my $prevattempts='';
88: if ($symb) {
1.3 albertel 89: my (%returnhash)=
90: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 91: if ($returnhash{'version'}) {
92: my %lasthash=();
93: my $version;
94: for ($version=1;$version<=$returnhash{'version'};$version++) {
95: map {
96: $lasthash{$_}=$returnhash{$version.':'.$_};
1.4 albertel 97: } sort(split(/\:/,$returnhash{$version.':keys'}));
1.1 albertel 98: }
99: $prevattempts='<table border=2></tr><th>History</th>';
100: map {
101: $prevattempts.='<th>'.$_.'</th>';
1.4 albertel 102: } sort(keys %lasthash);
1.1 albertel 103: for ($version=1;$version<=$returnhash{'version'};$version++) {
104: $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
105: map {
1.5 albertel 106: my $value;
107: if ($_ =~ /timestamp/) {
108: $value=scalar(localtime($returnhash{$version.':'.$_}));
109: } else {
110: $value=$returnhash{$version.':'.$_};
111: }
112: $prevattempts.='<td>'.$value.'</td>';
1.4 albertel 113: } sort(keys %lasthash);
1.1 albertel 114: }
115: $prevattempts.='</tr><tr><th>Current</th>';
116: map {
1.5 albertel 117: my $value;
118: if ($_ =~ /timestamp/) {
119: $value=scalar(localtime($lasthash{$_}));
120: } else {
121: $value=$lasthash{$_};
122: }
123: $prevattempts.='<td>'.$value.'</td>';
1.4 albertel 124: } sort(keys %lasthash);
1.1 albertel 125: $prevattempts.='</tr></table>';
126: } else {
127: $prevattempts='Nothing submitted - no attempts.';
128: }
129: } else {
130: $prevattempts='No data.';
131: }
1.10 albertel 132: }
133:
134: sub get_student_view {
135: my ($symb,$username,$domain,$courseid) = @_;
136: my ($map,$id,$feedurl) = split(/___/,$symb);
137: my (%old,%moreenv);
138: my @elements=('symb','courseid','domain','username');
139: foreach my $element (@elements) {
140: $old{$element}=$ENV{'form.grade_'.$element};
141: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
142: }
1.11 albertel 143: &Apache::lonnet::appenv(%moreenv);
144: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
145: &Apache::lonnet::delenv('form.grade_');
146: foreach my $element (@elements) {
147: $ENV{'form.grade_'.$element}=$old{$element};
148: }
149: $userview=~s/\<body[^\>]*\>//gi;
150: $userview=~s/\<\/body\>//gi;
151: $userview=~s/\<html\>//gi;
152: $userview=~s/\<\/html\>//gi;
153: $userview=~s/\<head\>//gi;
154: $userview=~s/\<\/head\>//gi;
155: $userview=~s/action\s*\=/would_be_action\=/gi;
156: return $userview;
157: }
158:
159: sub get_student_answers {
160: my ($symb,$username,$domain,$courseid) = @_;
161: my ($map,$id,$feedurl) = split(/___/,$symb);
162: my (%old,%moreenv);
163: my @elements=('symb','courseid','domain','username');
164: foreach my $element (@elements) {
165: $old{$element}=$ENV{'form.grade_'.$element};
166: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
167: }
168: $moreenv{'form.grade_target'}='answer';
1.10 albertel 169: &Apache::lonnet::appenv(%moreenv);
170: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
171: &Apache::lonnet::delenv('form.grade_');
172: foreach my $element (@elements) {
173: $ENV{'form.grade_'.$element}=$old{$element};
174: }
175: $userview=~s/\<body[^\>]*\>//gi;
176: $userview=~s/\<\/body\>//gi;
177: $userview=~s/\<html\>//gi;
178: $userview=~s/\<\/html\>//gi;
179: $userview=~s/\<head\>//gi;
180: $userview=~s/\<\/head\>//gi;
181: $userview=~s/action\s*\=/would_be_action\=/gi;
182: return $userview;
1.1 albertel 183: }
184:
1.6 albertel 185: sub get_unprocessed_cgi {
186: my ($query)= @_;
187: map {
188: my ($name, $value) = split(/=/,$_);
189: $value =~ tr/+/ /;
190: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
191: if (!defined($ENV{'form.'.$name})) { $ENV{'form.'.$name}=$value; }
192: } (split(/&/,$query));
193: }
194:
1.7 albertel 195: sub cacheheader {
1.8 albertel 196: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7 albertel 197: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
198: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
199: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
200: return $output;
201: }
202:
1.9 albertel 203: sub no_cache {
204: my ($r) = @_;
205: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
206: $r->no_cache(1);
207: $r->header_out("Pragma" => "no-cache");
208: $r->header_out("Expires" => $date);
209: }
1.1 albertel 210: 1;
211: __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