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