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