Annotation of rat/lonuserstate.pm, revision 1.5
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.5 ! www 13: # 7/15,7/17,7/18,8/1,8/2,8/4,8/5,8/21,8/22,8/23 Gerd Kortemeyer
1.1 www 14:
15: package Apache::lonuserstate;
16:
17: use strict;
18: use Apache::Constants qw(:common :http);
19: use Apache::File;
20: use HTML::TokeParser;
21: use Apache::lonnet();
22: use GDBM_File;
23:
24: # ---------------------------------------------------- Globals for this package
25:
26: my $pc; # Package counter
27: my %hash; # The big tied hash
28: my @cond; # Array with all of the conditions
29: my $errtext; # variable with all errors
30:
31: # --------------------------------------------------------- Loads map from disk
32:
33: sub loadmap {
34: my $uri=shift;
35: if ($hash{'map_pc_'.$uri}) { return OK; }
36:
37: $pc++;
38: my $lpc=$pc;
39: $hash{'map_pc_'.$uri}=$lpc;
40: $hash{'map_id_'.$lpc}=$uri;
41:
42: my $fn='/home/httpd/html'.$uri;
43:
44: unless (($fn=~/\.course$/) ||
45: ($fn=~/\.sequence$/) ||
46: ($fn=~/\.page$/)) {
47: $errtext.="Invalid map: $fn\n";
48: return OK;
49: }
50:
51: unless (-e $fn) {
52: my $returned=Apache::lonnet::repcopy($fn);
53: unless ($returned eq OK) {
54: $errtext.="Could not import: $fn - ";
55: if ($returned eq HTTP_SERVICE_UNAVAILABLE) {
56: $errtext.="Server unavailable\n";
57: }
58: if ($returned eq HTTP_NOT_FOUND) {
59: $errtext.="File not found\n";
60: }
61: if ($returned eq FORBIDDEN) {
62: $errtext.="Access forbidden\n";
63: }
64: return OK;
65: }
66: }
67:
68: if (-e $fn) {
69: my @content;
70: {
71: my $fh=Apache::File->new($fn);
72: @content=<$fh>;
73: }
74: my $instr=join('',@content);
75: my $parser = HTML::TokeParser->new(\$instr);
76: my $token;
77:
78: my $linkpc=0;
79:
80: $fn=~/\.(\w+)$/;
81:
82: $hash{'map_type_'.$lpc}=$1;
83:
84: while ($token = $parser->get_token) {
85: if ($token->[0] eq 'S') {
86: if ($token->[1] eq 'resource') {
87: # -------------------------------------------------------------------- Resource
88:
89: my $rid=$lpc.'.'.$token->[2]->{'id'};
90:
91: $hash{'kind_'.$rid}='res';
92: $hash{'title_'.$rid}=$token->[2]->{'title'};
93: my $turi=$token->[2]->{'src'};
94: $hash{'src_'.$rid}=$turi;
95:
96: if (defined($hash{'ids_'.$turi})) {
97: $hash{'ids_'.$turi}.=','.$rid;
98: } else {
99: $hash{'ids_'.$turi}=''.$rid;
100: }
101:
102: if ($token->[2]->{'src'}=~/\/\//) {
103: $hash{'ext_'.$rid}='true:';
104: } else {
105: $hash{'ext_'.$rid}='false:';
106: }
107: if ($token->[2]->{'type'}) {
108: $hash{'type_'.$rid}=$token->[2]->{'type'};
1.2 www 109: if ($token->[2]->{'type'} eq 'start') {
110: $hash{'map_start_'.$uri}="$rid";
111: }
112: if ($token->[2]->{'type'} eq 'finish') {
113: $hash{'map_finish_'.$uri}="$rid";
114: }
1.1 www 115: } else {
116: $hash{'type_'.$rid}='normal';
117: }
118:
119: if (($turi=~/\.course$/) ||
120: ($turi=~/\.sequence$/) ||
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: # "True and" is nothing
183: $expression=~s/0\&//g;
184: # (8)=8
185: $expression=~s/\((\d+)\)/$1/g;
186: # 8&8=8
187: $expression=~s/(\d+)\&\1/$1/g;
188: # 8|8=8
189: $expression=~s/(\d+)\|\1/$1/g;
190: # (5&3)&4=5&3&4
191: $expression=~s/\((\d+)\&(\d+)\)\&(\d+)/$1\&$2\&$3/g;
192: # (((5&3)|(4&6)))=((5&3)|(4&6))
193: $expression=~
194: s/\((\(\(\d+(?:\&\d+)*\)(?:\|\(\d+(?:\&\d+)*\))+\))\)/$1/g;
195: # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2)
196: $expression=~
197: s/\((\(\d+(?:\&\d+)*\))((?:\|\(\d+(?:\&\d+)*\))+)\)\|(\(\d+(?:\&\d+)*\))/\($1$2\|$3\)/g;
198: return $expression;
199: }
200:
1.2 www 201: # -------------------------------------------------------- Build condition hash
202:
203: sub traceroute {
1.3 www 204: my ($sofar,$rid,$beenhere)=@_;
205: $sofar=simplify($sofar);
1.2 www 206: unless ($beenhere=~/\&$rid\&/) {
207: $beenhere.=$rid.'&';
208: if (defined($hash{'conditions_'.$rid})) {
1.3 www 209: $hash{'conditions_'.$rid}=simplify(
210: '('.$hash{'conditions_'.$rid}.')|('.$sofar.')');
1.2 www 211: } else {
212: $hash{'conditions_'.$rid}=$sofar;
213: }
214: if (defined($hash{'is_map_'.$rid})) {
1.3 www 215: if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
216: &traceroute($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},'&');
217: if (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) {
218: $sofar=
219: $hash{'conditions_'.$hash{'map_finish_'.$hash{'src_'.$rid}}};
220: }
1.2 www 221: }
222: }
223: if (defined($hash{'to_'.$rid})) {
224: map {
225: my $further=$sofar;
226: if ($hash{'undercond_'.$_}) {
227: if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) {
1.3 www 228: $further=simplify('('.$further.')&('.
229: $hash{'condid_'.$hash{'undercond_'.$_}}.')');
1.2 www 230: } else {
231: $errtext.='Undefined condition ID: '
232: .$hash{'undercond_'.$_}.'. ';
233: }
234: }
235: &traceroute($further,$hash{'goesto_'.$_},$beenhere);
236: } split(/\,/,$hash{'to_'.$rid});
237: }
238: }
239: }
1.1 www 240:
1.4 www 241: # ------------------------------------------ Cascading conditions, quick access
242:
243: sub accinit {
244: my ($uri,$short,$fn)=@_;
245: my %acchash=();
246: my %captured=();
247: my $condcounter=0;
1.5 ! www 248: $acchash{'acc.cond.'.$short.'.0'}=0;
1.4 www 249: map {
250: if ($_=~/^conditions/) {
251: my $expr=$hash{$_};
252: map {
253: my $sub=$_;
254: my $orig=$_;
255: $sub=~/\(\((\d+(:?\&\d+)*)(?:\&\d+)+\)(?:\|\(\1(?:\&\d+)+\))+\)/;
256: my $factor=$1;
257: $sub=~s/$factor\&//g;
258: $sub=~s/^\(/\($factor\&\(/;
259: $sub.=')';
260: $sub=simplify($sub);
261: $orig=~s/(\W)/\\$1/g;
262: $expr=~s/$orig/$sub/;
263: } ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g);
264: $hash{$_}=$expr;
265: unless (defined($captured{$expr})) {
266: $condcounter++;
267: $captured{$expr}=$condcounter;
1.5 ! www 268: $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;
1.4 www 269: }
270: }
271: } keys %hash;
272: map {
273: if ($_=~/^ids/) {
274: my $resid=$hash{$_};
275: my $uri=$hash{'src_'.$resid};
276: my @uriparts=split(/\//,$uri);
277: my $urifile=$uriparts[$#uriparts];
278: $#uriparts--;
279: my $uripath=join('/',@uriparts);
280: if (defined($hash{'conditions_'.$resid})) {
281: $urifile.=':'.$captured{$hash{'conditions_'.$resid}};
282: } else {
283: $urifile.=':0';
284: }
1.5 ! www 285: if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) {
! 286: $acchash{'acc.res.'.$short.'.'.$uripath}.=$urifile.'&';
1.4 www 287: } else {
1.5 ! www 288: $acchash{'acc.res.'.$short.'.'.$uripath}='&'.$urifile.'&';
1.4 www 289: }
290: }
291: } keys %hash;
292: &Apache::lonnet::appenv(%acchash,
293: "request.course" => $short,
294: "request.course.fn" => $fn);
295: }
296:
1.1 www 297: # ---------------------------------------------------- Read map and all submaps
298:
1.4 www 299: #
300: # Call with uri of course map, short name for course, and filename for
301: # binary structure
302: #
303:
1.1 www 304: sub readmap {
1.4 www 305: my ($uri,$short,$fn)=@_;
1.3 www 306: @cond=('true:normal');
1.4 www 307: if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT,0640)) {
308: %hash=();
309: $errtext='';
310: $pc=0;
311: loadmap($uri);
312: if (defined($hash{'map_start_'.$uri})) {
313: &traceroute('0',$hash{'map_start_'.$uri},'&');
314: &accinit($uri,$short,$fn);
1.2 www 315: }
1.4 www 316: unless (untie(%hash)) {
317: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
318: "Could not untie coursemap $fn for $uri.</font>");
1.1 www 319: }
1.4 www 320: {
321: my $cfh;
322: if ($cfh=Apache::File->new(">$fn.state")) {
323: print $cfh join("\n",@cond);
324: } else {
325: &Apache::lonnet::logthis("<font color=blie>WARNING: ".
326: "Could not write statemap $fn for $uri.</font>");
327: }
328: }
329: } else {
330: &Apache::lonnet::logthis("<font color=blie>WARNING: ".
331: "Could not tie coursemap $fn for $uri.</font>");
332: }
333: return $errtext;
1.1 www 334: }
335:
336: 1;
337: __END__
338:
339:
340:
341:
342:
343:
344:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>