rat/lonuserstate.pm - view

File: [LON-CAPA] / rat / lonuserstate.pm
Revision 1.131: download - view: text, annotated - select for diffs
Wed Feb 18 07:06:19 2009 UTC (15 years, 2 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_8_99_0, bz5969, bz2851, HEAD, GCI_2

- Starting with lonnet.pm rev 1.981, default for &lonnet::delenv() has been to \Q escape arg in regexp used to identify items in environment to delete.
  - No longer need to escape special characters in arg passed to lonnet::delenv().
- Call to lonnet::delenv() in rat/lonuserstate now includes second arg, because in this case first arg is to be treated as a regexp (so \Q escape is not wanted).

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.131 2009/02/18 07:06:19 raeburn 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: ### 29: 30: package Apache::lonuserstate; 31: 32: # ------------------------------------------------- modules used by this module 33: use strict; 34: use HTML::TokeParser; 35: use Apache::lonnet; 36: use Apache::lonlocal; 37: use Apache::loncommon(); 38: use GDBM_File; 39: use Apache::lonmsg; 40: use Safe; 41: use Safe::Hole; 42: use Opcode; 43: use Apache::lonenc; 44: use Fcntl qw(:flock); 45: use LONCAPA; 46: 47: 48: # ---------------------------------------------------- Globals for this package 49: 50: my $pc; # Package counter 51: my %hash; # The big tied hash 52: my %parmhash;# The hash with the parameters 53: my @cond; # Array with all of the conditions 54: my $errtext; # variable with all errors 55: my $retfrid; # variable with the very first RID in the course 56: my $retfurl; # first URL 57: my %randompick; # randomly picked resources 58: my %randompickseed; # optional seed for randomly picking resources 59: my %randomorder; # maps to order contents randomly 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 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/; 70: unless ($hash{'version_'.$uri}) { 71: $hash{'version_'.$uri}=$version; 72: } 73: } 74: return $uri; 75: } 76: 77: # -------------------------------------------------------------- Put in version 78: 79: sub putinversion { 80: my $uri=shift; 81: my $key=$env{'request.course.id'}.'_'.&Apache::lonnet::clutter($uri); 82: if ($hash{'version_'.$uri}) { 83: my $version=$hash{'version_'.$uri}; 84: if ($version eq 'mostrecent') { return $uri; } 85: if ($version eq &Apache::lonnet::getversion( 86: &Apache::lonnet::filelocation('',$uri))) 87: { return $uri; } 88: $uri=~s/\.(\w+)$/\.$version\.$1/; 89: } 90: &Apache::lonnet::do_cache_new('courseresversion',$key,&Apache::lonnet::declutter($uri),600); 91: return $uri; 92: } 93: 94: # ----------------------------------------- Processing versions file for course 95: 96: sub processversionfile { 97: my %cenv=@_; 98: my %versions=&Apache::lonnet::dump('resourceversions', 99: $cenv{'domain'}, 100: $cenv{'num'}); 101: foreach my $ver (keys(%versions)) { 102: if ($ver=~/^error\:/) { return; } 103: $hash{'version_'.$ver}=$versions{$ver}; 104: } 105: } 106: 107: # --------------------------------------------------------- Loads map from disk 108: 109: sub loadmap { 110: my ($uri,$parent_rid)=@_; 111: if ($hash{'map_pc_'.$uri}) { 112: $errtext.=''. 113: &mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>'). 114: ''; 115: return; 116: } 117: $pc++; 118: my $lpc=$pc; 119: $hash{'map_pc_'.$uri}=$lpc; 120: $hash{'map_id_'.$lpc}=$uri; 121: 122: # Determine and check filename 123: my $fn=&Apache::lonnet::filelocation('',&putinversion($uri)); 124: 125: my $ispage=($fn=~/\.page$/); 126: 127: unless (($fn=~/\.sequence$/) || 128: ($fn=~/\.page$/)) { 129: $errtext.=&mt(" Invalid map: <tt>[_1]</tt>",$fn); 130: return; 131: } 132: 133: my $instr=&Apache::lonnet::getfile($fn); 134: 135: if ($instr eq -1) { 136: $errtext.=&mt(' Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn); 137: return; 138: } 139: 140: # Successfully got file, parse it 141: 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); 154: 155: my $linkpc=0; 156: 157: $fn=~/\.(\w+)$/; 158: 159: $hash{'map_type_'.$lpc}=$1; 160: 161: my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i); 162: 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) { 169: # ----------------------------------------------------------------------- Links 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: } 177: 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}); 188: 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: } 208: 209: $hash{'map_finish_'.$uri}= $from_rid; 210: $hash{'type_'.$from_rid}='finish'; 211: } 212: 213: $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: 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/^https?\:\/\//\/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: 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$/) { 407: &count_mapalias($token->[2]->{'value'},$referid); 408: $hash{'mapalias_'.$token->[2]->{'value'}}=$referid; 409: } 410: } 411: 412: # --------------------------------------------------------- Simplify expression 413: 414: sub simplify { 415: my $expression=shift; 416: # (0&1) = 1 417: $expression=~s/$0\&([_\.\d]+)$/$1/g; 418: # (8)=8 419: $expression=~s/$([_\.\d]+)$/$1/g; 420: # 8&8=8 421: $expression=~s/([^_\.\d])([_\.\d]+)\&\2([^_\.\d])/$1$2$3/g; 422: # 8|8=8 423: $expression=~s/([^_\.\d])([_\.\d]+)\|\2([^_\.\d])/$1$2$3/g; 424: # (5&3)&4=5&3&4 425: $expression=~s/$([_\.\d]+)((?:\&[_\.\d]+)+)$\&([_\.\d]+[^_\.\d])/$1$2\&$3/g; 426: # (((5&3)|(4&6)))=((5&3)|(4&6)) 427: $expression=~ 428: s/$(\(\([_\.\d]+(?:\&[_\.\d]+)*$(?:\|$[_\.\d]+(?:\&[_\.\d]+)*$)+\))\)/$1/g; 429: # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2) 430: $expression=~ 431: s/$(\([_\.\d]+(?:\&[_\.\d]+)*$)((?:\|$[_\.\d]+(?:\&[_\.\d]+)*$)+)\)\|($[_\.\d]+(?:\&[_\.\d]+)*$)/$$1$2\|$3$/g; 432: return $expression; 433: } 434: 435: # -------------------------------------------------------- Build condition hash 436: 437: sub traceroute { 438: my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_; 439: my $newsofar=$sofar=simplify($sofar); 440: unless ($beenhere=~/\&\Q$rid\E\&/) { 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); 445: 446: if ($hdnflag || lc($hidden) eq 'yes') { 447: $hiddenurl{$rid}=1; 448: } 449: if (!$hdnflag && lc($hidden) eq 'no') { 450: delete($hiddenurl{$rid}); 451: } 452: 453: my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb); 454: if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; } 455: if (($retfrid eq '') && ($hash{'src_'.$rid}) 456: && ($hash{'src_'.$rid}!~/\.sequence$/)) { 457: $retfrid=$rid; 458: } 459: if (defined($hash{'conditions_'.$rid})) { 460: $hash{'conditions_'.$rid}=simplify( 461: '('.$hash{'conditions_'.$rid}.')|('.$sofar.')'); 462: } else { 463: $hash{'conditions_'.$rid}=$sofar; 464: } 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: 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: $beenhere, 476: $encflag || $encurl{$rid}, 477: $hdnflag || $hiddenurl{$rid}); 478: } 479: } 480: if (defined($hash{'to_'.$rid})) { 481: foreach my $id (split(/\,/,$hash{'to_'.$rid})) { 482: my $further=$sofar; 483: if ($hash{'undercond_'.$id}) { 484: if (defined($hash{'condid_'.$hash{'undercond_'.$id}})) { 485: $further=simplify('('.'_'.$rid.')&('. 486: $hash{'condid_'.$hash{'undercond_'.$id}}.')'); 487: } else { 488: $errtext.=&mt(' Undefined condition ID: [_1]',$hash{'undercond_'.$id}); 489: } 490: } 491: $newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere, 492: $encflag,$hdnflag); 493: } 494: } 495: } 496: return $newsofar; 497: } 498: 499: # ------------------------------ Cascading conditions, quick access, parameters 500: 501: sub accinit { 502: my ($uri,$short,$fn)=@_; 503: my %acchash=(); 504: my %captured=(); 505: my $condcounter=0; 506: $acchash{'acc.cond.'.$short.'.0'}=0; 507: foreach my $key (keys(%hash)) { 508: if ($key=~/^conditions/) { 509: my $expr=$hash{$key}; 510: # try to find and factor out common sub-expressions 511: foreach my $sub ($expr=~m/($\([_\.\d]+(?:\&[_\.\d]+)+$(?:\|$[_\.\d]+(?:\&[_\.\d]+)+$)+\))/g) { 512: my $orig=$sub; 513: 514: my ($factor) = ($sub=~/$\(([_\.\d]+\&(:?[_\.\d]+\&)*)(?:[_\.\d]+\&*)+$(?:\|$\1(?:[_\.\d]+\&*)+$)+\)/); 515: next if (!defined($factor)); 516: 517: $sub=~s/\Q$factor\E//g; 518: $sub=~s/^\(/\($factor\(/; 519: $sub.=')'; 520: $sub=simplify($sub); 521: $expr=~s/\Q$orig\E/$sub/; 522: } 523: $hash{$key}=$expr; 524: unless (defined($captured{$expr})) { 525: $condcounter++; 526: $captured{$expr}=$condcounter; 527: $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr; 528: } 529: } elsif ($key=~/^param_(\d+)\.(\d+)/) { 530: my $prefix=&Apache::lonnet::encode_symb($hash{'map_id_'.$1},$2, 531: $hash{'src_'.$1.'.'.$2}); 532: foreach my $param (split(/\&/,$hash{$key})) { 533: my ($typename,$value)=split(/\=/,$param); 534: my ($type,$name)=split(/\:/,$typename); 535: $parmhash{$prefix.'.'.&unescape($name)}= 536: &unescape($value); 537: $parmhash{$prefix.'.'.&unescape($name).'.type'}= 538: &unescape($type); 539: } 540: } 541: } 542: foreach my $key (keys(%hash)) { 543: if ($key=~/^ids/) { 544: foreach my $resid (split(/\,/,$hash{$key})) { 545: my $uri=$hash{'src_'.$resid}; 546: my ($uripath,$urifile) = 547: &Apache::lonnet::split_uri_for_cond($uri); 548: if ($uripath) { 549: my $uricond='0'; 550: if (defined($hash{'conditions_'.$resid})) { 551: $uricond=$captured{$hash{'conditions_'.$resid}}; 552: } 553: if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) { 554: if ($acchash{'acc.res.'.$short.'.'.$uripath}=~ 555: /(\&\Q$urifile\E\:[^\&]*)/) { 556: my $replace=$1; 557: my $regexp=$replace; 558: #$regexp=~s/\|/\\\|/g; 559: $acchash{'acc.res.'.$short.'.'.$uripath} =~ 560: s/\Q$regexp\E/$replace\|$uricond/; 561: } else { 562: $acchash{'acc.res.'.$short.'.'.$uripath}.= 563: $urifile.':'.$uricond.'&'; 564: } 565: } else { 566: $acchash{'acc.res.'.$short.'.'.$uripath}= 567: '&'.$urifile.':'.$uricond.'&'; 568: } 569: } 570: } 571: } 572: } 573: $acchash{'acc.res.'.$short.'.'}='&:0&'; 574: my $courseuri=$uri; 575: $courseuri=~s/^\/res\///; 576: my $regexp = 1; 577: &Apache::lonnet::delenv('(acc\.|httpref\.)',$regexp); 578: &Apache::lonnet::appenv(\%acchash); 579: } 580: 581: # ---------------- Selectively delete from randompick maps and hidden url parms 582: 583: sub hiddenurls { 584: my $randomoutentry=''; 585: foreach my $rid (keys %randompick) { 586: my $rndpick=$randompick{$rid}; 587: my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}}; 588: # ------------------------------------------- put existing resources into array 589: my @currentrids=(); 590: foreach my $key (sort(keys(%hash))) { 591: if ($key=~/^src_($mpc\.\d+)/) { 592: if ($hash{'src_'.$1}) { push @currentrids, $1; } 593: } 594: } 595: # rids are number.number and we want to numercially sort on 596: # the second number 597: @currentrids=sort { 598: my (undef,$aid)=split(/\./,$a); 599: my (undef,$bid)=split(/\./,$b); 600: $aid <=> $bid; 601: } @currentrids; 602: next if ($#currentrids<$rndpick); 603: # -------------------------------- randomly eliminate the ones that should stay 604: my (undef,$id)=split(/\./,$rid); 605: if ($randompickseed{$rid}) { $id=$randompickseed{$rid}; } 606: my $rndseed=&Apache::lonnet::rndseed($id); # use id instead of symb 607: &Apache::lonnet::setup_random_from_rndseed($rndseed); 608: my @whichids=&Math::Random::random_permuted_index($#currentrids+1); 609: for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; } 610: #&Apache::lonnet::logthis("$id,$rndseed,".join(':',@whichids)); 611: # -------------------------------------------------------- delete the leftovers 612: for (my $k=0; $k<=$#currentrids; $k++) { 613: if ($currentrids[$k]) { 614: $hash{'randomout_'.$currentrids[$k]}=1; 615: my ($mapid,$resid)=split(/\./,$currentrids[$k]); 616: $randomoutentry.='&'. 617: &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid}, 618: $resid, 619: $hash{'src_'.$currentrids[$k]} 620: ).'&'; 621: } 622: } 623: } 624: # ------------------------------ take care of explicitly hidden urls or folders 625: foreach my $rid (keys %hiddenurl) { 626: $hash{'randomout_'.$rid}=1; 627: my ($mapid,$resid)=split(/\./,$rid); 628: $randomoutentry.='&'. 629: &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid, 630: $hash{'src_'.$rid}).'&'; 631: } 632: # --------------------------------------- append randomout entry to environment 633: if ($randomoutentry) { 634: &Apache::lonnet::appenv({'acc.randomout' => $randomoutentry}); 635: } 636: } 637: 638: # ---------------------------------------------------- Read map and all submaps 639: 640: sub readmap { 641: my $short=shift; 642: $short=~s/^\///; 643: my %cenv=&Apache::lonnet::coursedescription($short,{'freshen_cache'=>1}); 644: my $fn=$cenv{'fn'}; 645: my $uri; 646: $short=~s/\//\_/g; 647: unless ($uri=$cenv{'url'}) { 648: &Apache::lonnet::logthis("WARNING: ". 649: "Could not load course $short."); 650: return ('',&mt('No course data available.'));; 651: } 652: @cond=('true:normal'); 653: 654: open(LOCKFILE,">$fn.db.lock"); 655: my $lock=0; 656: if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) { 657: $lock=1; 658: unlink($fn.'.db'); 659: unlink($fn.'_symb.db'); 660: unlink($fn.'.state'); 661: unlink($fn.'parms.db'); 662: } 663: undef %randompick; 664: undef %hiddenurl; 665: undef %encurl; 666: $retfrid=''; 667: if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) && 668: (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) { 669: %hash=(); 670: %parmhash=(); 671: $errtext=''; 672: $pc=0; 673: &clear_mapalias_count(); 674: &processversionfile(%cenv); 675: my $furi=&Apache::lonnet::clutter($uri); 676: $hash{'src_0.0'}=&versiontrack($furi); 677: $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title'); 678: $hash{'ids_'.$furi}='0.0'; 679: $hash{'is_map_0.0'}=1; 680: loadmap($uri,'0.0'); 681: if (defined($hash{'map_start_'.$uri})) { 682: &Apache::lonnet::appenv({"request.course.id" => $short, 683: "request.course.fn" => $fn, 684: "request.course.uri" => $uri}); 685: $env{'request.course.id'}=$short; 686: &traceroute('0',$hash{'map_start_'.$uri},'&'); 687: &accinit($uri,$short,$fn); 688: &hiddenurls(); 689: } 690: $errtext .= &get_mapalias_errors(); 691: # ------------------------------------------------------- Put versions into src 692: foreach my $key (keys(%hash)) { 693: if ($key=~/^src_/) { 694: $hash{$key}=&putinversion($hash{$key}); 695: } elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) { 696: my ($type, $url) = ($1,$2); 697: my $value = $hash{$key}; 698: $hash{$type.&putinversion($url)}=$value; 699: } 700: } 701: # ---------------------------------------------------------------- Encrypt URLs 702: foreach my $id (keys(%encurl)) { 703: # $hash{'src_'.$id}=&Apache::lonenc::encrypted($hash{'src_'.$id}); 704: $hash{'encrypted_'.$id}=1; 705: } 706: # ----------------------------------------------- Close hashes to finally store 707: # --------------------------------- Routine must pass this point, no early outs 708: $hash{'first_rid'}=$retfrid; 709: my ($mapid,$resid)=split(/\./,$retfrid); 710: $hash{'first_mapurl'}=$hash{'map_id_'.$mapid}; 711: my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$retfrid}); 712: $retfurl=&add_get_param($hash{'src_'.$retfrid},{ 'symb' => $symb }); 713: if ($hash{'encrypted_'.$retfrid}) { 714: $retfurl=&Apache::lonenc::encrypted($retfurl,(&Apache::lonnet::allowed('adv') ne 'F')); 715: } 716: $hash{'first_url'}=$retfurl; 717: unless ((untie(%hash)) && (untie(%parmhash))) { 718: &Apache::lonnet::logthis("WARNING: ". 719: "Could not untie coursemap $fn for $uri."); 720: } 721: # ---------------------------------------------------- Store away initial state 722: { 723: my $cfh; 724: if (open($cfh,">$fn.state")) { 725: print $cfh join("\n",@cond); 726: } else { 727: &Apache::lonnet::logthis("WARNING: ". 728: "Could not write statemap $fn for $uri."); 729: } 730: } 731: flock(LOCKFILE,LOCK_UN); 732: close(LOCKFILE); 733: } else { 734: # if we are here it is likely because we are already trying to 735: # initialize the course in another child, busy wait trying to 736: # tie the hashes for the next 90 seconds, if we succeed forward 737: # them on to navmaps, if we fail, throw up the Could not init 738: # course screen 739: if ($lock) { 740: # Got the lock but not the DB files 741: flock(LOCKFILE,LOCK_UN); 742: } 743: untie(%hash); 744: untie(%parmhash); 745: &Apache::lonnet::logthis("WARNING: ". 746: "Could not tie coursemap $fn for $uri."); 747: my $i=0; 748: while($i<90) { 749: $i++; 750: sleep(1); 751: if (flock(LOCKFILE,LOCK_EX|LOCK_NB) && 752: (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640))) { 753: if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) { 754: $retfurl='/adm/navmaps'; 755: &Apache::lonnet::appenv({"request.course.id" => $short, 756: "request.course.fn" => $fn, 757: "request.course.uri" => $uri}); 758: untie(%hash); 759: untie(%parmhash); 760: last; 761: } 762: } 763: untie(%hash); 764: untie(%parmhash); 765: } 766: flock(LOCKFILE,LOCK_UN); 767: close(LOCKFILE); 768: } 769: &Apache::lonmsg::author_res_msg($env{'request.course.uri'},$errtext); 770: # ------------------------------------------------- Check for critical messages 771: 772: my @what=&Apache::lonnet::dump('critical',$env{'user.domain'}, 773: $env{'user.name'}); 774: if ($what[0]) { 775: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) { 776: $retfurl='/adm/email?critical=display'; 777: } 778: } 779: return ($retfurl,$errtext); 780: } 781: 782: # ------------------------------------------------------- Evaluate state string 783: 784: sub evalstate { 785: my $fn=$env{'request.course.fn'}.'.state'; 786: my $state=''; 787: if (-e $fn) { 788: my @conditions=(); 789: { 790: open(my $fh,"<$fn"); 791: @conditions=<$fh>; 792: close($fh); 793: } 794: my $safeeval = new Safe; 795: my $safehole = new Safe::Hole; 796: $safeeval->permit("entereval"); 797: $safeeval->permit(":base_math"); 798: $safeeval->deny(":base_io"); 799: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); 800: foreach my $line (@conditions) { 801: chomp($line); 802: my ($condition,$weight)=split(/\:/,$line); 803: if ($safeeval->reval($condition)) { 804: if ($weight eq 'force') { 805: $state.='3'; 806: } else { 807: $state.='2'; 808: } 809: } else { 810: if ($weight eq 'stop') { 811: $state.='0'; 812: } else { 813: $state.='1'; 814: } 815: } 816: } 817: } 818: &Apache::lonnet::appenv({'user.state.'.$env{'request.course.id'} => $state}); 819: return $state; 820: } 821: 822: { 823: my %mapalias_cache; 824: sub count_mapalias { 825: my ($value,$resid) = @_; 826: push(@{ $mapalias_cache{$value} }, $resid); 827: } 828: 829: sub get_mapalias_errors { 830: my $error_text; 831: foreach my $mapalias (sort(keys(%mapalias_cache))) { 832: next if (scalar(@{ $mapalias_cache{$mapalias} } ) == 1); 833: my $count; 834: my $which = 835: join('</li><li>', 836: map { 837: my $id = $_; 838: if (exists($hash{'src_'.$id})) { 839: $count++; 840: } 841: my ($mapid) = split(/\./,$id); 842: &mt('Resource "[_1]" in Map "[_2]"', 843: $hash{'title_'.$id}, 844: $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}}); 845: } (@{ $mapalias_cache{$mapalias} })); 846: next if ($count < 2); 847: $error_text .= '<div class="LC_error">'. 848: &mt('Error: Found the mapalias "[_1]" defined multiple times.', 849: $mapalias). 850: '</div><ul><li>'.$which.'</li></ul>'; 851: } 852: &clear_mapalias_count(); 853: return $error_text; 854: } 855: sub clear_mapalias_count { 856: undef(%mapalias_cache); 857: } 858: } 859: 1; 860: __END__ 861: 862: =head1 NAME 863: 864: Apache::lonuserstate - Construct and maintain state and binary representation 865: of course for user 866: 867: =head1 SYNOPSIS 868: 869: Invoked by lonroles.pm. 870: 871: &Apache::lonuserstate::readmap($cdom.'/'.$cnum); 872: 873: =head1 INTRODUCTION 874: 875: This module constructs and maintains state and binary representation 876: of course for user. 877: 878: This is part of the LearningOnline Network with CAPA project 879: described at http://www.lon-capa.org. 880: 881: =head1 SUBROUTINES 882: 883: =over 884: 885: =item loadmap() 886: 887: Loads map from disk 888: 889: =item simplify() 890: 891: Simplify expression 892: 893: =item traceroute() 894: 895: Build condition hash 896: 897: =item accinit() 898: 899: Cascading conditions, quick access, parameters 900: 901: =item readmap() 902: 903: Read map and all submaps 904: 905: =item evalstate() 906: 907: Evaluate state string 908: 909: =back 910: 911: =cut