File:
[LON-CAPA] /
rat /
lonuserstate.pm
Revision
1.42:
download - view:
text,
annotated -
select for diffs
Fri Sep 6 15:18:23 2002 UTC (21 years, 7 months ago) by
www
Branches:
MAIN
CVS tags:
HEAD
"showdoc" needs to be URL-encode like all the other functionality in order to
properly register with the remote. Remote has now additional fields to store symb, but
nothing is done with them yet. Eventually, this should improve navigation and contents
display for resources showing up multiple times.
1: # The LearningOnline Network with CAPA
2: # Construct and maintain state and binary representation of course for user
3: #
4: # $Id: lonuserstate.pm,v 1.42 2002/09/06 15:18:23 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: # (Server for RAT Maps
29: #
30: # (Edit Handler for RAT Maps
31: # (TeX Content Handler
32: #
33: # YEAR=2000
34: # 05/29/00,05/30 Gerd Kortemeyer)
35: # 7/1 Gerd Kortemeyer)
36: # 7/1,7/3,7/4,7/7,7/8,7/10 Gerd Kortemeyer)
37: #
38: # 7/15,7/17,7/18,8/1,8/2,8/4,8/5,8/21,8/22,8/23,8/30,
39: # 9/2,9/4,9/29,9/30,10/2,10/11,10/30,10/31,
40: # 11/1,11/2,11/14,11/16,11/22,12/28,
41: # YEAR=2001
42: # 07/05/01,08/30,08/31 Gerd Kortemeyer
43: # 12/16 Scott Harrison
44: #
45: ###
46:
47: package Apache::lonuserstate;
48:
49: # ------------------------------------------------- modules used by this module
50: use strict;
51: use Apache::Constants qw(:common :http);
52: use Apache::File;
53: use HTML::TokeParser;
54: use Apache::lonnet();
55: use Apache::loncommon();
56: use GDBM_File;
57: use Apache::lonmsg;
58: use Safe;
59: use Safe::Hole;
60: use Opcode;
61:
62: # ---------------------------------------------------- Globals for this package
63:
64: my $pc; # Package counter
65: my %hash; # The big tied hash
66: my %parmhash;# The hash with the parameters
67: my @cond; # Array with all of the conditions
68: my $errtext; # variable with all errors
69: my $retfurl; # variable with the very first URL in the course
70: my %randompick; # randomly picked resources
71: # --------------------------------------------------------- Loads map from disk
72:
73: sub loadmap {
74: my $uri=shift;
75: if ($hash{'map_pc_'.$uri}) { return OK; }
76:
77: $pc++;
78: my $lpc=$pc;
79: $hash{'map_pc_'.$uri}=$lpc;
80: $hash{'map_id_'.$lpc}=$uri;
81:
82: # Determine and check filename
83: my $fn=&Apache::lonnet::filelocation('',$uri);
84:
85: my $ispage=($fn=~/\.page$/);
86:
87: unless (($fn=~/\.sequence$/) ||
88: ($fn=~/\.page$/)) {
89: $errtext.="Invalid map: $fn\n";
90: return OK;
91: }
92:
93: my $instr=&Apache::lonnet::getfile($fn);
94:
95: unless ($instr == -1) {
96:
97: # Successfully got file, parse it
98:
99: my $parser = HTML::TokeParser->new(\$instr);
100: my $token;
101:
102: my $linkpc=0;
103:
104: $fn=~/\.(\w+)$/;
105:
106: $hash{'map_type_'.$lpc}=$1;
107:
108: while ($token = $parser->get_token) {
109: if ($token->[0] eq 'S') {
110: if ($token->[1] eq 'resource') {
111: # -------------------------------------------------------------------- Resource
112:
113: my $rid=$lpc.'.'.$token->[2]->{'id'};
114:
115: $hash{'kind_'.$rid}='res';
116: $hash{'title_'.$rid}=$token->[2]->{'title'};
117: my $turi=$token->[2]->{'src'};
118: unless ($ispage) {
119: $turi=~/\.(\w+)$/;
120: my $embstyle=&Apache::loncommon::fileembstyle($1);
121: if ($token->[2]->{'external'} eq 'true') { # external
122: $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;
123: } elsif ($turi=~/^\/*uploaded\//) { # uploaded
124: if (($embstyle eq 'img') || ($embstyle eq 'emb')
125: || ($embstyle eq 'ssi')) {
126: $turi='/adm/wrapper'.$turi;
127: } elsif ($turi!~/\.(sequence|page)$/) {
128: $turi='/adm/coursedocs/showdoc'.$turi;
129: }
130: } else { # normal internal resource
131: if (($embstyle eq 'img') || ($embstyle eq 'emb')
132: || ($turi=~/\/syllabus$/) || ($turi=~/\/aboutme$/)
133: || ($turi=~/\/navmaps$/)) {
134: $turi='/adm/wrapper'.$turi;
135: }
136: }
137: }
138: $hash{'src_'.$rid}=$turi;
139:
140: if (defined($hash{'ids_'.$turi})) {
141: $hash{'ids_'.$turi}.=','.$rid;
142: } else {
143: $hash{'ids_'.$turi}=''.$rid;
144: }
145:
146: if ($token->[2]->{'external'} eq 'true') {
147: $hash{'ext_'.$rid}='true:';
148: } else {
149: $hash{'ext_'.$rid}='false:';
150: }
151: if ($token->[2]->{'type'}) {
152: $hash{'type_'.$rid}=$token->[2]->{'type'};
153: if ($token->[2]->{'type'} eq 'start') {
154: $hash{'map_start_'.$uri}="$rid";
155: }
156: if ($token->[2]->{'type'} eq 'finish') {
157: $hash{'map_finish_'.$uri}="$rid";
158: }
159: } else {
160: $hash{'type_'.$rid}='normal';
161: }
162:
163: if (($turi=~/\.sequence$/) ||
164: ($turi=~/\.page$/)) {
165: $hash{'is_map_'.$rid}=1;
166: &loadmap($turi);
167: }
168:
169: } elsif ($token->[1] eq 'condition') {
170: # ------------------------------------------------------------------- Condition
171:
172: my $rid=$lpc.'.'.$token->[2]->{'id'};
173:
174: $hash{'kind_'.$rid}='cond';
175: $cond[$#cond+1]=$token->[2]->{'value'};
176: $hash{'condid_'.$rid}=$#cond;
177: if ($token->[2]->{'type'}) {
178: $cond[$#cond].=':'.$token->[2]->{'type'};
179: } else {
180: $cond[$#cond].=':normal';
181: }
182:
183: } elsif ($token->[1] eq 'link') {
184: # ----------------------------------------------------------------------- Links
185:
186: $linkpc++;
187: my $linkid=$lpc.'.'.$linkpc;
188:
189: my $goesto=$lpc.'.'.$token->[2]->{'to'};
190: my $comesfrom=$lpc.'.'.$token->[2]->{'from'};
191: my $undercond=0;
192:
193: if ($token->[2]->{'condition'}) {
194: $undercond=$lpc.'.'.$token->[2]->{'condition'};
195: }
196:
197: $hash{'goesto_'.$linkid}=$goesto;
198: $hash{'comesfrom_'.$linkid}=$comesfrom;
199: $hash{'undercond_'.$linkid}=$undercond;
200:
201: if (defined($hash{'to_'.$comesfrom})) {
202: $hash{'to_'.$comesfrom}.=','.$linkid;
203: } else {
204: $hash{'to_'.$comesfrom}=''.$linkid;
205: }
206: if (defined($hash{'from_'.$goesto})) {
207: $hash{'from_'.$goesto}.=','.$linkid;
208: } else {
209: $hash{'from_'.$goesto}=''.$linkid;
210: }
211: } elsif ($token->[1] eq 'param') {
212: # ------------------------------------------------------------------- Parameter
213:
214: my $referid=$lpc.'.'.$token->[2]->{'to'};
215: my $part=$token->[2]->{'part'};
216: unless ($part) { $part=0; }
217: my $newparam=
218: &Apache::lonnet::escape($token->[2]->{'type'}).':'.
219: &Apache::lonnet::escape($part.'.'.
220: $token->[2]->{'name'}).'='.
221: &Apache::lonnet::escape($token->[2]->{'value'});
222: if (defined($hash{'param_'.$referid})) {
223: $hash{'param_'.$referid}.='&'.$newparam;
224: } else {
225: $hash{'param_'.$referid}=''.$newparam;
226: }
227: if ($token->[2]->{'name'} eq 'parameter_mapalias') {
228: $hash{'mapalias_'.$token->[2]->{'value'}}=$referid;
229: }
230: if ($token->[2]->{'name'} eq 'parameter_randompick') {
231: $randompick{$referid}=$token->[2]->{'value'};
232: }
233: }
234:
235: }
236: }
237:
238: } else {
239: $errtext.='Map not loaded: The file does not exist. ';
240: }
241: }
242:
243: # --------------------------------------------------------- Simplify expression
244:
245: sub simplify {
246: my $expression=shift;
247: # (8)=8
248: $expression=~s/\((\d+)\)/$1/g;
249: # 8&8=8
250: $expression=~s/(\D)(\d+)\&\2(\D)/$1$2$3/g;
251: # 8|8=8
252: $expression=~s/(\D)(\d+)\|\2(\D)/$1$2$3/g;
253: # (5&3)&4=5&3&4
254: $expression=~s/\((\d+)((?:\&\d+)+)\)\&(\d+\D)/$1$2\&$3/g;
255: # (((5&3)|(4&6)))=((5&3)|(4&6))
256: $expression=~
257: s/\((\(\(\d+(?:\&\d+)*\)(?:\|\(\d+(?:\&\d+)*\))+\))\)/$1/g;
258: # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2)
259: $expression=~
260: s/\((\(\d+(?:\&\d+)*\))((?:\|\(\d+(?:\&\d+)*\))+)\)\|(\(\d+(?:\&\d+)*\))/\($1$2\|$3\)/g;
261: return $expression;
262: }
263:
264: # -------------------------------------------------------- Build condition hash
265:
266: sub traceroute {
267: my ($sofar,$rid,$beenhere)=@_;
268: $sofar=simplify($sofar);
269: unless ($beenhere=~/\&$rid\&/) {
270: $beenhere.=$rid.'&';
271: if (($retfurl eq '') && ($hash{'src_'.$rid})) {
272: my ($mapid,$resid)=split(/\./,$rid);
273: $retfurl=$hash{'src_'.$rid}.
274: (($hash{'src_'.$rid}=~/\?/)?'&':'?').'symb='.
275: &Apache::lonnet::symbclean(
276: &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).
277: '___'.$resid.'___'.
278: &Apache::lonnet::declutter($hash{'src_'.$rid}));
279: }
280: if (defined($hash{'conditions_'.$rid})) {
281: $hash{'conditions_'.$rid}=simplify(
282: '('.$hash{'conditions_'.$rid}.')|('.$sofar.')');
283: } else {
284: $hash{'conditions_'.$rid}=$sofar;
285: }
286: if (defined($hash{'is_map_'.$rid})) {
287: if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
288: &traceroute($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},'&');
289: if (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) {
290: $sofar=
291: $hash{'conditions_'.$hash{'map_finish_'.$hash{'src_'.$rid}}};
292: }
293: }
294: }
295: if (defined($hash{'to_'.$rid})) {
296: foreach (split(/\,/,$hash{'to_'.$rid})) {
297: my $further=$sofar;
298: if ($hash{'undercond_'.$_}) {
299: if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) {
300: $further=simplify('('.$further.')&('.
301: $hash{'condid_'.$hash{'undercond_'.$_}}.')');
302: } else {
303: $errtext.='Undefined condition ID: '
304: .$hash{'undercond_'.$_}.'. ';
305: }
306: }
307: &traceroute($further,$hash{'goesto_'.$_},$beenhere);
308: }
309: }
310: }
311: }
312:
313: # ------------------------------ Cascading conditions, quick access, parameters
314:
315: sub accinit {
316: my ($uri,$short,$fn)=@_;
317: my %acchash=();
318: my %captured=();
319: my $condcounter=0;
320: $acchash{'acc.cond.'.$short.'.0'}=0;
321: foreach (keys %hash) {
322: if ($_=~/^conditions/) {
323: my $expr=$hash{$_};
324: foreach ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g) {
325: my $sub=$_;
326: my $orig=$_;
327: $sub=~/\(\((\d+\&(:?\d+\&)*)(?:\d+\&*)+\)(?:\|\(\1(?:\d+\&*)+\))+\)/;
328: my $factor=$1;
329: $sub=~s/$factor//g;
330: $sub=~s/^\(/\($factor\(/;
331: $sub.=')';
332: $sub=simplify($sub);
333: $orig=~s/(\W)/\\$1/g;
334: $expr=~s/$orig/$sub/;
335: }
336: $hash{$_}=$expr;
337: unless (defined($captured{$expr})) {
338: $condcounter++;
339: $captured{$expr}=$condcounter;
340: $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;
341: }
342: } elsif ($_=~/^param_(\d+)\.(\d+)/) {
343: my $prefix=&Apache::lonnet::declutter($hash{'map_id_'.$1}).
344: '___'.$2.'___'.&Apache::lonnet::declutter($hash{'src_'.$1.'.'.$2});
345: foreach (split(/\&/,$hash{$_})) {
346: my ($typename,$value)=split(/\=/,$_);
347: my ($type,$name)=split(/\:/,$typename);
348: $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name)}=
349: &Apache::lonnet::unescape($value);
350: $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name).'.type'}=
351: &Apache::lonnet::unescape($type);
352: }
353: }
354: }
355: foreach (keys %hash) {
356: if ($_=~/^ids/) {
357: foreach (split(/\,/,$hash{$_})) {
358: my $resid=$_;
359: my $uri=$hash{'src_'.$resid};
360: $uri=~s/^\/adm\/wrapper//;
361: my @uriparts=split(/\//,$uri);
362: my $urifile=$uriparts[$#uriparts];
363: $#uriparts--;
364: my $uripath=join('/',@uriparts);
365: $uripath=~s/^\/res\///;
366: if ($uripath) {
367: my $uricond='0';
368: if (defined($hash{'conditions_'.$resid})) {
369: $uricond=$captured{$hash{'conditions_'.$resid}};
370: }
371: if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) {
372: if ($acchash{'acc.res.'.$short.'.'.$uripath}=~
373: /(\&$urifile\:[^\&]*)/) {
374: my $replace=$1;
375: my $regexp=$replace;
376: $regexp=~s/\|/\\\|/g;
377: $acchash{'acc.res.'.$short.'.'.$uripath}
378: =~s/$regexp/$replace\|$uricond/;
379: } else {
380: $acchash{'acc.res.'.$short.'.'.$uripath}.=
381: $urifile.':'.$uricond.'&';
382: }
383: } else {
384: $acchash{'acc.res.'.$short.'.'.$uripath}=
385: '&'.$urifile.':'.$uricond.'&';
386: }
387: }
388: }
389: }
390: }
391: $acchash{'acc.res.'.$short.'.'}='&:0&';
392: my $courseuri=$uri;
393: $courseuri=~s/^\/res\///;
394: &Apache::lonnet::delenv('(acc\.|httpref\.)');
395: &Apache::lonnet::appenv(%acchash,
396: "request.course.id" => $short,
397: "request.course.fn" => $fn,
398: "request.course.uri" => $courseuri);
399: }
400:
401: # ------------------------------------- Selectively delete from randompick maps
402:
403: sub pickrandom {
404: my $randomoutentry='';
405: foreach my $rid (keys %randompick) {
406: my $rndpick=$randompick{$rid};
407: my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}};
408: # ------------------------------------------- put existing resources into array
409: my @currentrids=();
410: foreach (keys %hash) {
411: if ($_=~/^src_($mpc\.\d+)/) {
412: if ($hash{'src_'.$1}) { push @currentrids, $1; }
413: }
414: }
415: next if ($#currentrids<$rndpick);
416: # -------------------------------- randomly eliminate the ones that should stay
417: srand(&Apache::lonnet::rndseed($rid)); # use rid instead of symb
418: for (my $i=1;$i<=$rndpick;$i++) {
419: while (1) {
420: my $randomidx=int(rand($#currentrids+1));
421: if ($currentrids[$randomidx]) {
422: $currentrids[$randomidx]='';
423: last;
424: }
425: }
426: }
427: # -------------------------------------------------------- delete the leftovers
428: for (my $k=0; $k<=$#currentrids; $k++) {
429: if ($currentrids[$k]) {
430: $hash{'randomout_'.$currentrids[$k]}=1;
431: my ($mapid,$resid)=split(/\./,$currentrids[$k]);
432: $randomoutentry.='&'.
433: &Apache::lonnet::symbclean(
434: &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).
435: '___'.$resid.'___'.
436: &Apache::lonnet::declutter($hash{'src_'.$currentrids[$k]})
437: ).'&';
438: }
439: }
440: }
441: if ($randomoutentry) {
442: &Apache::lonnet::appenv('acc.randomout' => $randomoutentry);
443: }
444: }
445:
446: # ---------------------------------------------------- Read map and all submaps
447:
448: sub readmap {
449: my $short=shift;
450: $short=~s/^\///;
451: my %cenv=&Apache::lonnet::coursedescription($short);
452: my $fn=$cenv{'fn'};
453: my $uri;
454: $short=~s/\//\_/g;
455: unless ($uri=$cenv{'url'}) {
456: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
457: "Could not load course $short.</font>");
458: return 'No course data available.';
459: }
460: @cond=('true:normal');
461: unlink($fn.'.db');
462: unlink($fn.'_symb.db');
463: unlink($fn.'.state');
464: unlink($fn.'parms.db');
465: undef %randompick;
466: $retfurl='';
467: if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&
468: (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {
469: %hash=();
470: %parmhash=();
471: $errtext='';
472: $pc=0;
473: my $furi=&Apache::lonnet::clutter($uri);
474: $hash{'src_0.0'}=$furi;
475: $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');
476: $hash{'ids_'.$furi}='0.0';
477: $hash{'is_map_0.0'}=1;
478: loadmap($uri);
479: if (defined($hash{'map_start_'.$uri})) {
480: &traceroute('0',$hash{'map_start_'.$uri},'&');
481: &accinit($uri,$short,$fn);
482: &pickrandom();
483: }
484: unless ((untie(%hash)) && (untie(%parmhash))) {
485: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
486: "Could not untie coursemap $fn for $uri.</font>");
487: }
488: {
489: my $cfh;
490: if ($cfh=Apache::File->new(">$fn.state")) {
491: print $cfh join("\n",@cond);
492: } else {
493: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
494: "Could not write statemap $fn for $uri.</font>");
495: }
496: }
497: } else {
498: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
499: "Could not tie coursemap $fn for $uri.</font>");
500: }
501: &Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext);
502: return ($retfurl,$errtext);
503: }
504:
505: # ------------------------------------------------------- Evaluate state string
506:
507: sub evalstate {
508:
509: my $fn=$ENV{'request.course.fn'}.'.state';
510: my $state='2';
511: if (-e $fn) {
512: my @conditions=();
513: {
514: my $fh=Apache::File->new($fn);
515: @conditions=<$fh>;
516: }
517: my $safeeval = new Safe;
518: my $safehole = new Safe::Hole;
519: $safeeval->permit("entereval");
520: $safeeval->permit(":base_math");
521: $safeeval->deny(":base_io");
522: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
523: foreach (@conditions) {
524: my $line=$_;
525: chomp($line);
526: my ($condition,$weight)=split(/\:/,$_);
527: if ($safeeval->reval($condition)) {
528: if ($weight eq 'force') {
529: $state.='3';
530: } else {
531: $state.='2';
532: }
533: } else {
534: if ($weight eq 'stop') {
535: $state.='0';
536: } else {
537: $state.='1';
538: }
539: }
540: }
541: }
542: &Apache::lonnet::appenv('user.state.'.$ENV{'request.course.id'} => $state);
543: return $state;
544: }
545:
546: 1;
547: __END__
548:
549: =head1 NAME
550:
551: Apache::lonuserstate - Construct and maintain state and binary representation
552: of course for user
553:
554: =head1 SYNOPSIS
555:
556: Invoked by lonroles.pm.
557:
558: &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
559:
560: =head1 INTRODUCTION
561:
562: This module constructs and maintains state and binary representation
563: of course for user.
564:
565: This is part of the LearningOnline Network with CAPA project
566: described at http://www.lon-capa.org.
567:
568: =head1 HANDLER SUBROUTINE
569:
570: There is no handler subroutine.
571:
572: =head1 OTHER SUBROUTINES
573:
574: =over 4
575:
576: =item *
577:
578: loadmap() : Loads map from disk
579:
580: =item *
581:
582: simplify() : Simplify expression
583:
584: =item *
585:
586: traceroute() : Build condition hash
587:
588: =item *
589:
590: accinit() : Cascading conditions, quick access, parameters
591:
592: =item *
593:
594: readmap() : Read map and all submaps
595:
596: =item *
597:
598: evalstate() : Evaluate state string
599:
600: =back
601:
602: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonuserstate.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / rat