1: # The LearningOnline Network with CAPA
2: # a pile of common routines
3: #
4: # $Id: loncommon.pm,v 1.21 2001/12/25 21:57:54 www Exp $
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: #
28: # YEAR=2001
29: # 2/13-12/7 Guy Albertelli
30: # 12/11,12/12,12/17 Scott Harrison
31: # 12/21 Gerd Kortemeyer
32: # 12/21 Scott Harrison
33: # 12/25 Gerd Kortemeyer
34:
35: # Makes a table out of the previous attempts
36: # Inputs result_from_symbread, user, domain, course_id
37: # Reads in non-network-related .tab files
38:
39: package Apache::loncommon;
40:
41: use strict;
42: use POSIX qw(strftime);
43: use Apache::Constants qw(:common);
44: use Apache::lonmsg();
45:
46: # ----------------------------------------------- Filetypes/Languages/Copyright
47: my %language;
48: my %cprtag;
49: my %fe; my %fd;
50: my %fc;
51:
52: # -------------------------------------------------------------- Thesaurus data
53: my @therelated;
54: my @theword;
55: my @thecount;
56: my %theindex;
57: my $thetotalcount;
58: my $thefuzzy=2;
59: my $thethreshold=0.1/$thefuzzy;
60: my $theavecount;
61:
62: # ----------------------------------------------------------------------- BEGIN
63: BEGIN {
64: # ------------------------------------------------------------------- languages
65: {
66: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
67: '/language.tab');
68: if ($fh) {
69: while (<$fh>) {
70: next if /^\#/;
71: chomp;
72: my ($key,$val)=(split(/\s+/,$_,2));
73: $language{$key}=$val;
74: }
75: }
76: }
77: # ------------------------------------------------------------------ copyrights
78: {
79: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.
80: '/copyright.tab');
81: if ($fh) {
82: while (<$fh>) {
83: next if /^\#/;
84: chomp;
85: my ($key,$val)=(split(/\s+/,$_,2));
86: $cprtag{$key}=$val;
87: }
88: }
89: }
90: # ------------------------------------------------------------- file categories
91: {
92: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
93: '/filecategories.tab');
94: if ($fh) {
95: while (<$fh>) {
96: next if /^\#/;
97: chomp;
98: my ($key,$val)=(split(/\s+/,$_,2));
99: push @{$fc{$key}},$val;
100: }
101: }
102: }
103: # ------------------------------------------------------------------ file types
104: {
105: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
106: '/filetypes.tab');
107: if ($fh) {
108: while (<$fh>) {
109: next if (/^\#/);
110: chomp;
111: my ($ending,$emb,$descr)=split(/\s+/,$_,3);
112: if ($descr ne '') {
113: $fe{$ending}=lc($emb);
114: $fd{$ending}=$descr;
115: }
116: }
117: }
118: }
119: # -------------------------------------------------------------- Thesaurus data
120: {
121: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
122: '/thesaurus.dat');
123: if ($fh) {
124: while (<$fh>) {
125: my ($tword,$tindex,$tcount,$trelated)=split(/\@/,$_);
126: $theindex{$tword}=$tindex;
127: $theword[$tindex]=$tword;
128: $thecount[$tindex]=$tcount;
129: $thetotalcount+=$tcount;
130: $therelated[$tindex]=$trelated;
131: }
132: }
133: $theavecount=$thetotalcount/$#thecount;
134: }
135: }
136: # ============================================================= END BEGIN BLOCK
137:
138:
139: # ---------------------------------------------------------- Is this a keyword?
140:
141: sub keyword {
142: my $newword=shift;
143: $newword=~s/\W//g;
144: $newword=~tr/A-Z/a-z/;
145: my $tindex=$theindex{$newword};
146: if ($tindex) {
147: if ($thecount[$tindex]>$theavecount) {
148: return 1;
149: }
150: }
151: return 0;
152: }
153: # -------------------------------------------------------- Return related words
154:
155: sub related {
156: my $newword=shift;
157: $newword=~s/\W//g;
158: $newword=~tr/A-Z/a-z/;
159: my $tindex=$theindex{$newword};
160: if ($tindex) {
161: my %found=();
162: foreach (split(/\,/,$therelated[$tindex])) {
163: # - Related word found
164: my ($ridx,$rcount)=split(/\:/,$_);
165: # - Direct relation index
166: my $directrel=$rcount/$thecount[$tindex];
167: if ($directrel>$thethreshold) {
168: foreach (split(/\,/,$therelated[$ridx])) {
169: my ($rridx,$rrcount)=split(/\:/,$_);
170: if ($rridx==$tindex) {
171: # - Determine reverse relation index
172: my $revrel=$rrcount/$thecount[$ridx];
173: # - Calculate full index
174: $found{$ridx}=$directrel*$revrel;
175: if ($found{$ridx}>$thethreshold) {
176: foreach (split(/\,/,$therelated[$ridx])) {
177: my ($rrridx,$rrrcount)=split(/\:/,$_);
178: unless ($found{$rrridx}) {
179: my $revrevrel=$rrrcount/$thecount[$ridx];
180: if (
181: $directrel*$revrel*$revrevrel>$thethreshold
182: ) {
183: $found{$rrridx}=
184: $directrel*$revrel*$revrevrel;
185: }
186: }
187: }
188: }
189: }
190: }
191: }
192: }
193: }
194: return ();
195: }
196:
197: # ---------------------------------------------------------------- Language IDs
198: sub languageids {
199: return sort(keys(%language));
200: }
201:
202: # -------------------------------------------------------- Language Description
203: sub languagedescription {
204: return $language{shift(@_)};
205: }
206:
207: # --------------------------------------------------------------- Copyright IDs
208: sub copyrightids {
209: return sort(keys(%cprtag));
210: }
211:
212: # ------------------------------------------------------- Copyright Description
213: sub copyrightdescription {
214: return $cprtag{shift(@_)};
215: }
216:
217: # ------------------------------------------------------------- File Categories
218: sub filecategories {
219: return sort(keys(%fc));
220: }
221:
222: # -------------------------------------- File Types within a specified category
223: sub filecategorytypes {
224: return @{$fc{lc(shift(@_))}};
225: }
226:
227: # ------------------------------------------------------------------ File Types
228: sub fileextensions {
229: return sort(keys(%fe));
230: }
231:
232: # ------------------------------------------------------------- Embedding Style
233: sub fileembstyle {
234: return $fe{lc(shift(@_))};
235: }
236:
237: # ------------------------------------------------------------ Description Text
238: sub filedescription {
239: return $fd{lc(shift(@_))};
240: }
241:
242: # ------------------------------------------------------------ Description Text
243: sub filedescriptionex {
244: my $ex=shift;
245: return '.'.$ex.' '.$fd{lc($ex)};
246: }
247:
248: sub get_previous_attempt {
249: my ($symb,$username,$domain,$course)=@_;
250: my $prevattempts='';
251: if ($symb) {
252: my (%returnhash)=
253: &Apache::lonnet::restore($symb,$course,$domain,$username);
254: if ($returnhash{'version'}) {
255: my %lasthash=();
256: my $version;
257: for ($version=1;$version<=$returnhash{'version'};$version++) {
258: foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
259: $lasthash{$_}=$returnhash{$version.':'.$_};
260: }
261: }
262: $prevattempts='<table border=2></tr><th>History</th>';
263: foreach (sort(keys %lasthash)) {
264: $prevattempts.='<th>'.$_.'</th>';
265: }
266: for ($version=1;$version<=$returnhash{'version'};$version++) {
267: $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
268: foreach (sort(keys %lasthash)) {
269: my $value;
270: if ($_ =~ /timestamp/) {
271: $value=scalar(localtime($returnhash{$version.':'.$_}));
272: } else {
273: $value=$returnhash{$version.':'.$_};
274: }
275: $prevattempts.='<td>'.$value.'</td>';
276: }
277: }
278: $prevattempts.='</tr><tr><th>Current</th>';
279: foreach (sort(keys %lasthash)) {
280: my $value;
281: if ($_ =~ /timestamp/) {
282: $value=scalar(localtime($lasthash{$_}));
283: } else {
284: $value=$lasthash{$_};
285: }
286: $prevattempts.='<td>'.$value.'</td>';
287: }
288: $prevattempts.='</tr></table>';
289: } else {
290: $prevattempts='Nothing submitted - no attempts.';
291: }
292: } else {
293: $prevattempts='No data.';
294: }
295: }
296:
297: sub get_student_view {
298: my ($symb,$username,$domain,$courseid) = @_;
299: my ($map,$id,$feedurl) = split(/___/,$symb);
300: my (%old,%moreenv);
301: my @elements=('symb','courseid','domain','username');
302: foreach my $element (@elements) {
303: $old{$element}=$ENV{'form.grade_'.$element};
304: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
305: }
306: &Apache::lonnet::appenv(%moreenv);
307: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
308: &Apache::lonnet::delenv('form.grade_');
309: foreach my $element (@elements) {
310: $ENV{'form.grade_'.$element}=$old{$element};
311: }
312: $userview=~s/\<body[^\>]*\>//gi;
313: $userview=~s/\<\/body\>//gi;
314: $userview=~s/\<html\>//gi;
315: $userview=~s/\<\/html\>//gi;
316: $userview=~s/\<head\>//gi;
317: $userview=~s/\<\/head\>//gi;
318: $userview=~s/action\s*\=/would_be_action\=/gi;
319: return $userview;
320: }
321:
322: sub get_student_answers {
323: my ($symb,$username,$domain,$courseid) = @_;
324: my ($map,$id,$feedurl) = split(/___/,$symb);
325: my (%old,%moreenv);
326: my @elements=('symb','courseid','domain','username');
327: foreach my $element (@elements) {
328: $old{$element}=$ENV{'form.grade_'.$element};
329: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
330: }
331: $moreenv{'form.grade_target'}='answer';
332: &Apache::lonnet::appenv(%moreenv);
333: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
334: &Apache::lonnet::delenv('form.grade_');
335: foreach my $element (@elements) {
336: $ENV{'form.grade_'.$element}=$old{$element};
337: }
338: $userview=~s/\<body[^\>]*\>//gi;
339: $userview=~s/\<\/body\>//gi;
340: $userview=~s/\<html\>//gi;
341: $userview=~s/\<\/html\>//gi;
342: $userview=~s/\<head\>//gi;
343: $userview=~s/\<\/head\>//gi;
344: $userview=~s/action\s*\=/would_be_action\=/gi;
345: return $userview;
346: }
347:
348: sub get_unprocessed_cgi {
349: my ($query)= @_;
350: foreach (split(/&/,$query)) {
351: my ($name, $value) = split(/=/,$_);
352: $value =~ tr/+/ /;
353: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
354: if (!defined($ENV{'form.'.$name})) { $ENV{'form.'.$name}=$value; }
355: }
356: }
357:
358: sub cacheheader {
359: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
360: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
361: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
362: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
363: return $output;
364: }
365:
366: sub no_cache {
367: my ($r) = @_;
368: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
369: $r->no_cache(1);
370: $r->header_out("Pragma" => "no-cache");
371: $r->header_out("Expires" => $date);
372: }
373: 1;
374: __END__;
375:
376:
377: =head1 NAME
378:
379: Apache::loncommon - pile of common routines
380:
381: =head1 SYNOPSIS
382:
383: Referenced by other mod_perl Apache modules.
384:
385: Invocation:
386: &Apache::loncommon::SUBROUTINENAME(ARGUMENTS);
387:
388: =head1 INTRODUCTION
389:
390: Common collection of used subroutines. This collection helps remove
391: redundancy from other modules and increase efficiency of memory usage.
392:
393: Current things done:
394:
395: Makes a table out of the previous homework attempts
396: Inputs result_from_symbread, user, domain, course_id
397: Reads in non-network-related .tab files
398:
399: This is part of the LearningOnline Network with CAPA project
400: described at http://www.lon-capa.org.
401:
402: =head1 HANDLER SUBROUTINE
403:
404: There is no handler subroutine.
405:
406: =head1 OTHER SUBROUTINES
407:
408: =over 4
409:
410: =item *
411:
412: BEGIN() : initialize values from language.tab, copyright.tab, filetypes.tab,
413: and filecategories.tab.
414:
415: =item *
416:
417: languageids() : returns list of all language ids
418:
419: =item *
420:
421: languagedescription() : returns description of a specified language id
422:
423: =item *
424:
425: copyrightids() : returns list of all copyrights
426:
427: =item *
428:
429: copyrightdescription() : returns description of a specified copyright id
430:
431: =item *
432:
433: filecategories() : returns list of all file categories
434:
435: =item *
436:
437: filecategorytypes() : returns list of file types belonging to a given file
438: category
439:
440: =item *
441:
442: fileembstyle() : returns embedding style for a specified file type
443:
444: =item *
445:
446: filedescription() : returns description for a specified file type
447:
448: =item *
449:
450: filedescriptionex() : returns description for a specified file type with
451: extra formatting
452:
453: =item *
454:
455: get_previous_attempt() : return string with previous attempt on problem
456:
457: =item *
458:
459: get_student_view() : show a snapshot of what student was looking at
460:
461: =item *
462:
463: get_student_answers() : show a snapshot of how student was answering problem
464:
465: =item *
466:
467: get_unprocessed_cgi() : get unparsed CGI parameters
468:
469: =item *
470:
471: cacheheader() : returns cache-controlling header code
472:
473: =item *
474:
475: nocache() : specifies header code to not have cache
476:
477: =back
478:
479: =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