Annotation of loncom/interface/loncommon.pm, revision 1.22
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.20 www 4: # $Id: loncommon.pm,v 1.19 2001/12/21 17:06:56 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.17 harris41 30: # 12/11,12/12,12/17 Scott Harrison
1.18 www 31: # 12/21 Gerd Kortemeyer
1.20 www 32: # 12/21 Scott Harrison
1.22 ! www 33: # 12/25,12/28 Gerd Kortemeyer
1.1 albertel 34:
35: # Makes a table out of the previous attempts
1.2 albertel 36: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 37: # Reads in non-network-related .tab files
1.1 albertel 38:
39: package Apache::loncommon;
40:
41: use strict;
1.22 ! www 42: use Apache::lonnet();
1.8 albertel 43: use POSIX qw(strftime);
1.1 albertel 44: use Apache::Constants qw(:common);
45: use Apache::lonmsg();
1.12 harris41 46:
1.22 ! www 47: my $readit;
! 48:
1.20 www 49: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 50: my %language;
51: my %cprtag;
52: my %fe; my %fd;
1.15 harris41 53: my %fc;
1.12 harris41 54:
1.20 www 55: # -------------------------------------------------------------- Thesaurus data
1.21 www 56: my @therelated;
57: my @theword;
58: my @thecount;
59: my %theindex;
60: my $thetotalcount;
1.20 www 61: my $thefuzzy=2;
62: my $thethreshold=0.1/$thefuzzy;
63: my $theavecount;
64:
1.12 harris41 65: # ----------------------------------------------------------------------- BEGIN
1.18 www 66: BEGIN {
1.22 ! www 67:
! 68: unless ($readit) {
1.12 harris41 69: # ------------------------------------------------------------------- languages
70: {
71: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
72: '/language.tab');
1.16 harris41 73: if ($fh) {
74: while (<$fh>) {
75: next if /^\#/;
76: chomp;
77: my ($key,$val)=(split(/\s+/,$_,2));
78: $language{$key}=$val;
79: }
1.12 harris41 80: }
81: }
82: # ------------------------------------------------------------------ copyrights
83: {
1.16 harris41 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: }
1.12 harris41 93: }
94: }
1.15 harris41 95: # ------------------------------------------------------------- file categories
96: {
97: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
1.16 harris41 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: }
1.15 harris41 106: }
107: }
1.12 harris41 108: # ------------------------------------------------------------------ file types
109: {
1.16 harris41 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: }
1.12 harris41 121: }
122: }
123: }
1.20 www 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: }
1.22 ! www 140: &Apache::lonnet::logthis(
! 141: "<font color=yellow>INFO: Read file types and thesaurus</font>");
! 142: $readit=1;
! 143: }
! 144:
1.20 www 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 ();
1.14 harris41 205: }
206:
207: # ---------------------------------------------------------------- Language IDs
208: sub languageids {
1.16 harris41 209: return sort(keys(%language));
1.14 harris41 210: }
211:
212: # -------------------------------------------------------- Language Description
213: sub languagedescription {
1.16 harris41 214: return $language{shift(@_)};
1.14 harris41 215: }
216:
217: # --------------------------------------------------------------- Copyright IDs
218: sub copyrightids {
1.16 harris41 219: return sort(keys(%cprtag));
1.14 harris41 220: }
221:
222: # ------------------------------------------------------- Copyright Description
223: sub copyrightdescription {
1.16 harris41 224: return $cprtag{shift(@_)};
1.14 harris41 225: }
226:
227: # ------------------------------------------------------------- File Categories
228: sub filecategories {
1.16 harris41 229: return sort(keys(%fc));
1.15 harris41 230: }
1.14 harris41 231:
1.17 harris41 232: # -------------------------------------- File Types within a specified category
1.15 harris41 233: sub filecategorytypes {
1.16 harris41 234: return @{$fc{lc(shift(@_))}};
1.14 harris41 235: }
236:
237: # ------------------------------------------------------------------ File Types
238: sub fileextensions {
1.16 harris41 239: return sort(keys(%fe));
1.14 harris41 240: }
241:
242: # ------------------------------------------------------------- Embedding Style
243: sub fileembstyle {
1.16 harris41 244: return $fe{lc(shift(@_))};
1.14 harris41 245: }
246:
247: # ------------------------------------------------------------ Description Text
248: sub filedescription {
1.16 harris41 249: return $fd{lc(shift(@_))};
250: }
251:
252: # ------------------------------------------------------------ Description Text
253: sub filedescriptionex {
254: my $ex=shift;
255: return '.'.$ex.' '.$fd{lc($ex)};
1.12 harris41 256: }
1.1 albertel 257:
258: sub get_previous_attempt {
1.2 albertel 259: my ($symb,$username,$domain,$course)=@_;
1.1 albertel 260: my $prevattempts='';
261: if ($symb) {
1.3 albertel 262: my (%returnhash)=
263: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 264: if ($returnhash{'version'}) {
265: my %lasthash=();
266: my $version;
267: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.19 harris41 268: foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
1.1 albertel 269: $lasthash{$_}=$returnhash{$version.':'.$_};
1.19 harris41 270: }
1.1 albertel 271: }
272: $prevattempts='<table border=2></tr><th>History</th>';
1.16 harris41 273: foreach (sort(keys %lasthash)) {
1.1 albertel 274: $prevattempts.='<th>'.$_.'</th>';
1.16 harris41 275: }
1.1 albertel 276: for ($version=1;$version<=$returnhash{'version'};$version++) {
277: $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
1.16 harris41 278: foreach (sort(keys %lasthash)) {
1.5 albertel 279: my $value;
280: if ($_ =~ /timestamp/) {
281: $value=scalar(localtime($returnhash{$version.':'.$_}));
282: } else {
283: $value=$returnhash{$version.':'.$_};
284: }
285: $prevattempts.='<td>'.$value.'</td>';
1.16 harris41 286: }
1.1 albertel 287: }
288: $prevattempts.='</tr><tr><th>Current</th>';
1.16 harris41 289: foreach (sort(keys %lasthash)) {
1.5 albertel 290: my $value;
291: if ($_ =~ /timestamp/) {
292: $value=scalar(localtime($lasthash{$_}));
293: } else {
294: $value=$lasthash{$_};
295: }
296: $prevattempts.='<td>'.$value.'</td>';
1.16 harris41 297: }
1.1 albertel 298: $prevattempts.='</tr></table>';
299: } else {
300: $prevattempts='Nothing submitted - no attempts.';
301: }
302: } else {
303: $prevattempts='No data.';
304: }
1.10 albertel 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: }
1.11 albertel 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';
1.10 albertel 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;
1.1 albertel 356: }
357:
1.6 albertel 358: sub get_unprocessed_cgi {
359: my ($query)= @_;
1.16 harris41 360: foreach (split(/&/,$query)) {
1.6 albertel 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; }
1.16 harris41 365: }
1.6 albertel 366: }
367:
1.7 albertel 368: sub cacheheader {
1.8 albertel 369: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7 albertel 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:
1.9 albertel 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: }
1.1 albertel 383: 1;
384: __END__;
1.17 harris41 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