Annotation of loncom/interface/loncommon.pm, revision 1.20
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
! 33: # 12/25 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.8 albertel 42: use POSIX qw(strftime);
1.1 albertel 43: use Apache::Constants qw(:common);
44: use Apache::lonmsg();
1.12 harris41 45:
1.20 ! www 46: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 47: my %language;
48: my %cprtag;
49: my %fe; my %fd;
1.15 harris41 50: my %fc;
1.12 harris41 51:
1.20 ! www 52: # -------------------------------------------------------------- Thesaurus data
! 53: my @therelated=();
! 54: my @theword=();
! 55: my @thecount=();
! 56: my %theindex=();
! 57: my $thetotalcount=0;
! 58: my $thefuzzy=2;
! 59: my $thethreshold=0.1/$thefuzzy;
! 60: my $theavecount;
! 61:
1.12 harris41 62: # ----------------------------------------------------------------------- BEGIN
1.18 www 63: BEGIN {
1.12 harris41 64: # ------------------------------------------------------------------- languages
65: {
66: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
67: '/language.tab');
1.16 harris41 68: if ($fh) {
69: while (<$fh>) {
70: next if /^\#/;
71: chomp;
72: my ($key,$val)=(split(/\s+/,$_,2));
73: $language{$key}=$val;
74: }
1.12 harris41 75: }
76: }
77: # ------------------------------------------------------------------ copyrights
78: {
1.16 harris41 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: }
1.12 harris41 88: }
89: }
1.15 harris41 90: # ------------------------------------------------------------- file categories
91: {
92: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
1.16 harris41 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: }
1.15 harris41 101: }
102: }
1.12 harris41 103: # ------------------------------------------------------------------ file types
104: {
1.16 harris41 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: }
1.12 harris41 116: }
117: }
118: }
1.20 ! www 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 ();
1.14 harris41 195: }
196:
197: # ---------------------------------------------------------------- Language IDs
198: sub languageids {
1.16 harris41 199: return sort(keys(%language));
1.14 harris41 200: }
201:
202: # -------------------------------------------------------- Language Description
203: sub languagedescription {
1.16 harris41 204: return $language{shift(@_)};
1.14 harris41 205: }
206:
207: # --------------------------------------------------------------- Copyright IDs
208: sub copyrightids {
1.16 harris41 209: return sort(keys(%cprtag));
1.14 harris41 210: }
211:
212: # ------------------------------------------------------- Copyright Description
213: sub copyrightdescription {
1.16 harris41 214: return $cprtag{shift(@_)};
1.14 harris41 215: }
216:
217: # ------------------------------------------------------------- File Categories
218: sub filecategories {
1.16 harris41 219: return sort(keys(%fc));
1.15 harris41 220: }
1.14 harris41 221:
1.17 harris41 222: # -------------------------------------- File Types within a specified category
1.15 harris41 223: sub filecategorytypes {
1.16 harris41 224: return @{$fc{lc(shift(@_))}};
1.14 harris41 225: }
226:
227: # ------------------------------------------------------------------ File Types
228: sub fileextensions {
1.16 harris41 229: return sort(keys(%fe));
1.14 harris41 230: }
231:
232: # ------------------------------------------------------------- Embedding Style
233: sub fileembstyle {
1.16 harris41 234: return $fe{lc(shift(@_))};
1.14 harris41 235: }
236:
237: # ------------------------------------------------------------ Description Text
238: sub filedescription {
1.16 harris41 239: return $fd{lc(shift(@_))};
240: }
241:
242: # ------------------------------------------------------------ Description Text
243: sub filedescriptionex {
244: my $ex=shift;
245: return '.'.$ex.' '.$fd{lc($ex)};
1.12 harris41 246: }
1.1 albertel 247:
248: sub get_previous_attempt {
1.2 albertel 249: my ($symb,$username,$domain,$course)=@_;
1.1 albertel 250: my $prevattempts='';
251: if ($symb) {
1.3 albertel 252: my (%returnhash)=
253: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 254: if ($returnhash{'version'}) {
255: my %lasthash=();
256: my $version;
257: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.19 harris41 258: foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
1.1 albertel 259: $lasthash{$_}=$returnhash{$version.':'.$_};
1.19 harris41 260: }
1.1 albertel 261: }
262: $prevattempts='<table border=2></tr><th>History</th>';
1.16 harris41 263: foreach (sort(keys %lasthash)) {
1.1 albertel 264: $prevattempts.='<th>'.$_.'</th>';
1.16 harris41 265: }
1.1 albertel 266: for ($version=1;$version<=$returnhash{'version'};$version++) {
267: $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
1.16 harris41 268: foreach (sort(keys %lasthash)) {
1.5 albertel 269: my $value;
270: if ($_ =~ /timestamp/) {
271: $value=scalar(localtime($returnhash{$version.':'.$_}));
272: } else {
273: $value=$returnhash{$version.':'.$_};
274: }
275: $prevattempts.='<td>'.$value.'</td>';
1.16 harris41 276: }
1.1 albertel 277: }
278: $prevattempts.='</tr><tr><th>Current</th>';
1.16 harris41 279: foreach (sort(keys %lasthash)) {
1.5 albertel 280: my $value;
281: if ($_ =~ /timestamp/) {
282: $value=scalar(localtime($lasthash{$_}));
283: } else {
284: $value=$lasthash{$_};
285: }
286: $prevattempts.='<td>'.$value.'</td>';
1.16 harris41 287: }
1.1 albertel 288: $prevattempts.='</tr></table>';
289: } else {
290: $prevattempts='Nothing submitted - no attempts.';
291: }
292: } else {
293: $prevattempts='No data.';
294: }
1.10 albertel 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: }
1.11 albertel 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';
1.10 albertel 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;
1.1 albertel 346: }
347:
1.6 albertel 348: sub get_unprocessed_cgi {
349: my ($query)= @_;
1.16 harris41 350: foreach (split(/&/,$query)) {
1.6 albertel 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; }
1.16 harris41 355: }
1.6 albertel 356: }
357:
1.7 albertel 358: sub cacheheader {
1.8 albertel 359: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7 albertel 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:
1.9 albertel 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: }
1.1 albertel 373: 1;
374: __END__;
1.17 harris41 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