Annotation of rat/lonuserstate.pm, revision 1.13
1.1 www 1: # The LearningOnline Network with CAPA
2: # Construct and maintain state and binary representation of course for user
3: #
4: # (Server for RAT Maps
5: #
6: # (Edit Handler for RAT Maps
7: # (TeX Content Handler
8: #
9: # 05/29/00,05/30 Gerd Kortemeyer)
10: # 7/1 Gerd Kortemeyer)
11: # 7/1,7/3,7/4,7/7,7/8,7/10 Gerd Kortemeyer)
12: #
1.9 www 13: # 7/15,7/17,7/18,8/1,8/2,8/4,8/5,8/21,8/22,8/23,8/30,
1.13 ! www 14: # 9/2,9/4,9/29,9/30,10/2,10/11,10/30 Gerd Kortemeyer
1.1 www 15:
16: package Apache::lonuserstate;
17:
18: use strict;
19: use Apache::Constants qw(:common :http);
20: use Apache::File;
21: use HTML::TokeParser;
22: use Apache::lonnet();
23: use GDBM_File;
1.12 www 24: use Apache::lonmsg;
1.1 www 25:
26: # ---------------------------------------------------- Globals for this package
27:
28: my $pc; # Package counter
29: my %hash; # The big tied hash
30: my @cond; # Array with all of the conditions
31: my $errtext; # variable with all errors
32:
33: # --------------------------------------------------------- Loads map from disk
34:
35: sub loadmap {
36: my $uri=shift;
37: if ($hash{'map_pc_'.$uri}) { return OK; }
38:
39: $pc++;
40: my $lpc=$pc;
41: $hash{'map_pc_'.$uri}=$lpc;
42: $hash{'map_id_'.$lpc}=$uri;
43:
44: my $fn='/home/httpd/html'.$uri;
45:
1.10 www 46: unless (($fn=~/\.sequence$/) ||
1.1 www 47: ($fn=~/\.page$/)) {
48: $errtext.="Invalid map: $fn\n";
49: return OK;
50: }
51:
52: unless (-e $fn) {
53: my $returned=Apache::lonnet::repcopy($fn);
54: unless ($returned eq OK) {
55: $errtext.="Could not import: $fn - ";
56: if ($returned eq HTTP_SERVICE_UNAVAILABLE) {
57: $errtext.="Server unavailable\n";
58: }
59: if ($returned eq HTTP_NOT_FOUND) {
60: $errtext.="File not found\n";
61: }
62: if ($returned eq FORBIDDEN) {
63: $errtext.="Access forbidden\n";
64: }
65: return OK;
66: }
67: }
68:
69: if (-e $fn) {
70: my @content;
71: {
72: my $fh=Apache::File->new($fn);
73: @content=<$fh>;
74: }
75: my $instr=join('',@content);
76: my $parser = HTML::TokeParser->new(\$instr);
77: my $token;
78:
79: my $linkpc=0;
80:
81: $fn=~/\.(\w+)$/;
82:
83: $hash{'map_type_'.$lpc}=$1;
84:
85: while ($token = $parser->get_token) {
86: if ($token->[0] eq 'S') {
87: if ($token->[1] eq 'resource') {
88: # -------------------------------------------------------------------- Resource
89:
90: my $rid=$lpc.'.'.$token->[2]->{'id'};
91:
92: $hash{'kind_'.$rid}='res';
93: $hash{'title_'.$rid}=$token->[2]->{'title'};
94: my $turi=$token->[2]->{'src'};
95: $hash{'src_'.$rid}=$turi;
96:
97: if (defined($hash{'ids_'.$turi})) {
98: $hash{'ids_'.$turi}.=','.$rid;
99: } else {
100: $hash{'ids_'.$turi}=''.$rid;
101: }
102:
103: if ($token->[2]->{'src'}=~/\/\//) {
104: $hash{'ext_'.$rid}='true:';
105: } else {
106: $hash{'ext_'.$rid}='false:';
107: }
108: if ($token->[2]->{'type'}) {
109: $hash{'type_'.$rid}=$token->[2]->{'type'};
1.2 www 110: if ($token->[2]->{'type'} eq 'start') {
111: $hash{'map_start_'.$uri}="$rid";
112: }
113: if ($token->[2]->{'type'} eq 'finish') {
114: $hash{'map_finish_'.$uri}="$rid";
115: }
1.1 www 116: } else {
117: $hash{'type_'.$rid}='normal';
118: }
119:
1.10 www 120: if (($turi=~/\.sequence$/) ||
1.1 www 121: ($turi=~/\.page$/)) {
1.2 www 122: $hash{'is_map_'.$rid}=1;
1.1 www 123: &loadmap($turi);
124: }
125:
126: } elsif ($token->[1] eq 'condition') {
127: # ------------------------------------------------------------------- Condition
128:
129: my $rid=$lpc.'.'.$token->[2]->{'id'};
130:
131: $hash{'kind_'.$rid}='cond';
1.2 www 132: $cond[$#cond+1]=$token->[2]->{'value'};
133: $hash{'condid_'.$rid}=$#cond;
1.1 www 134: if ($token->[2]->{'type'}) {
1.2 www 135: $cond[$#cond].=':'.$token->[2]->{'type'};
1.1 www 136: } else {
1.2 www 137: $cond[$#cond].=':normal';
1.1 www 138: }
139:
140: } elsif ($token->[1] eq 'link') {
141: # ----------------------------------------------------------------------- Links
142:
143: $linkpc++;
144: my $linkid=$lpc.'.'.$linkpc;
145:
146: my $goesto=$lpc.'.'.$token->[2]->{'to'};
147: my $comesfrom=$lpc.'.'.$token->[2]->{'from'};
148: my $undercond=0;
149:
150: if ($token->[2]->{'condition'}) {
151: $undercond=$lpc.'.'.$token->[2]->{'condition'};
152: }
153:
154: $hash{'goesto_'.$linkid}=$goesto;
155: $hash{'comesfrom_'.$linkid}=$comesfrom;
156: $hash{'undercond_'.$linkid}=$undercond;
157:
158: if (defined($hash{'to_'.$comesfrom})) {
159: $hash{'to_'.$comesfrom}.=','.$linkid;
160: } else {
161: $hash{'to_'.$comesfrom}=''.$linkid;
162: }
163: if (defined($hash{'from_'.$goesto})) {
164: $hash{'from_'.$goesto}.=','.$linkid;
165: } else {
166: $hash{'from_'.$goesto}=''.$linkid;
167: }
168: }
169:
170: }
171: }
172:
173: } else {
174: $errtext.='Map not loaded: The file does not exist. ';
175: }
176: }
177:
1.3 www 178: # --------------------------------------------------------- Simplify expression
179:
180: sub simplify {
181: my $expression=shift;
182: # (8)=8
183: $expression=~s/\((\d+)\)/$1/g;
184: # 8&8=8
1.7 www 185: $expression=~s/(\D)(\d+)\&\2(\D)/$1$2$3/g;
1.3 www 186: # 8|8=8
1.7 www 187: $expression=~s/(\D)(\d+)\|\2(\D)/$1$2$3/g;
1.3 www 188: # (5&3)&4=5&3&4
1.7 www 189: $expression=~s/\((\d+)((?:\&\d+)+)\)\&(\d+\D)/$1$2\&$3/g;
1.3 www 190: # (((5&3)|(4&6)))=((5&3)|(4&6))
191: $expression=~
192: s/\((\(\(\d+(?:\&\d+)*\)(?:\|\(\d+(?:\&\d+)*\))+\))\)/$1/g;
193: # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2)
194: $expression=~
195: s/\((\(\d+(?:\&\d+)*\))((?:\|\(\d+(?:\&\d+)*\))+)\)\|(\(\d+(?:\&\d+)*\))/\($1$2\|$3\)/g;
196: return $expression;
197: }
198:
1.2 www 199: # -------------------------------------------------------- Build condition hash
200:
201: sub traceroute {
1.3 www 202: my ($sofar,$rid,$beenhere)=@_;
203: $sofar=simplify($sofar);
1.2 www 204: unless ($beenhere=~/\&$rid\&/) {
205: $beenhere.=$rid.'&';
206: if (defined($hash{'conditions_'.$rid})) {
1.3 www 207: $hash{'conditions_'.$rid}=simplify(
208: '('.$hash{'conditions_'.$rid}.')|('.$sofar.')');
1.2 www 209: } else {
210: $hash{'conditions_'.$rid}=$sofar;
211: }
212: if (defined($hash{'is_map_'.$rid})) {
1.3 www 213: if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
214: &traceroute($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},'&');
215: if (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) {
216: $sofar=
217: $hash{'conditions_'.$hash{'map_finish_'.$hash{'src_'.$rid}}};
218: }
1.2 www 219: }
220: }
221: if (defined($hash{'to_'.$rid})) {
222: map {
223: my $further=$sofar;
224: if ($hash{'undercond_'.$_}) {
225: if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) {
1.3 www 226: $further=simplify('('.$further.')&('.
227: $hash{'condid_'.$hash{'undercond_'.$_}}.')');
1.2 www 228: } else {
229: $errtext.='Undefined condition ID: '
230: .$hash{'undercond_'.$_}.'. ';
231: }
232: }
233: &traceroute($further,$hash{'goesto_'.$_},$beenhere);
234: } split(/\,/,$hash{'to_'.$rid});
235: }
236: }
237: }
1.1 www 238:
1.4 www 239: # ------------------------------------------ Cascading conditions, quick access
240:
241: sub accinit {
242: my ($uri,$short,$fn)=@_;
243: my %acchash=();
244: my %captured=();
245: my $condcounter=0;
1.5 www 246: $acchash{'acc.cond.'.$short.'.0'}=0;
1.4 www 247: map {
248: if ($_=~/^conditions/) {
249: my $expr=$hash{$_};
250: map {
251: my $sub=$_;
252: my $orig=$_;
1.13 ! www 253: $sub=~/\(\((\d+\&(:?\d+\&)*)(?:\d+\&*)+\)(?:\|\(\1(?:\d+\&*)+\))+\)/;
1.4 www 254: my $factor=$1;
1.7 www 255: $sub=~s/$factor//g;
256: $sub=~s/^\(/\($factor\(/;
1.4 www 257: $sub.=')';
258: $sub=simplify($sub);
259: $orig=~s/(\W)/\\$1/g;
1.7 www 260: $expr=~s/$orig/$sub/;
1.4 www 261: } ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g);
262: $hash{$_}=$expr;
263: unless (defined($captured{$expr})) {
264: $condcounter++;
265: $captured{$expr}=$condcounter;
1.5 www 266: $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;
1.4 www 267: }
268: }
269: } keys %hash;
270: map {
271: if ($_=~/^ids/) {
1.13 ! www 272: map {
! 273: my $resid=$_;
1.4 www 274: my $uri=$hash{'src_'.$resid};
275: my @uriparts=split(/\//,$uri);
276: my $urifile=$uriparts[$#uriparts];
277: $#uriparts--;
278: my $uripath=join('/',@uriparts);
1.8 www 279: $uripath=~s/^\/res\///;
1.13 ! www 280: my $uricond='0';
1.4 www 281: if (defined($hash{'conditions_'.$resid})) {
1.13 ! www 282: $uricond=$captured{$hash{'conditions_'.$resid}};
1.4 www 283: }
1.5 www 284: if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) {
1.13 ! www 285: if ($acchash{'acc.res.'.$short.'.'.$uripath}=~
! 286: /(\&$urifile\:[^\&]*)/) {
! 287: my $replace=$1;
! 288: $acchash{'acc.res.'.$short.'.'.$uripath}
! 289: =~s/$replace/$replace\|$uricond/;
! 290: } else {
! 291: $acchash{'acc.res.'.$short.'.'.$uripath}.=
! 292: $urifile.':'.$uricond.'&';
! 293: }
1.4 www 294: } else {
1.13 ! www 295: $acchash{'acc.res.'.$short.'.'.$uripath}=
! 296: '&'.$urifile.':'.$uricond.'&';
! 297: }
! 298: } split(/\,/,$hash{$_});
! 299: }
1.4 www 300: } keys %hash;
1.8 www 301: my $courseuri=$uri;
302: $courseuri=~s/^\/res\///;
1.4 www 303: &Apache::lonnet::appenv(%acchash,
1.9 www 304: "request.course.id" => $short,
1.8 www 305: "request.course.fn" => $fn,
306: "request.course.uri" => $courseuri);
1.4 www 307: }
308:
1.1 www 309: # ---------------------------------------------------- Read map and all submaps
310:
311: sub readmap {
1.9 www 312: my $short=shift;
313: $short=~s/^\///;
314: my %cenv=&Apache::lonnet::coursedescription($short);
315: my $fn=$cenv{'fn'};
316: my $uri;
317: $short=~s/\//\_/g;
318: unless ($uri=$cenv{'url'}) {
319: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
320: "Could not load course $short.</font>");
321: return 'No course data available.';
322: }
1.3 www 323: @cond=('true:normal');
1.11 www 324: unlink($fn.'.db');
325: unlink($fn.'_symb.db');
326: unlink($fn.'.state');
1.4 www 327: if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT,0640)) {
328: %hash=();
329: $errtext='';
330: $pc=0;
331: loadmap($uri);
332: if (defined($hash{'map_start_'.$uri})) {
333: &traceroute('0',$hash{'map_start_'.$uri},'&');
334: &accinit($uri,$short,$fn);
1.2 www 335: }
1.4 www 336: unless (untie(%hash)) {
337: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
338: "Could not untie coursemap $fn for $uri.</font>");
1.1 www 339: }
1.4 www 340: {
341: my $cfh;
342: if ($cfh=Apache::File->new(">$fn.state")) {
343: print $cfh join("\n",@cond);
344: } else {
1.6 www 345: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
1.4 www 346: "Could not write statemap $fn for $uri.</font>");
347: }
348: }
349: } else {
1.6 www 350: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
1.4 www 351: "Could not tie coursemap $fn for $uri.</font>");
352: }
1.12 www 353: &Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext);
1.4 www 354: return $errtext;
1.1 www 355: }
356:
357: 1;
358: __END__
359:
360:
361:
362:
363:
364:
365:
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