Annotation of rat/lonuserstate.pm, revision 1.124
1.1 www 1: # The LearningOnline Network with CAPA
2: # Construct and maintain state and binary representation of course for user
3: #
1.124 ! albertel 4: # $Id: lonuserstate.pm,v 1.123 2007/08/28 16:45:20 albertel Exp $
1.25 www 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.26 harris41 28: ###
1.1 www 29:
30: package Apache::lonuserstate;
31:
1.26 harris41 32: # ------------------------------------------------- modules used by this module
1.1 www 33: use strict;
34: use HTML::TokeParser;
1.89 albertel 35: use Apache::lonnet;
1.114 www 36: use Apache::lonlocal;
1.26 harris41 37: use Apache::loncommon();
1.1 www 38: use GDBM_File;
1.12 www 39: use Apache::lonmsg;
1.15 www 40: use Safe;
1.21 www 41: use Safe::Hole;
1.15 www 42: use Opcode;
1.73 www 43: use Apache::lonenc;
1.96 albertel 44: use Fcntl qw(:flock);
1.114 www 45: use LONCAPA;
46:
1.15 www 47:
1.1 www 48: # ---------------------------------------------------- Globals for this package
49:
50: my $pc; # Package counter
51: my %hash; # The big tied hash
1.19 www 52: my %parmhash;# The hash with the parameters
1.1 www 53: my @cond; # Array with all of the conditions
54: my $errtext; # variable with all errors
1.116 www 55: my $retfrid; # variable with the very first RID in the course
56: my $retfurl; # first URL
1.29 www 57: my %randompick; # randomly picked resources
1.51 www 58: my %randompickseed; # optional seed for randomly picking resources
1.124 ! albertel 59: my %randomorder; # maps to order contents randomly
1.73 www 60: my %encurl; # URLs in this folder are supposed to be encrypted
61: my %hiddenurl; # this URL (or complete folder) is supposed to be hidden
1.61 www 62:
63: # ----------------------------------- Remove version from URL and store in hash
64:
65: sub versiontrack {
66: my $uri=shift;
67: if ($uri=~/\.(\d+)\.\w+$/) {
68: my $version=$1;
69: $uri=~s/\.\d+\.(\w+)$/\.$1/;
1.62 www 70: unless ($hash{'version_'.$uri}) {
71: $hash{'version_'.$uri}=$version;
72: }
1.61 www 73: }
74: return $uri;
75: }
76:
77: # -------------------------------------------------------------- Put in version
78:
79: sub putinversion {
80: my $uri=shift;
1.93 www 81: my $key=$env{'request.course.id'}.'_'.&Apache::lonnet::clutter($uri);
1.61 www 82: if ($hash{'version_'.$uri}) {
83: my $version=$hash{'version_'.$uri};
1.65 www 84: if ($version eq 'mostrecent') { return $uri; }
1.66 www 85: if ($version eq &Apache::lonnet::getversion(
86: &Apache::lonnet::filelocation('',$uri)))
87: { return $uri; }
1.61 www 88: $uri=~s/\.(\w+)$/\.$version\.$1/;
89: }
1.93 www 90: &Apache::lonnet::do_cache_new('courseresversion',$key,&Apache::lonnet::declutter($uri),600);
1.61 www 91: return $uri;
92: }
93:
94: # ----------------------------------------- Processing versions file for course
95:
96: sub processversionfile {
1.64 www 97: my %cenv=@_;
1.61 www 98: my %versions=&Apache::lonnet::dump('resourceversions',
99: $cenv{'domain'},
100: $cenv{'num'});
1.106 albertel 101: foreach my $ver (keys(%versions)) {
102: if ($ver=~/^error\:/) { return; }
103: $hash{'version_'.$ver}=$versions{$ver};
1.61 www 104: }
105: }
1.45 www 106:
1.1 www 107: # --------------------------------------------------------- Loads map from disk
108:
109: sub loadmap {
1.124 ! albertel 110: my ($uri,$parent_rid)=@_;
1.114 www 111: if ($hash{'map_pc_'.$uri}) {
1.120 albertel 112: $errtext.='<p class="LC_error">'.
113: &mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>').
114: '</p>';
1.114 www 115: return;
116: }
1.1 www 117: $pc++;
118: my $lpc=$pc;
119: $hash{'map_pc_'.$uri}=$lpc;
120: $hash{'map_id_'.$lpc}=$uri;
121:
1.37 www 122: # Determine and check filename
1.62 www 123: my $fn=&Apache::lonnet::filelocation('',&putinversion($uri));
1.37 www 124:
125: my $ispage=($fn=~/\.page$/);
1.1 www 126:
1.10 www 127: unless (($fn=~/\.sequence$/) ||
1.1 www 128: ($fn=~/\.page$/)) {
1.114 www 129: $errtext.=&mt("<br />Invalid map: <tt>[_1]</tt>",$fn);
1.98 albertel 130: return;
1.1 www 131: }
132:
1.37 www 133: my $instr=&Apache::lonnet::getfile($fn);
134:
1.124 ! albertel 135: if ($instr eq -1) {
! 136: $errtext.=&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn);
! 137: return;
! 138: }
1.22 www 139:
1.37 www 140: # Successfully got file, parse it
1.1 www 141:
1.124 ! albertel 142: my $parser = HTML::TokeParser->new(\$instr);
! 143: $parser->attr_encoded(1);
! 144: # first get all parameters
! 145: while (my $token = $parser->get_token) {
! 146: next if ($token->[0] ne 'S');
! 147: if ($token->[1] eq 'param') {
! 148: &parse_param($token,$lpc);
! 149: }
! 150: }
! 151: #reset parser
! 152: $parser = HTML::TokeParser->new(\$instr);
! 153: $parser->attr_encoded(1);
1.1 www 154:
1.124 ! albertel 155: my $linkpc=0;
1.1 www 156:
1.124 ! albertel 157: $fn=~/\.(\w+)$/;
1.1 www 158:
1.124 ! albertel 159: $hash{'map_type_'.$lpc}=$1;
1.1 www 160:
1.124 ! albertel 161: my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i);
1.1 www 162:
1.124 ! albertel 163: my @map_ids;
! 164: while (my $token = $parser->get_token) {
! 165: next if ($token->[0] ne 'S');
! 166: if ($token->[1] eq 'resource') {
! 167: push(@map_ids,&parse_resource($token,$lpc,$ispage,$uri));
! 168: } elsif ($token->[1] eq 'link' && !$randomize) {
1.1 www 169: # ----------------------------------------------------------------------- Links
1.124 ! albertel 170: &make_link(++$linkpc,$lpc,$token->[2]->{'to'},
! 171: $token->[2]->{'from'},
! 172: $token->[2]->{'condition'});
! 173: } elsif ($token->[1] eq 'condition' && !$randomize) {
! 174: &parse_condition($token,$lpc);
! 175: }
! 176: }
1.1 www 177:
1.124 ! albertel 178: if ($randomize) {
! 179: if (!$env{'request.role.adv'}) {
! 180: my $seed;
! 181: if (defined($randompickseed{$parent_rid})) {
! 182: $seed = $randompickseed{$parent_rid};
! 183: } else {
! 184: my ($mapid,$resid)=split(/\./,$parent_rid);
! 185: my $symb=
! 186: &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
! 187: $resid,$hash{'src_'.$parent_rid});
1.85 albertel 188:
1.124 ! albertel 189: $seed = $symb;
! 190: }
! 191:
! 192: my $rndseed=&Apache::lonnet::rndseed($seed);
! 193: &Apache::lonnet::setup_random_from_rndseed($rndseed);
! 194: @map_ids=&Math::Random::random_permutation(@map_ids);
! 195: }
! 196: my $from = shift(@map_ids);
! 197: my $from_rid = $lpc.'.'.$from;
! 198: $hash{'map_start_'.$uri} = $from_rid;
! 199: $hash{'type_'.$from_rid}='start';
! 200:
! 201: while (my $to = shift(@map_ids)) {
! 202: &make_link(++$linkpc,$lpc,$to,$from);
! 203: my $to_rid = $lpc.'.'.$to;
! 204: $hash{'type_'.$to_rid}='normal';
! 205: $from = $to;
! 206: $from_rid = $to_rid;
! 207: }
1.1 www 208:
1.124 ! albertel 209: $hash{'map_finish_'.$uri}= $from_rid;
! 210: $hash{'type_'.$from_rid}='finish';
1.1 www 211: }
1.121 albertel 212:
213: my $parser = HTML::TokeParser->new(\$instr);
214: $parser->attr_encoded(1);
215: # last parse out the mapalias params so as to ignore anything
216: # refering to non-existant resources
217: while (my $token = $parser->get_token) {
218: next if ($token->[0] ne 'S');
219: if ($token->[1] eq 'param') {
220: &parse_mapalias_param($token,$lpc);
221: }
222: }
223: }
224:
1.124 ! albertel 225:
! 226: # -------------------------------------------------------------------- Resource
! 227: sub parse_resource {
! 228: my ($token,$lpc,$ispage,$uri) = @_;
! 229: if ($token->[2]->{'type'} eq 'zombie') { next; }
! 230: my $rid=$lpc.'.'.$token->[2]->{'id'};
! 231:
! 232: $hash{'kind_'.$rid}='res';
! 233: $hash{'title_'.$rid}=$token->[2]->{'title'};
! 234: my $turi=&versiontrack($token->[2]->{'src'});
! 235: if ($token->[2]->{'version'}) {
! 236: unless ($hash{'version_'.$turi}) {
! 237: $hash{'version_'.$turi}=$1;
! 238: }
! 239: }
! 240: my $title=$token->[2]->{'title'};
! 241: $title=~s/\&colon\;/\:/gs;
! 242: # my $symb=&Apache::lonnet::encode_symb($uri,
! 243: # $token->[2]->{'id'},
! 244: # $turi);
! 245: # &Apache::lonnet::do_cache_new('title',$symb,$title);
! 246: unless ($ispage) {
! 247: $turi=~/\.(\w+)$/;
! 248: my $embstyle=&Apache::loncommon::fileembstyle($1);
! 249: if ($token->[2]->{'external'} eq 'true') { # external
! 250: $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;
! 251: } elsif ($turi=~/^\/*uploaded\//) { # uploaded
! 252: if (($embstyle eq 'img')
! 253: || ($embstyle eq 'emb')
! 254: || ($embstyle eq 'wrp')) {
! 255: $turi='/adm/wrapper'.$turi;
! 256: } elsif ($embstyle eq 'ssi') {
! 257: #do nothing with these
! 258: } elsif ($turi!~/\.(sequence|page)$/) {
! 259: $turi='/adm/coursedocs/showdoc'.$turi;
! 260: }
! 261: } elsif ($turi=~/\S/) { # normal non-empty internal resource
! 262: my $mapdir=$uri;
! 263: $mapdir=~s/[^\/]+$//;
! 264: $turi=&Apache::lonnet::hreflocation($mapdir,$turi);
! 265: if (($embstyle eq 'img')
! 266: || ($embstyle eq 'emb')
! 267: || ($embstyle eq 'wrp')) {
! 268: $turi='/adm/wrapper'.$turi;
! 269: }
! 270: }
! 271: }
! 272: # Store reverse lookup, remove query string
! 273: my $idsuri=$turi;
! 274: $idsuri=~s/\?.+$//;
! 275: if (defined($hash{'ids_'.$idsuri})) {
! 276: $hash{'ids_'.$idsuri}.=','.$rid;
! 277: } else {
! 278: $hash{'ids_'.$idsuri}=''.$rid;
! 279: }
! 280:
! 281: if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) {
! 282: $turi.='?register=1';
! 283: }
! 284:
! 285: $hash{'src_'.$rid}=$turi;
! 286:
! 287: if ($token->[2]->{'external'} eq 'true') {
! 288: $hash{'ext_'.$rid}='true:';
! 289: } else {
! 290: $hash{'ext_'.$rid}='false:';
! 291: }
! 292: if ($token->[2]->{'type'}) {
! 293: $hash{'type_'.$rid}=$token->[2]->{'type'};
! 294: if ($token->[2]->{'type'} eq 'start') {
! 295: $hash{'map_start_'.$uri}="$rid";
! 296: }
! 297: if ($token->[2]->{'type'} eq 'finish') {
! 298: $hash{'map_finish_'.$uri}="$rid";
! 299: }
! 300: } else {
! 301: $hash{'type_'.$rid}='normal';
! 302: }
! 303:
! 304: if (($turi=~/\.sequence$/) ||
! 305: ($turi=~/\.page$/)) {
! 306: $hash{'is_map_'.$rid}=1;
! 307: &loadmap($turi,$rid);
! 308: }
! 309: return $token->[2]->{'id'};
! 310: }
! 311:
! 312: sub make_link {
! 313: my ($linkpc,$lpc,$to,$from,$condition) = @_;
! 314:
! 315: my $linkid=$lpc.'.'.$linkpc;
! 316: my $goesto=$lpc.'.'.$to;
! 317: my $comesfrom=$lpc.'.'.$from;
! 318: my $undercond=0;
! 319:
! 320: if ($condition) {
! 321: $undercond=$lpc.'.'.$condition;
! 322: }
! 323:
! 324: $hash{'goesto_'.$linkid}=$goesto;
! 325: $hash{'comesfrom_'.$linkid}=$comesfrom;
! 326: $hash{'undercond_'.$linkid}=$undercond;
! 327:
! 328: if (defined($hash{'to_'.$comesfrom})) {
! 329: $hash{'to_'.$comesfrom}.=','.$linkid;
! 330: } else {
! 331: $hash{'to_'.$comesfrom}=''.$linkid;
! 332: }
! 333: if (defined($hash{'from_'.$goesto})) {
! 334: $hash{'from_'.$goesto}.=','.$linkid;
! 335: } else {
! 336: $hash{'from_'.$goesto}=''.$linkid;
! 337: }
! 338: }
! 339:
! 340: # ------------------------------------------------------------------- Condition
! 341: sub parse_condition {
! 342: my ($token,$lpc) = @_;
! 343: my $rid=$lpc.'.'.$token->[2]->{'id'};
! 344:
! 345: $hash{'kind_'.$rid}='cond';
! 346:
! 347: my $condition = $token->[2]->{'value'};
! 348: $condition =~ s/[\n\r]+/ /gs;
! 349: push(@cond, $condition);
! 350: $hash{'condid_'.$rid}=$#cond;
! 351: if ($token->[2]->{'type'}) {
! 352: $cond[$#cond].=':'.$token->[2]->{'type'};
! 353: } else {
! 354: $cond[$#cond].=':normal';
! 355: }
! 356: }
! 357:
! 358: # ------------------------------------------------------------------- Parameter
! 359:
! 360: sub parse_param {
! 361: my ($token,$lpc) = @_;
! 362: my $referid=$lpc.'.'.$token->[2]->{'to'};
! 363: my $name=$token->[2]->{'name'};
! 364: my $part;
! 365: if ($name=~/^parameter_(.*)_/) {
! 366: $part=$1;
! 367: } else {
! 368: $part=0;
! 369: }
! 370: $name=~s/^.*_([^_]*)$/$1/;
! 371: my $newparam=
! 372: &escape($token->[2]->{'type'}).':'.
! 373: &escape($part.'.'.$name).'='.
! 374: &escape($token->[2]->{'value'});
! 375: if (defined($hash{'param_'.$referid})) {
! 376: $hash{'param_'.$referid}.='&'.$newparam;
! 377: } else {
! 378: $hash{'param_'.$referid}=''.$newparam;
! 379: }
! 380: if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) {
! 381: $randompick{$referid}=$token->[2]->{'value'};
! 382: }
! 383: if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) {
! 384: $randompickseed{$referid}=$token->[2]->{'value'};
! 385: }
! 386: if ($token->[2]->{'name'}=~/^parameter_(0_)*randomorder$/) {
! 387: $randomorder{$referid}=$token->[2]->{'value'};
! 388: }
! 389: if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) {
! 390: if ($token->[2]->{'value'}=~/^yes$/i) {
! 391: $encurl{$referid}=1;
! 392: }
! 393: }
! 394: if ($token->[2]->{'name'}=~/^parameter_(0_)*hiddenresource$/) {
! 395: if ($token->[2]->{'value'}=~/^yes$/i) {
! 396: $hiddenurl{$referid}=1;
! 397: }
! 398: }
! 399: }
! 400:
1.121 albertel 401: sub parse_mapalias_param {
402: my ($token,$lpc) = @_;
403: my $referid=$lpc.'.'.$token->[2]->{'to'};
404: return if (!exists($hash{'src_'.$referid}));
405:
406: if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) {
1.122 albertel 407: &count_mapalias($token->[2]->{'value'},$referid);
1.121 albertel 408: $hash{'mapalias_'.$token->[2]->{'value'}}=$referid;
409: }
1.1 www 410: }
411:
1.3 www 412: # --------------------------------------------------------- Simplify expression
413:
414: sub simplify {
1.85 albertel 415: my $expression=shift;
1.101 albertel 416: # (0&1) = 1
1.105 albertel 417: $expression=~s/\(0\&([_\.\d]+)\)/$1/g;
1.3 www 418: # (8)=8
1.105 albertel 419: $expression=~s/\(([_\.\d]+)\)/$1/g;
1.3 www 420: # 8&8=8
1.105 albertel 421: $expression=~s/([^_\.\d])([_\.\d]+)\&\2([^_\.\d])/$1$2$3/g;
1.3 www 422: # 8|8=8
1.105 albertel 423: $expression=~s/([^_\.\d])([_\.\d]+)\|\2([^_\.\d])/$1$2$3/g;
1.3 www 424: # (5&3)&4=5&3&4
1.105 albertel 425: $expression=~s/\(([_\.\d]+)((?:\&[_\.\d]+)+)\)\&([_\.\d]+[^_\.\d])/$1$2\&$3/g;
1.3 www 426: # (((5&3)|(4&6)))=((5&3)|(4&6))
1.105 albertel 427: $expression=~
428: s/\((\(\([_\.\d]+(?:\&[_\.\d]+)*\)(?:\|\([_\.\d]+(?:\&[_\.\d]+)*\))+\))\)/$1/g;
1.3 www 429: # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2)
1.85 albertel 430: $expression=~
1.105 albertel 431: s/\((\([_\.\d]+(?:\&[_\.\d]+)*\))((?:\|\([_\.\d]+(?:\&[_\.\d]+)*\))+)\)\|(\([_\.\d]+(?:\&[_\.\d]+)*\))/\($1$2\|$3\)/g;
1.85 albertel 432: return $expression;
1.3 www 433: }
434:
1.2 www 435: # -------------------------------------------------------- Build condition hash
436:
437: sub traceroute {
1.77 www 438: my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;
1.81 albertel 439: my $newsofar=$sofar=simplify($sofar);
1.120 albertel 440: unless ($beenhere=~/\&\Q$rid\E\&/) {
1.85 albertel 441: $beenhere.=$rid.'&';
442: my ($mapid,$resid)=split(/\./,$rid);
443: my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid});
444: my $hidden=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb);
1.91 albertel 445:
1.90 albertel 446: if ($hdnflag || lc($hidden) eq 'yes') {
447: $hiddenurl{$rid}=1;
1.91 albertel 448: }
449: if (!$hdnflag && lc($hidden) eq 'no') {
1.90 albertel 450: delete($hiddenurl{$rid});
451: }
1.91 albertel 452:
1.85 albertel 453: my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb);
454: if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; }
1.116 www 455: if (($retfrid eq '') && ($hash{'src_'.$rid})
1.85 albertel 456: && ($hash{'src_'.$rid}!~/\.sequence$/)) {
1.116 www 457: $retfrid=$rid;
1.85 albertel 458: }
459: if (defined($hash{'conditions_'.$rid})) {
460: $hash{'conditions_'.$rid}=simplify(
1.103 albertel 461: '('.$hash{'conditions_'.$rid}.')|('.$sofar.')');
1.85 albertel 462: } else {
463: $hash{'conditions_'.$rid}=$sofar;
464: }
1.107 albertel 465:
466: # if the expression is just the 0th condition keep it
467: # otherwise leave a pointer to this condition expression
468: $newsofar = ($sofar eq '0') ? $sofar : '_'.$rid;
469:
1.85 albertel 470: if (defined($hash{'is_map_'.$rid})) {
471: if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
472: $sofar=$newsofar=
473: &traceroute($sofar,
474: $hash{'map_start_'.$hash{'src_'.$rid}},'&',
475: $encflag || $encurl{$rid},
476: $hdnflag || $hiddenurl{$rid});
477: }
478: }
479: if (defined($hash{'to_'.$rid})) {
1.106 albertel 480: foreach my $id (split(/\,/,$hash{'to_'.$rid})) {
1.2 www 481: my $further=$sofar;
1.106 albertel 482: if ($hash{'undercond_'.$id}) {
483: if (defined($hash{'condid_'.$hash{'undercond_'.$id}})) {
1.105 albertel 484: $further=simplify('('.'_'.$rid.')&('.
1.106 albertel 485: $hash{'condid_'.$hash{'undercond_'.$id}}.')');
1.85 albertel 486: } else {
1.114 www 487: $errtext.=&mt('<br />Undefined condition ID: [_1]',$hash{'undercond_'.$id});
1.85 albertel 488: }
1.2 www 489: }
1.106 albertel 490: $newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere,
1.81 albertel 491: $encflag,$hdnflag);
1.85 albertel 492: }
493: }
1.2 www 494: }
1.81 albertel 495: return $newsofar;
1.2 www 496: }
1.1 www 497:
1.19 www 498: # ------------------------------ Cascading conditions, quick access, parameters
1.4 www 499:
500: sub accinit {
501: my ($uri,$short,$fn)=@_;
502: my %acchash=();
503: my %captured=();
504: my $condcounter=0;
1.5 www 505: $acchash{'acc.cond.'.$short.'.0'}=0;
1.104 albertel 506: foreach my $key (keys(%hash)) {
507: if ($key=~/^conditions/) {
508: my $expr=$hash{$key};
1.109 albertel 509: # try to find and factor out common sub-expressions
1.105 albertel 510: foreach my $sub ($expr=~m/(\(\([_\.\d]+(?:\&[_\.\d]+)+\)(?:\|\([_\.\d]+(?:\&[_\.\d]+)+\))+\))/g) {
1.104 albertel 511: my $orig=$sub;
1.109 albertel 512:
513: my ($factor) = ($sub=~/\(\(([_\.\d]+\&(:?[_\.\d]+\&)*)(?:[_\.\d]+\&*)+\)(?:\|\(\1(?:[_\.\d]+\&*)+\))+\)/);
514: next if (!defined($factor));
515:
516: $sub=~s/\Q$factor\E//g;
1.85 albertel 517: $sub=~s/^\(/\($factor\(/;
518: $sub.=')';
519: $sub=simplify($sub);
1.109 albertel 520: $expr=~s/\Q$orig\E/$sub/;
1.85 albertel 521: }
1.104 albertel 522: $hash{$key}=$expr;
1.85 albertel 523: unless (defined($captured{$expr})) {
524: $condcounter++;
525: $captured{$expr}=$condcounter;
526: $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;
527: }
1.104 albertel 528: } elsif ($key=~/^param_(\d+)\.(\d+)/) {
1.86 albertel 529: my $prefix=&Apache::lonnet::encode_symb($hash{'map_id_'.$1},$2,
530: $hash{'src_'.$1.'.'.$2});
1.104 albertel 531: foreach my $param (split(/\&/,$hash{$key})) {
532: my ($typename,$value)=split(/\=/,$param);
1.85 albertel 533: my ($type,$name)=split(/\:/,$typename);
1.114 www 534: $parmhash{$prefix.'.'.&unescape($name)}=
535: &unescape($value);
536: $parmhash{$prefix.'.'.&unescape($name).'.type'}=
537: &unescape($type);
1.85 albertel 538: }
539: }
1.26 harris41 540: }
1.104 albertel 541: foreach my $key (keys(%hash)) {
542: if ($key=~/^ids/) {
543: foreach my $resid (split(/\,/,$hash{$key})) {
1.85 albertel 544: my $uri=$hash{'src_'.$resid};
1.100 albertel 545: my ($uripath,$urifile) =
546: &Apache::lonnet::split_uri_for_cond($uri);
1.85 albertel 547: if ($uripath) {
548: my $uricond='0';
549: if (defined($hash{'conditions_'.$resid})) {
550: $uricond=$captured{$hash{'conditions_'.$resid}};
551: }
552: if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) {
553: if ($acchash{'acc.res.'.$short.'.'.$uripath}=~
554: /(\&\Q$urifile\E\:[^\&]*)/) {
555: my $replace=$1;
556: my $regexp=$replace;
557: #$regexp=~s/\|/\\\|/g;
1.105 albertel 558: $acchash{'acc.res.'.$short.'.'.$uripath} =~
1.104 albertel 559: s/\Q$regexp\E/$replace\|$uricond/;
1.85 albertel 560: } else {
561: $acchash{'acc.res.'.$short.'.'.$uripath}.=
562: $urifile.':'.$uricond.'&';
563: }
564: } else {
565: $acchash{'acc.res.'.$short.'.'.$uripath}=
566: '&'.$urifile.':'.$uricond.'&';
567: }
568: }
569: }
570: }
1.26 harris41 571: }
1.24 www 572: $acchash{'acc.res.'.$short.'.'}='&:0&';
1.8 www 573: my $courseuri=$uri;
574: $courseuri=~s/^\/res\///;
1.19 www 575: &Apache::lonnet::delenv('(acc\.|httpref\.)');
1.79 albertel 576: &Apache::lonnet::appenv(%acchash);
1.4 www 577: }
578:
1.73 www 579: # ---------------- Selectively delete from randompick maps and hidden url parms
1.29 www 580:
1.73 www 581: sub hiddenurls {
1.31 www 582: my $randomoutentry='';
1.29 www 583: foreach my $rid (keys %randompick) {
584: my $rndpick=$randompick{$rid};
585: my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}};
586: # ------------------------------------------- put existing resources into array
587: my @currentrids=();
1.106 albertel 588: foreach my $key (sort(keys(%hash))) {
589: if ($key=~/^src_($mpc\.\d+)/) {
1.29 www 590: if ($hash{'src_'.$1}) { push @currentrids, $1; }
591: }
592: }
1.50 albertel 593: # rids are number.number and we want to numercially sort on
594: # the second number
595: @currentrids=sort {
596: my (undef,$aid)=split(/\./,$a);
597: my (undef,$bid)=split(/\./,$b);
598: $aid <=> $bid;
599: } @currentrids;
1.29 www 600: next if ($#currentrids<$rndpick);
601: # -------------------------------- randomly eliminate the ones that should stay
1.50 albertel 602: my (undef,$id)=split(/\./,$rid);
1.51 www 603: if ($randompickseed{$rid}) { $id=$randompickseed{$rid}; }
1.50 albertel 604: my $rndseed=&Apache::lonnet::rndseed($id); # use id instead of symb
1.58 albertel 605: &Apache::lonnet::setup_random_from_rndseed($rndseed);
1.50 albertel 606: my @whichids=&Math::Random::random_permuted_index($#currentrids+1);
607: for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; }
608: #&Apache::lonnet::logthis("$id,$rndseed,".join(':',@whichids));
1.29 www 609: # -------------------------------------------------------- delete the leftovers
610: for (my $k=0; $k<=$#currentrids; $k++) {
611: if ($currentrids[$k]) {
612: $hash{'randomout_'.$currentrids[$k]}=1;
1.32 www 613: my ($mapid,$resid)=split(/\./,$currentrids[$k]);
614: $randomoutentry.='&'.
1.86 albertel 615: &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
616: $resid,
617: $hash{'src_'.$currentrids[$k]}
618: ).'&';
1.29 www 619: }
620: }
1.31 www 621: }
1.73 www 622: # ------------------------------ take care of explicitly hidden urls or folders
623: foreach my $rid (keys %hiddenurl) {
624: $hash{'randomout_'.$rid}=1;
625: my ($mapid,$resid)=split(/\./,$rid);
626: $randomoutentry.='&'.
1.86 albertel 627: &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,
628: $hash{'src_'.$rid}).'&';
1.73 www 629: }
630: # --------------------------------------- append randomout entry to environment
1.31 www 631: if ($randomoutentry) {
632: &Apache::lonnet::appenv('acc.randomout' => $randomoutentry);
1.29 www 633: }
634: }
635:
1.1 www 636: # ---------------------------------------------------- Read map and all submaps
637:
638: sub readmap {
1.85 albertel 639: my $short=shift;
640: $short=~s/^\///;
1.108 albertel 641: my %cenv=&Apache::lonnet::coursedescription($short,{'freshen_cache'=>1});
1.85 albertel 642: my $fn=$cenv{'fn'};
643: my $uri;
644: $short=~s/\//\_/g;
645: unless ($uri=$cenv{'url'}) {
646: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
647: "Could not load course $short.</font>");
1.114 www 648: return ('',&mt('No course data available.'));;
1.85 albertel 649: }
650: @cond=('true:normal');
1.96 albertel 651:
652: open(LOCKFILE,">$fn.db.lock");
653: my $lock=0;
654: if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
655: $lock=1;
656: unlink($fn.'.db');
657: unlink($fn.'_symb.db');
658: unlink($fn.'.state');
659: unlink($fn.'parms.db');
660: }
1.85 albertel 661: undef %randompick;
662: undef %hiddenurl;
663: undef %encurl;
1.116 www 664: $retfrid='';
1.96 albertel 665: if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&
1.85 albertel 666: (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {
667: %hash=();
668: %parmhash=();
669: $errtext='';
670: $pc=0;
1.122 albertel 671: &clear_mapalias_count();
1.85 albertel 672: &processversionfile(%cenv);
673: my $furi=&Apache::lonnet::clutter($uri);
674: $hash{'src_0.0'}=&versiontrack($furi);
675: $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');
676: $hash{'ids_'.$furi}='0.0';
677: $hash{'is_map_0.0'}=1;
1.124 ! albertel 678: loadmap($uri,'0.0');
1.85 albertel 679: if (defined($hash{'map_start_'.$uri})) {
680: &Apache::lonnet::appenv("request.course.id" => $short,
681: "request.course.fn" => $fn,
682: "request.course.uri" => $uri);
1.116 www 683: $env{'request.course.id'}=$short;
1.85 albertel 684: &traceroute('0',$hash{'map_start_'.$uri},'&');
685: &accinit($uri,$short,$fn);
686: &hiddenurls();
687: }
1.122 albertel 688: $errtext .= &get_mapalias_errors();
1.62 www 689: # ------------------------------------------------------- Put versions into src
1.106 albertel 690: foreach my $key (keys(%hash)) {
1.110 albertel 691: if ($key=~/^src_/) {
1.106 albertel 692: $hash{$key}=&putinversion($hash{$key});
1.110 albertel 693: } elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) {
694: my ($type, $url) = ($1,$2);
695: my $value = $hash{$key};
696: $hash{$type.&putinversion($url)}=$value;
1.85 albertel 697: }
1.61 www 698: }
1.74 www 699: # ---------------------------------------------------------------- Encrypt URLs
1.106 albertel 700: foreach my $id (keys(%encurl)) {
701: # $hash{'src_'.$id}=&Apache::lonenc::encrypted($hash{'src_'.$id});
702: $hash{'encrypted_'.$id}=1;
1.85 albertel 703: }
1.74 www 704: # ----------------------------------------------- Close hashes to finally store
705: # --------------------------------- Routine must pass this point, no early outs
1.116 www 706: $hash{'first_rid'}=$retfrid;
707: my ($mapid,$resid)=split(/\./,$retfrid);
708: $hash{'first_mapurl'}=$hash{'map_id_'.$mapid};
709: my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$retfrid});
710: $retfurl=&add_get_param($hash{'src_'.$retfrid},{ 'symb' => $symb });
711: if ($hash{'encrypted_'.$retfrid}) {
712: $retfurl=&Apache::lonenc::encrypted($retfurl,(&Apache::lonnet::allowed('adv') ne 'F'));
713: }
1.94 albertel 714: $hash{'first_url'}=$retfurl;
1.85 albertel 715: unless ((untie(%hash)) && (untie(%parmhash))) {
716: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
717: "Could not untie coursemap $fn for $uri.</font>");
718: }
719: # ---------------------------------------------------- Store away initial state
720: {
721: my $cfh;
1.88 raeburn 722: if (open($cfh,">$fn.state")) {
1.85 albertel 723: print $cfh join("\n",@cond);
724: } else {
725: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
726: "Could not write statemap $fn for $uri.</font>");
727: }
1.96 albertel 728: }
729: flock(LOCKFILE,LOCK_UN);
730: close(LOCKFILE);
1.85 albertel 731: } else {
1.87 albertel 732: # if we are here it is likely because we are already trying to
733: # initialize the course in another child, busy wait trying to
734: # tie the hashes for the next 90 seconds, if we succeed forward
735: # them on to navmaps, if we fail, throw up the Could not init
736: # course screen
1.96 albertel 737: if ($lock) {
738: # Got the lock but not the DB files
739: flock(LOCKFILE,LOCK_UN);
740: }
1.87 albertel 741: untie(%hash);
742: untie(%parmhash);
1.85 albertel 743: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
744: "Could not tie coursemap $fn for $uri.</font>");
1.87 albertel 745: my $i=0;
746: while($i<90) {
747: $i++;
748: sleep(1);
1.96 albertel 749: if (flock(LOCKFILE,LOCK_EX|LOCK_NB) &&
750: (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640))) {
1.87 albertel 751: if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {
752: $retfurl='/adm/navmaps';
753: &Apache::lonnet::appenv("request.course.id" => $short,
754: "request.course.fn" => $fn,
755: "request.course.uri" => $uri);
756: untie(%hash);
757: untie(%parmhash);
758: last;
759: }
760: }
761: untie(%hash);
762: untie(%parmhash);
763: }
1.96 albertel 764: flock(LOCKFILE,LOCK_UN);
765: close(LOCKFILE);
1.1 www 766: }
1.89 albertel 767: &Apache::lonmsg::author_res_msg($env{'request.course.uri'},$errtext);
1.46 www 768: # ------------------------------------------------- Check for critical messages
769:
1.89 albertel 770: my @what=&Apache::lonnet::dump('critical',$env{'user.domain'},
771: $env{'user.name'});
1.46 www 772: if ($what[0]) {
773: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
774: $retfurl='/adm/email?critical=display';
775: }
776: }
1.85 albertel 777: return ($retfurl,$errtext);
1.1 www 778: }
1.15 www 779:
780: # ------------------------------------------------------- Evaluate state string
781:
782: sub evalstate {
1.89 albertel 783: my $fn=$env{'request.course.fn'}.'.state';
1.80 albertel 784: my $state='';
1.15 www 785: if (-e $fn) {
1.80 albertel 786: my @conditions=();
787: {
1.115 raeburn 788: open(my $fh,"<$fn");
1.80 albertel 789: @conditions=<$fh>;
1.115 raeburn 790: close($fh);
1.80 albertel 791: }
792: my $safeeval = new Safe;
793: my $safehole = new Safe::Hole;
794: $safeeval->permit("entereval");
795: $safeeval->permit(":base_math");
796: $safeeval->deny(":base_io");
797: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
798: foreach my $line (@conditions) {
799: chomp($line);
800: my ($condition,$weight)=split(/\:/,$line);
801: if ($safeeval->reval($condition)) {
802: if ($weight eq 'force') {
803: $state.='3';
804: } else {
805: $state.='2';
806: }
807: } else {
808: if ($weight eq 'stop') {
809: $state.='0';
810: } else {
811: $state.='1';
812: }
813: }
814: }
1.15 www 815: }
1.89 albertel 816: &Apache::lonnet::appenv('user.state.'.$env{'request.course.id'} => $state);
1.15 www 817: return $state;
818: }
819:
1.122 albertel 820: {
821: my %mapalias_cache;
822: sub count_mapalias {
823: my ($value,$resid) = @_;
824: push(@{ $mapalias_cache{$value} }, $resid);
825: }
826:
827: sub get_mapalias_errors {
828: my $error_text;
829: foreach my $mapalias (sort(keys(%mapalias_cache))) {
830: next if (scalar(@{ $mapalias_cache{$mapalias} } ) == 1);
831: my $count;
832: my $which =
833: join('</li><li>',
834: map {
835: my $id = $_;
836: if (exists($hash{'src_'.$id})) {
837: $count++;
838: }
839: my ($mapid) = split(/\./,$id);
840: &mt('[_1] in [_2]', $hash{'title_'.$id},
841:
842: $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}});
843: } (@{ $mapalias_cache{$mapalias} }));
844: next if ($count < 2);
845: $error_text .= '<div class="LC_error">'.
846: &mt('Error: Found the mapalias "[_1]" defined multiple times.',
847: $mapalias).
848: '</div><ul><li>'.$which.'</li></ul>';
849: }
850: &clear_mapalias_count();
851: return $error_text;
852: }
853: sub clear_mapalias_count {
854: undef(%mapalias_cache);
855: }
856: }
1.1 www 857: 1;
858: __END__
859:
1.26 harris41 860: =head1 NAME
861:
862: Apache::lonuserstate - Construct and maintain state and binary representation
863: of course for user
864:
865: =head1 SYNOPSIS
866:
867: Invoked by lonroles.pm.
868:
869: &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
870:
871: =head1 INTRODUCTION
872:
873: This module constructs and maintains state and binary representation
874: of course for user.
875:
876: This is part of the LearningOnline Network with CAPA project
877: described at http://www.lon-capa.org.
878:
879: =head1 HANDLER SUBROUTINE
880:
881: There is no handler subroutine.
882:
883: =head1 OTHER SUBROUTINES
884:
885: =over 4
886:
887: =item *
888:
889: loadmap() : Loads map from disk
890:
891: =item *
892:
893: simplify() : Simplify expression
894:
895: =item *
896:
897: traceroute() : Build condition hash
898:
899: =item *
900:
901: accinit() : Cascading conditions, quick access, parameters
1.1 www 902:
1.26 harris41 903: =item *
1.1 www 904:
1.26 harris41 905: readmap() : Read map and all submaps
1.1 www 906:
1.26 harris41 907: =item *
1.1 www 908:
1.26 harris41 909: evalstate() : Evaluate state string
1.1 www 910:
1.26 harris41 911: =back
1.1 www 912:
1.26 harris41 913: =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