rat/lonuserstate.pm - view

File: [LON-CAPA] / rat / lonuserstate.pm
Revision 1.138: download - view: text, annotated - select for diffs
Tue Jul 26 10:40:23 2011 UTC (12 years, 9 months ago) by foxr
Branches: MAIN
CVS tags: HEAD

1. Centralize tempdir location in unlink_tmpfiles.
2. Get rid of >dirty< next in parse_resource ... returning
  undef instead for zombie resources and checking in the
  loop that calls it.

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.138 2011/07/26 10:40:23 foxr 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: use File::Basename; 47: 48: 49: 50: # ---------------------------------------------------- Globals for this package 51: 52: my $pc; # Package counter is this what 'Guts' calls the map counter? 53: my %hash; # The big tied hash 54: my %parmhash;# The hash with the parameters 55: my @cond; # Array with all of the conditions 56: my $errtext; # variable with all errors 57: my $retfrid; # variable with the very first RID in the course 58: my $retfurl; # first URL 59: my %randompick; # randomly picked resources 60: my %randompickseed; # optional seed for randomly picking resources 61: my %randomorder; # maps to order contents randomly 62: my %encurl; # URLs in this folder are supposed to be encrypted 63: my %hiddenurl; # this URL (or complete folder) is supposed to be hidden 64: 65: # ----------------------------------- Remove version from URL and store in hash 66: 67: sub versionerror { 68: my ($uri,$usedversion,$unusedversion)=@_; 69: return ' '.&mt('Version discrepancy: resource [_1] included in both version [_2] and version [_3]. Using version [_2].', 70: $uri,$usedversion,$unusedversion).' '; 71: } 72: 73: sub versiontrack { 74: my $uri=shift; 75: if ($uri=~/\.(\d+)\.\w+$/) { 76: my $version=$1; 77: $uri=~s/\.\d+\.(\w+)$/\.$1/; 78: unless ($hash{'version_'.$uri}) { 79: $hash{'version_'.$uri}=$version; 80: } elsif ($version!=$hash{'version_'.$uri}) { 81: $errtext.=&versionerror($uri,$hash{'version_'.$uri},$version); 82: } 83: } 84: return $uri; 85: } 86: 87: # -------------------------------------------------------------- Put in version 88: 89: sub putinversion { 90: my $uri=shift; 91: my $key=$env{'request.course.id'}.'_'.&Apache::lonnet::clutter($uri); 92: if ($hash{'version_'.$uri}) { 93: my $version=$hash{'version_'.$uri}; 94: if ($version eq 'mostrecent') { return $uri; } 95: if ($version eq &Apache::lonnet::getversion( 96: &Apache::lonnet::filelocation('',$uri))) 97: { return $uri; } 98: $uri=~s/\.(\w+)$/\.$version\.$1/; 99: } 100: &Apache::lonnet::do_cache_new('courseresversion',$key,&Apache::lonnet::declutter($uri),600); 101: return $uri; 102: } 103: 104: # ----------------------------------------- Processing versions file for course 105: 106: sub processversionfile { 107: my %cenv=@_; 108: my %versions=&Apache::lonnet::dump('resourceversions', 109: $cenv{'domain'}, 110: $cenv{'num'}); 111: foreach my $ver (keys(%versions)) { 112: if ($ver=~/^error\:/) { return; } 113: $hash{'version_'.$ver}=$versions{$ver}; 114: } 115: } 116: 117: # --------------------------------------------------------- Loads from disk 118: 119: sub loadmap { 120: my ($uri,$parent_rid)=@_; 121: 122: # Is the map already included? 123: 124: if ($hash{'map_pc_'.$uri}) { 125: $errtext.=''. 126: &mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>'). 127: ''; 128: return; 129: } 130: # Register the resource in it's map_pc_ [for the URL] 131: # map_id.nnn is the nesting level -> to the URI. 132: 133: $pc++; 134: my $lpc=$pc; 135: $hash{'map_pc_'.$uri}=$lpc; 136: $hash{'map_id_'.$lpc}=$uri; 137: 138: # If the parent is of the form n.m hang this map underneath it in the 139: # map hierarchy. 140: 141: if ($parent_rid =~ /^(\d+)\.\d+$/) { 142: my $parent_pc = $1; 143: if (defined($hash{'map_hierarchy_'.$parent_pc})) { 144: $hash{'map_hierarchy_'.$lpc}=$hash{'map_hierarchy_'.$parent_pc}.','. 145: $parent_pc; 146: } else { 147: $hash{'map_hierarchy_'.$lpc}=$parent_pc; 148: } 149: } 150: 151: # Determine and check filename of the sequence we need to read: 152: 153: my $fn=&Apache::lonnet::filelocation('',&putinversion($uri)); 154: 155: my $ispage=($fn=~/\.page$/); 156: 157: # We can only nest sequences or pages. Anything else is an illegal nest. 158: 159: unless (($fn=~/\.sequence$/) || $ispage) { 160: $errtext.=&mt(" Invalid map: <tt>[_1]</tt>",$fn); 161: return; 162: } 163: 164: # Read the XML that constitutes the file. 165: 166: my $instr=&Apache::lonnet::getfile($fn); 167: 168: if ($instr eq -1) { 169: $errtext.=&mt(' Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn); 170: return; 171: } 172: 173: # Successfully got file, parse it 174: 175: # parse for parameter processing. 176: # Note that these are <param... / > tags 177: # so we only care about 'S' (tag start) nodes. 178: 179: 180: my $parser = HTML::TokeParser->new(\$instr); 181: $parser->attr_encoded(1); 182: 183: # first get all parameters 184: 185: 186: while (my $token = $parser->get_token) { 187: next if ($token->[0] ne 'S'); 188: if ($token->[1] eq 'param') { 189: &parse_param($token,$lpc); 190: } 191: } 192: 193: # Get set to take another pass through the XML: 194: # for resources and links. 195: 196: $parser = HTML::TokeParser->new(\$instr); 197: $parser->attr_encoded(1); 198: 199: my $linkpc=0; 200: 201: $fn=~/\.(\w+)$/; 202: 203: $hash{'map_type_'.$lpc}=$1; 204: 205: my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i); 206: 207: # Parse the resources, link and condition tags. 208: # Note that if randomorder or random select is chosen the links and 209: # conditions are meaningless but are determined by the randomization. 210: # This is handled in the next chunk of code. 211: 212: my @map_ids; 213: while (my $token = $parser->get_token) { 214: next if ($token->[0] ne 'S'); 215: 216: # Resource 217: 218: if ($token->[1] eq 'resource') { 219: my $resource_id = &parse_resource($token,$lpc,$ispage,$uri); 220: if (defined $resource_id) { 221: push(@map_ids, $resource_id); 222: } 223: 224: # Link 225: 226: } elsif ($token->[1] eq 'link' && !$randomize) { 227: &make_link(++$linkpc,$lpc,$token->[2]->{'to'}, 228: $token->[2]->{'from'}, 229: $token->[2]->{'condition'}); 230: 231: # condition 232: 233: } elsif ($token->[1] eq 'condition' && !$randomize) { 234: &parse_condition($token,$lpc); 235: } 236: } 237: 238: 239: # Handle randomization and random selection 240: 241: if ($randomize) { 242: if (!$env{'request.role.adv'}) { 243: my $seed; 244: if (defined($randompickseed{$parent_rid})) { 245: $seed = $randompickseed{$parent_rid}; 246: } else { 247: my ($mapid,$resid)=split(/\./,$parent_rid); 248: my $symb= 249: &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid}, 250: $resid,$hash{'src_'.$parent_rid}); 251: 252: $seed = $symb; 253: } 254: 255: # Here for sure we need to pass along the username/domain 256: # so that we can impersonate users in lonprintout e.g. 257: 258: my $rndseed=&Apache::lonnet::rndseed($seed); 259: &Apache::lonnet::setup_random_from_rndseed($rndseed); 260: @map_ids=&Math::Random::random_permutation(@map_ids); 261: } 262: my $from = shift(@map_ids); 263: my $from_rid = $lpc.'.'.$from; 264: $hash{'map_start_'.$uri} = $from_rid; 265: $hash{'type_'.$from_rid}='start'; 266: 267: while (my $to = shift(@map_ids)) { 268: &make_link(++$linkpc,$lpc,$to,$from); 269: my $to_rid = $lpc.'.'.$to; 270: $hash{'type_'.$to_rid}='normal'; 271: $from = $to; 272: $from_rid = $to_rid; 273: } 274: 275: $hash{'map_finish_'.$uri}= $from_rid; 276: $hash{'type_'.$from_rid}='finish'; 277: } 278: 279: $parser = HTML::TokeParser->new(\$instr); 280: $parser->attr_encoded(1); 281: # last parse out the mapalias params so as to ignore anything 282: # refering to non-existant resources 283: while (my $token = $parser->get_token) { 284: next if ($token->[0] ne 'S'); 285: if ($token->[1] eq 'param') { 286: &parse_mapalias_param($token,$lpc); 287: } 288: } 289: } 290: 291: 292: # -------------------------------------------------------------------- Resource 293: # 294: # Parses a resource tag to produce the value to push into the 295: # map_ids array. 296: # 297: # 298: # Information about the actual type of resource is provided by the file extension 299: # of the uri (e.g. .problem, .sequence etc. etc.). 300: # 301: # Parameters: 302: # $token - A token from HTML::TokeParser 303: # This is an array that describes the most recently parsed HTML item. 304: # $lpc - Map nesting level (?) 305: # $ispage - True if this resource is encapsulated in a .page (assembled resourcde). 306: # $uri - URI of the enclosing resource. 307: # Returns: 308: # 309: # Note: 310: # The token is an array that contains the following elements: 311: # [0] => 'S' indicating this is a start token 312: # [1] => 'resource' indicating this tag is a <resource> tag. 313: # [2] => Hash of attribute =>value pairs. 314: # [3] => @(keys [2]). 315: # [4] => unused. 316: # 317: # The attributes of the resourcde tag include: 318: # 319: # id - The resource id. 320: # src - The URI of the resource. 321: # type - The resource type (e.g. start and finish). 322: # title - The resource title. 323: 324: 325: sub parse_resource { 326: my ($token,$lpc,$ispage,$uri) = @_; 327: 328: # I refuse to coutenance code like this that has 329: # such a dirty side effect (and forcing this sub to be called within a loop). 330: # 331: # if ($token->[2]->{'type'} eq 'zombie') { next; } 332: 333: # Zombie resources don't produce anything useful. 334: 335: if ($token->[2]->{'type'} eq 'zombie') { 336: return undef; 337: } 338: 339: my $rid=$lpc.'.'.$token->[2]->{'id'}; 340: 341: $hash{'kind_'.$rid}='res'; 342: $hash{'title_'.$rid}=$token->[2]->{'title'}; 343: my $turi=&versiontrack($token->[2]->{'src'}); 344: if ($token->[2]->{'version'}) { 345: unless ($hash{'version_'.$turi}) { 346: $hash{'version_'.$turi}=$1; 347: } 348: } 349: my $title=$token->[2]->{'title'}; 350: $title=~s/\&colon\;/\:/gs; 351: # my $symb=&Apache::lonnet::encode_symb($uri, 352: # $token->[2]->{'id'}, 353: # $turi); 354: # &Apache::lonnet::do_cache_new('title',$symb,$title); 355: unless ($ispage) { 356: $turi=~/\.(\w+)$/; 357: my $embstyle=&Apache::loncommon::fileembstyle($1); 358: if ($token->[2]->{'external'} eq 'true') { # external 359: $turi=~s/^https?\:\/\//\/adm\/wrapper\/ext\//; 360: } elsif ($turi=~/^\/*uploaded\//) { # uploaded 361: if (($embstyle eq 'img') 362: || ($embstyle eq 'emb') 363: || ($embstyle eq 'wrp')) { 364: $turi='/adm/wrapper'.$turi; 365: } elsif ($embstyle eq 'ssi') { 366: #do nothing with these 367: } elsif ($turi!~/\.(sequence|page)$/) { 368: $turi='/adm/coursedocs/showdoc'.$turi; 369: } 370: } elsif ($turi=~/\S/) { # normal non-empty internal resource 371: my $mapdir=$uri; 372: $mapdir=~s/[^\/]+$//; 373: $turi=&Apache::lonnet::hreflocation($mapdir,$turi); 374: if (($embstyle eq 'img') 375: || ($embstyle eq 'emb') 376: || ($embstyle eq 'wrp')) { 377: $turi='/adm/wrapper'.$turi; 378: } 379: } 380: } 381: # Store reverse lookup, remove query string 382: my $idsuri=$turi; 383: $idsuri=~s/\?.+$//; 384: if (defined($hash{'ids_'.$idsuri})) { 385: $hash{'ids_'.$idsuri}.=','.$rid; 386: } else { 387: $hash{'ids_'.$idsuri}=''.$rid; 388: } 389: 390: if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard|viewclasslist)$/) { 391: $turi.='?register=1'; 392: } 393: 394: $hash{'src_'.$rid}=$turi; 395: 396: if ($token->[2]->{'external'} eq 'true') { 397: $hash{'ext_'.$rid}='true:'; 398: } else { 399: $hash{'ext_'.$rid}='false:'; 400: } 401: if ($token->[2]->{'type'}) { 402: $hash{'type_'.$rid}=$token->[2]->{'type'}; 403: if ($token->[2]->{'type'} eq 'start') { 404: $hash{'map_start_'.$uri}="$rid"; 405: } 406: if ($token->[2]->{'type'} eq 'finish') { 407: $hash{'map_finish_'.$uri}="$rid"; 408: } 409: } else { 410: $hash{'type_'.$rid}='normal'; 411: } 412: 413: if (($turi=~/\.sequence$/) || 414: ($turi=~/\.page$/)) { 415: $hash{'is_map_'.$rid}=1; 416: &loadmap($turi,$rid); 417: } 418: return $token->[2]->{'id'}; 419: } 420: 421: sub make_link { 422: my ($linkpc,$lpc,$to,$from,$condition) = @_; 423: 424: my $linkid=$lpc.'.'.$linkpc; 425: my $goesto=$lpc.'.'.$to; 426: my $comesfrom=$lpc.'.'.$from; 427: my $undercond=0; 428: 429: if ($condition) { 430: $undercond=$lpc.'.'.$condition; 431: } 432: 433: $hash{'goesto_'.$linkid}=$goesto; 434: $hash{'comesfrom_'.$linkid}=$comesfrom; 435: $hash{'undercond_'.$linkid}=$undercond; 436: 437: if (defined($hash{'to_'.$comesfrom})) { 438: $hash{'to_'.$comesfrom}.=','.$linkid; 439: } else { 440: $hash{'to_'.$comesfrom}=''.$linkid; 441: } 442: if (defined($hash{'from_'.$goesto})) { 443: $hash{'from_'.$goesto}.=','.$linkid; 444: } else { 445: $hash{'from_'.$goesto}=''.$linkid; 446: } 447: } 448: 449: # ------------------------------------------------------------------- Condition 450: sub parse_condition { 451: my ($token,$lpc) = @_; 452: my $rid=$lpc.'.'.$token->[2]->{'id'}; 453: 454: $hash{'kind_'.$rid}='cond'; 455: 456: my $condition = $token->[2]->{'value'}; 457: $condition =~ s/[\n\r]+/ /gs; 458: push(@cond, $condition); 459: $hash{'condid_'.$rid}=$#cond; 460: if ($token->[2]->{'type'}) { 461: $cond[$#cond].=':'.$token->[2]->{'type'}; 462: } else { 463: $cond[$#cond].=':normal'; 464: } 465: } 466: 467: # ------------------------------------------------------------------- Parameter 468: # Parse a <parameter> tag in the map. 469: # Parmameters: 470: # $token Token array for a start tag from HTML::TokeParser 471: # [0] = 'S' 472: # [1] = tagname ("param") 473: # [2] = Hash of {attribute} = values. 474: # [3] = Array of the keys in [2]. 475: # [4] = unused. 476: # $lpc Current map nesting level.a 477: # 478: # Typical attributes: 479: # to=n - Number of the resource the parameter applies to. 480: # type=xx - Type of parameter value (e.g. string_yesno or int_pos). 481: # name=xxx - Name ofr parameter (e.g. parameter_randompick or parameter_randomorder). 482: # value=xxx - value of the parameter. 483: 484: sub parse_param { 485: my ($token,$lpc) = @_; 486: my $referid=$lpc.'.'.$token->[2]->{'to'}; # Resource param applies to. 487: my $name=$token->[2]->{'name'}; # Name of parameter 488: my $part; 489: 490: 491: if ($name=~/^parameter_(.*)_/) { 492: $part=$1; 493: } else { 494: $part=0; 495: } 496: 497: # Peel the parameter_ off the parameter name. 498: 499: $name=~s/^.*_([^_]*)$/$1/; 500: 501: # The value is: 502: # type.part.name.value 503: 504: my $newparam= 505: &escape($token->[2]->{'type'}).':'. 506: &escape($part.'.'.$name).'='. 507: &escape($token->[2]->{'value'}); 508: 509: # The hash key is param_resourceid. 510: # Multiple parameters for a single resource are & separated in the hash. 511: 512: 513: if (defined($hash{'param_'.$referid})) { 514: $hash{'param_'.$referid}.='&'.$newparam; 515: } else { 516: $hash{'param_'.$referid}=''.$newparam; 517: } 518: # 519: # These parameters have to do with randomly selecting 520: # resources, therefore a separate hash is also created to 521: # make it easy to locate them when actually computing the resource set later on 522: # See the code conditionalized by ($randomize) in loadmap(). 523: 524: if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) { # Random selection turned on 525: $randompick{$referid}=$token->[2]->{'value'}; 526: } 527: if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) { # Randomseed provided. 528: $randompickseed{$referid}=$token->[2]->{'value'}; 529: } 530: if ($token->[2]->{'name'}=~/^parameter_(0_)*randomorder$/) { # Random order turned on. 531: $randomorder{$referid}=$token->[2]->{'value'}; 532: } 533: 534: # These parameters have to do with how the URLs of resources are presented to 535: # course members(?). encrypturl presents encypted url's while 536: # hiddenresource hides the URL. 537: # 538: 539: if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) { 540: if ($token->[2]->{'value'}=~/^yes$/i) { 541: $encurl{$referid}=1; 542: } 543: } 544: if ($token->[2]->{'name'}=~/^parameter_(0_)*hiddenresource$/) { 545: if ($token->[2]->{'value'}=~/^yes$/i) { 546: $hiddenurl{$referid}=1; 547: } 548: } 549: } 550: 551: sub parse_mapalias_param { 552: my ($token,$lpc) = @_; 553: my $referid=$lpc.'.'.$token->[2]->{'to'}; 554: return if (!exists($hash{'src_'.$referid})); 555: 556: if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) { 557: &count_mapalias($token->[2]->{'value'},$referid); 558: $hash{'mapalias_'.$token->[2]->{'value'}}=$referid; 559: } 560: } 561: 562: # --------------------------------------------------------- Simplify expression 563: 564: sub simplify { 565: my $expression=shift; 566: # (0&1) = 1 567: $expression=~s/$0\&([_\.\d]+)$/$1/g; 568: # (8)=8 569: $expression=~s/$([_\.\d]+)$/$1/g; 570: # 8&8=8 571: $expression=~s/([^_\.\d])([_\.\d]+)\&\2([^_\.\d])/$1$2$3/g; 572: # 8|8=8 573: $expression=~s/([^_\.\d])([_\.\d]+)\|\2([^_\.\d])/$1$2$3/g; 574: # (5&3)&4=5&3&4 575: $expression=~s/$([_\.\d]+)((?:\&[_\.\d]+)+)$\&([_\.\d]+[^_\.\d])/$1$2\&$3/g; 576: # (((5&3)|(4&6)))=((5&3)|(4&6)) 577: $expression=~ 578: s/$(\(\([_\.\d]+(?:\&[_\.\d]+)*$(?:\|$[_\.\d]+(?:\&[_\.\d]+)*$)+\))\)/$1/g; 579: # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2) 580: $expression=~ 581: s/$(\([_\.\d]+(?:\&[_\.\d]+)*$)((?:\|$[_\.\d]+(?:\&[_\.\d]+)*$)+)\)\|($[_\.\d]+(?:\&[_\.\d]+)*$)/$$1$2\|$3$/g; 582: return $expression; 583: } 584: 585: # -------------------------------------------------------- Build condition hash 586: 587: sub traceroute { 588: my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_; 589: my $newsofar=$sofar=simplify($sofar); 590: unless ($beenhere=~/\&\Q$rid\E\&/) { 591: $beenhere.=$rid.'&'; 592: my ($mapid,$resid)=split(/\./,$rid); 593: my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid}); 594: my $hidden=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb); 595: 596: if ($hdnflag || lc($hidden) eq 'yes') { 597: $hiddenurl{$rid}=1; 598: } 599: if (!$hdnflag && lc($hidden) eq 'no') { 600: delete($hiddenurl{$rid}); 601: } 602: 603: my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb); 604: if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; } 605: if (($retfrid eq '') && ($hash{'src_'.$rid}) 606: && ($hash{'src_'.$rid}!~/\.sequence$/)) { 607: $retfrid=$rid; 608: } 609: if (defined($hash{'conditions_'.$rid})) { 610: $hash{'conditions_'.$rid}=simplify( 611: '('.$hash{'conditions_'.$rid}.')|('.$sofar.')'); 612: } else { 613: $hash{'conditions_'.$rid}=$sofar; 614: } 615: 616: # if the expression is just the 0th condition keep it 617: # otherwise leave a pointer to this condition expression 618: $newsofar = ($sofar eq '0') ? $sofar : '_'.$rid; 619: 620: if (defined($hash{'is_map_'.$rid})) { 621: if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) { 622: $sofar=$newsofar= 623: &traceroute($sofar, 624: $hash{'map_start_'.$hash{'src_'.$rid}}, 625: $beenhere, 626: $encflag || $encurl{$rid}, 627: $hdnflag || $hiddenurl{$rid}); 628: } 629: } 630: if (defined($hash{'to_'.$rid})) { 631: foreach my $id (split(/\,/,$hash{'to_'.$rid})) { 632: my $further=$sofar; 633: if ($hash{'undercond_'.$id}) { 634: if (defined($hash{'condid_'.$hash{'undercond_'.$id}})) { 635: $further=simplify('('.'_'.$rid.')&('. 636: $hash{'condid_'.$hash{'undercond_'.$id}}.')'); 637: } else { 638: $errtext.=&mt(' Undefined condition ID: [_1]',$hash{'undercond_'.$id}); 639: } 640: } 641: $newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere, 642: $encflag,$hdnflag); 643: } 644: } 645: } 646: return $newsofar; 647: } 648: 649: # ------------------------------ Cascading conditions, quick access, parameters 650: 651: sub accinit { 652: my ($uri,$short,$fn)=@_; 653: my %acchash=(); 654: my %captured=(); 655: my $condcounter=0; 656: $acchash{'acc.cond.'.$short.'.0'}=0; 657: foreach my $key (keys(%hash)) { 658: if ($key=~/^conditions/) { 659: my $expr=$hash{$key}; 660: # try to find and factor out common sub-expressions 661: foreach my $sub ($expr=~m/($\([_\.\d]+(?:\&[_\.\d]+)+$(?:\|$[_\.\d]+(?:\&[_\.\d]+)+$)+\))/g) { 662: my $orig=$sub; 663: 664: my ($factor) = ($sub=~/$\(([_\.\d]+\&(:?[_\.\d]+\&)*)(?:[_\.\d]+\&*)+$(?:\|$\1(?:[_\.\d]+\&*)+$)+\)/); 665: next if (!defined($factor)); 666: 667: $sub=~s/\Q$factor\E//g; 668: $sub=~s/^\(/\($factor\(/; 669: $sub.=')'; 670: $sub=simplify($sub); 671: $expr=~s/\Q$orig\E/$sub/; 672: } 673: $hash{$key}=$expr; 674: unless (defined($captured{$expr})) { 675: $condcounter++; 676: $captured{$expr}=$condcounter; 677: $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr; 678: } 679: } elsif ($key=~/^param_(\d+)\.(\d+)/) { 680: my $prefix=&Apache::lonnet::encode_symb($hash{'map_id_'.$1},$2, 681: $hash{'src_'.$1.'.'.$2}); 682: foreach my $param (split(/\&/,$hash{$key})) { 683: my ($typename,$value)=split(/\=/,$param); 684: my ($type,$name)=split(/\:/,$typename); 685: $parmhash{$prefix.'.'.&unescape($name)}= 686: &unescape($value); 687: $parmhash{$prefix.'.'.&unescape($name).'.type'}= 688: &unescape($type); 689: } 690: } 691: } 692: foreach my $key (keys(%hash)) { 693: if ($key=~/^ids/) { 694: foreach my $resid (split(/\,/,$hash{$key})) { 695: my $uri=$hash{'src_'.$resid}; 696: my ($uripath,$urifile) = 697: &Apache::lonnet::split_uri_for_cond($uri); 698: if ($uripath) { 699: my $uricond='0'; 700: if (defined($hash{'conditions_'.$resid})) { 701: $uricond=$captured{$hash{'conditions_'.$resid}}; 702: } 703: if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) { 704: if ($acchash{'acc.res.'.$short.'.'.$uripath}=~ 705: /(\&\Q$urifile\E\:[^\&]*)/) { 706: my $replace=$1; 707: my $regexp=$replace; 708: #$regexp=~s/\|/\\\|/g; 709: $acchash{'acc.res.'.$short.'.'.$uripath} =~ 710: s/\Q$regexp\E/$replace\|$uricond/; 711: } else { 712: $acchash{'acc.res.'.$short.'.'.$uripath}.= 713: $urifile.':'.$uricond.'&'; 714: } 715: } else { 716: $acchash{'acc.res.'.$short.'.'.$uripath}= 717: '&'.$urifile.':'.$uricond.'&'; 718: } 719: } 720: } 721: } 722: } 723: $acchash{'acc.res.'.$short.'.'}='&:0&'; 724: my $courseuri=$uri; 725: $courseuri=~s/^\/res\///; 726: my $regexp = 1; 727: &Apache::lonnet::delenv('(acc\.|httpref\.)',$regexp); 728: &Apache::lonnet::appenv(\%acchash); 729: } 730: 731: # ---------------- Selectively delete from randompick maps and hidden url parms 732: 733: sub hiddenurls { 734: my $randomoutentry=''; 735: foreach my $rid (keys %randompick) { 736: my $rndpick=$randompick{$rid}; 737: my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}}; 738: # ------------------------------------------- put existing resources into array 739: my @currentrids=(); 740: foreach my $key (sort(keys(%hash))) { 741: if ($key=~/^src_($mpc\.\d+)/) { 742: if ($hash{'src_'.$1}) { push @currentrids, $1; } 743: } 744: } 745: # rids are number.number and we want to numercially sort on 746: # the second number 747: @currentrids=sort { 748: my (undef,$aid)=split(/\./,$a); 749: my (undef,$bid)=split(/\./,$b); 750: $aid <=> $bid; 751: } @currentrids; 752: next if ($#currentrids<$rndpick); 753: # -------------------------------- randomly eliminate the ones that should stay 754: my (undef,$id)=split(/\./,$rid); 755: if ($randompickseed{$rid}) { $id=$randompickseed{$rid}; } 756: my $rndseed=&Apache::lonnet::rndseed($id); # use id instead of symb 757: &Apache::lonnet::setup_random_from_rndseed($rndseed); 758: my @whichids=&Math::Random::random_permuted_index($#currentrids+1); 759: for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; } 760: #&Apache::lonnet::logthis("$id,$rndseed,".join(':',@whichids)); 761: # -------------------------------------------------------- delete the leftovers 762: for (my $k=0; $k<=$#currentrids; $k++) { 763: if ($currentrids[$k]) { 764: $hash{'randomout_'.$currentrids[$k]}=1; 765: my ($mapid,$resid)=split(/\./,$currentrids[$k]); 766: $randomoutentry.='&'. 767: &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid}, 768: $resid, 769: $hash{'src_'.$currentrids[$k]} 770: ).'&'; 771: } 772: } 773: } 774: # ------------------------------ take care of explicitly hidden urls or folders 775: foreach my $rid (keys %hiddenurl) { 776: $hash{'randomout_'.$rid}=1; 777: my ($mapid,$resid)=split(/\./,$rid); 778: $randomoutentry.='&'. 779: &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid, 780: $hash{'src_'.$rid}).'&'; 781: } 782: # --------------------------------------- append randomout entry to environment 783: if ($randomoutentry) { 784: &Apache::lonnet::appenv({'acc.randomout' => $randomoutentry}); 785: } 786: } 787: 788: # ---------------------------------------------------- Read map and all submaps 789: 790: sub readmap { 791: my $short=shift; 792: $short=~s/^\///; 793: 794: # TODO: Hidden dependency on current user: 795: 796: my %cenv=&Apache::lonnet::coursedescription($short,{'freshen_cache'=>1}); 797: 798: my $fn=$cenv{'fn'}; 799: my $uri; 800: $short=~s/\//\_/g; 801: unless ($uri=$cenv{'url'}) { 802: &Apache::lonnet::logthis('WARNING: '. 803: "Could not load course $short."); 804: return ('',&mt('No course data available.'));; 805: } 806: @cond=('true:normal'); 807: 808: unless (open(LOCKFILE,">$fn.db.lock")) { 809: # 810: # Most likely a permissions problem on the lockfile or its directory. 811: # 812: $errtext.=' '.&mt('Map not loaded - Lock file could not be opened when reading map:').' <tt>'.$fn.'</tt>.'; 813: $retfurl = ''; 814: return ($retfurl,$errtext); 815: } 816: my $lock=0; 817: my $gotstate=0; 818: 819: # If we can get the lock without delay any files there are idle 820: # and from some prior request. We'll kill them off and regenerate them: 821: 822: if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) { 823: $lock=1; # Remember that we hold the lock. 824: &unlink_tmpfiles($fn); 825: } 826: undef %randompick; 827: undef %hiddenurl; 828: undef %encurl; 829: $retfrid=''; 830: my ($untiedhash,$untiedparmhash,$tiedhash,$tiedparmhash); # More state flags. 831: 832: # if we got the lock, regenerate course regnerate empty files and tie them. 833: 834: if ($lock) { 835: if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) { 836: $tiedhash = 1; 837: if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640)) { 838: $tiedparmhash = 1; 839: $gotstate = &build_tmp_hashes($uri, 840: $fn, 841: $short, 842: \%cenv); # TODO: Need to provide requested user@dom 843: unless ($gotstate) { 844: &Apache::lonnet::logthis('Failed to write statemap at first attempt '.$fn.' for '.$uri.'.'); 845: } 846: $untiedparmhash = untie(%parmhash); 847: unless ($untiedparmhash) { 848: &Apache::lonnet::logthis('WARNING: '. 849: 'Could not untie coursemap parmhash '.$fn.' for '.$uri.'.'); 850: } 851: } 852: $untiedhash = untie(%hash); 853: unless ($untiedhash) { 854: &Apache::lonnet::logthis('WARNING: '. 855: 'Could not untie coursemap hash '.$fn.' for '.$uri.'.'); 856: } 857: } 858: flock(LOCKFILE,LOCK_UN); # RF: this is what I don't get unless there are other 859: # unlocked places the remainder happens..seems like if we 860: # just kept the lock here the rest of the code would have 861: # been much easier? 862: } 863: unless ($lock && $tiedhash && $tiedparmhash) { 864: # if we are here it is likely because we are already trying to 865: # initialize the course in another child, busy wait trying to 866: # tie the hashes for the next 90 seconds, if we succeed forward 867: # them on to navmaps, if we fail, throw up the Could not init 868: # course screen 869: # 870: # RF: I'm not seeing the case where the ties/unties can fail in a way 871: # that can be remedied by this. Since we owned the lock seems 872: # Tie/untie failures are a result of something like a permissions problem instead? 873: # 874: 875: # In any vent, undo what we did manage to do above first: 876: if ($lock) { 877: # Got the lock but not the DB files 878: flock(LOCKFILE,LOCK_UN); 879: $lock = 0; 880: } 881: if ($tiedhash) { 882: unless($untiedhash) { 883: untie(%hash); 884: } 885: } 886: if ($tiedparmhash) { 887: unless($untiedparmhash) { 888: untie(%parmhash); 889: } 890: } 891: # Log our failure: 892: 893: &Apache::lonnet::logthis('WARNING: '. 894: "Could not tie coursemap $fn for $uri."); 895: $tiedhash = ''; 896: $tiedparmhash = ''; 897: my $i=0; 898: 899: # Keep on retrying the lock for 90 sec until we succeed. 900: 901: while($i<90) { 902: $i++; 903: sleep(1); 904: if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) { 905: 906: # Got the lock, tie the hashes...the assumption in this code is 907: # that some other worker thread has created the db files quite recently 908: # so no load is needed: 909: 910: $lock = 1; 911: if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) { 912: $tiedhash = 1; 913: if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) { 914: $tiedparmhash = 1; 915: if (-e "$fn.state") { 916: $retfurl='/adm/navmaps'; 917: 918: # BUG BUG: Side effect! 919: # Should conditionalize on something so that we can use this 920: # to load maps for courses that are not current? 921: # 922: &Apache::lonnet::appenv({"request.course.id" => $short, 923: "request.course.fn" => $fn, 924: "request.course.uri" => $uri}); 925: $untiedhash = untie(%hash); 926: $untiedparmhash = untie(%parmhash); 927: $gotstate = 1; 928: last; 929: } 930: $untiedparmhash = untie(%parmhash); 931: } 932: $untiedhash = untie(%hash); 933: } 934: } 935: } 936: if ($lock) { 937: flock(LOCKFILE,LOCK_UN); 938: $lock = 0; 939: if ($tiedparmhash) { 940: unless ($untiedparmhash) { 941: &Apache::lonnet::logthis('WARNING: '. 942: 'Could not untie coursemap parmhash '.$fn.' for '.$uri.'.'); 943: } 944: } 945: if ($tiedparmhash) { 946: unless ($untiedhash) { 947: &Apache::lonnet::logthis('WARNING: '. 948: 'Could not untie coursemap hash '.$fn.' for '.$uri.'.'); 949: } 950: } 951: } 952: } 953: # I think this branch of code is all about what happens if we just did the stuff above, 954: # but found that the state file did not exist...again if we'd just held the lock 955: # would that have made this logic simpler..as generating all the files would be 956: # an atomic operation with respect to the lock. 957: # 958: unless ($gotstate) { 959: $lock = 0; 960: &Apache::lonnet::logthis('WARNING: '. 961: 'Could not read statemap '.$fn.' for '.$uri.'.'); 962: &unlink_tmpfiles($fn); 963: if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) { 964: $lock=1; 965: } 966: undef %randompick; 967: undef %hiddenurl; 968: undef %encurl; 969: $retfrid=''; 970: # 971: # Once more through the routine of tying and loading and so on. 972: # 973: if ($lock) { 974: if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) { 975: if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640)) { 976: $gotstate = &build_tmp_hashes($uri,$fn,$short,\%cenv); # TODO: User dependent? 977: unless ($gotstate) { 978: &Apache::lonnet::logthis('WARNING: '. 979: 'Failed to write statemap at second attempt '.$fn.' for '.$uri.'.'); 980: } 981: unless (untie(%parmhash)) { 982: &Apache::lonnet::logthis('WARNING: '. 983: 'Could not untie coursemap parmhash '.$fn.'.db for '.$uri.'.'); 984: } 985: } else { 986: &Apache::lonnet::logthis('WARNING: '. 987: 'Could not tie coursemap '.$fn.'__parms.db for '.$uri.'.'); 988: } 989: unless (untie(%hash)) { 990: &Apache::lonnet::logthis('WARNING: '. 991: 'Could not untie coursemap hash '.$fn.'.db for '.$uri.'.'); 992: } 993: } else { 994: &Apache::lonnet::logthis('WARNING: '. 995: 'Could not tie coursemap '.$fn.'.db for '.$uri.'.'); 996: } 997: flock(LOCKFILE,LOCK_UN); 998: $lock = 0; 999: } else { 1000: # Failed to get the immediate lock. 1001: 1002: &Apache::lonnet::logthis('WARNING: '. 1003: 'Could not obtain lock to tie coursemap hash '.$fn.'.db for '.$uri.'.'); 1004: } 1005: } 1006: close(LOCKFILE); 1007: unless (($errtext eq '') || ($env{'request.course.uri'} =~ m{^/uploaded/})) { 1008: &Apache::lonmsg::author_res_msg($env{'request.course.uri'}, 1009: $errtext); # TODO: User dependent? 1010: } 1011: # ------------------------------------------------- Check for critical messages 1012: 1013: # Depends on user must parameterize this as well..or separate as this is: 1014: # more part of determining what someone sees on entering a course? 1015: 1016: my @what=&Apache::lonnet::dump('critical',$env{'user.domain'}, 1017: $env{'user.name'}); 1018: if ($what[0]) { 1019: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) { 1020: $retfurl='/adm/email?critical=display'; 1021: } 1022: } 1023: return ($retfurl,$errtext); 1024: } 1025: 1026: # 1027: # This sub is called when the course hash and the param hash have been tied and 1028: # their lock file is held. 1029: # Parameters: 1030: # $uri - URI that identifies the course. 1031: # $fn - The base path/filename of the files that make up the context 1032: # being built. 1033: # $short - Short course name. 1034: # $cenvref - Reference to the course environment hash returned by 1035: # Apache::lonnet::coursedescription 1036: # 1037: # Assumptions: 1038: # The globals 1039: # %hash, %paramhash are tied to their gdbm files and we hold the lock on them. 1040: # 1041: sub build_tmp_hashes { 1042: my ($uri,$fn,$short,$cenvref) = @_; 1043: 1044: unless(ref($cenvref) eq 'HASH') { 1045: return; 1046: } 1047: my %cenv = %{$cenvref}; 1048: my $gotstate = 0; 1049: %hash=(); # empty the global course and parameter hashes. 1050: %parmhash=(); 1051: $errtext=''; # No error messages yet. 1052: $pc=0; 1053: &clear_mapalias_count(); 1054: &processversionfile(%cenv); 1055: my $furi=&Apache::lonnet::clutter($uri); 1056: # 1057: # the map staring points. 1058: # 1059: $hash{'src_0.0'}=&versiontrack($furi); 1060: $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title'); 1061: $hash{'ids_'.$furi}='0.0'; 1062: $hash{'is_map_0.0'}=1; 1063: &loadmap($uri,'0.0'); 1064: if (defined($hash{'map_start_'.$uri})) { 1065: &Apache::lonnet::appenv({"request.course.id" => $short, 1066: "request.course.fn" => $fn, 1067: "request.course.uri" => $uri}); 1068: $env{'request.course.id'}=$short; 1069: &traceroute('0',$hash{'map_start_'.$uri},'&'); 1070: &accinit($uri,$short,$fn); 1071: &hiddenurls(); 1072: } 1073: $errtext .= &get_mapalias_errors(); 1074: # ------------------------------------------------------- Put versions into src 1075: foreach my $key (keys(%hash)) { 1076: if ($key=~/^src_/) { 1077: $hash{$key}=&putinversion($hash{$key}); 1078: } elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) { 1079: my ($type, $url) = ($1,$2); 1080: my $value = $hash{$key}; 1081: $hash{$type.&putinversion($url)}=$value; 1082: } 1083: } 1084: # ---------------------------------------------------------------- Encrypt URLs 1085: foreach my $id (keys(%encurl)) { 1086: # $hash{'src_'.$id}=&Apache::lonenc::encrypted($hash{'src_'.$id}); 1087: $hash{'encrypted_'.$id}=1; 1088: } 1089: # ----------------------------------------------- Close hashes to finally store 1090: # --------------------------------- Routine must pass this point, no early outs 1091: $hash{'first_rid'}=$retfrid; 1092: my ($mapid,$resid)=split(/\./,$retfrid); 1093: $hash{'first_mapurl'}=$hash{'map_id_'.$mapid}; 1094: my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$retfrid}); 1095: $retfurl=&add_get_param($hash{'src_'.$retfrid},{ 'symb' => $symb }); 1096: if ($hash{'encrypted_'.$retfrid}) { 1097: $retfurl=&Apache::lonenc::encrypted($retfurl,(&Apache::lonnet::allowed('adv') ne 'F')); 1098: } 1099: $hash{'first_url'}=$retfurl; 1100: # ---------------------------------------------------- Store away initial state 1101: { 1102: my $cfh; 1103: if (open($cfh,">$fn.state")) { 1104: print $cfh join("\n",@cond); 1105: $gotstate = 1; 1106: } else { 1107: &Apache::lonnet::logthis("WARNING: ". 1108: "Could not write statemap $fn for $uri."); 1109: } 1110: } 1111: return $gotstate; 1112: } 1113: 1114: sub unlink_tmpfiles { 1115: my ($fn) = @_; 1116: my $file_dir = dirname($fn); 1117: 1118: if ($fn eq LONCAPA::tempdir()) { 1119: my @files = qw (.db _symb.db .state _parms.db); 1120: foreach my $file (@files) { 1121: if (-e $fn.$file) { 1122: unless (unlink($fn.$file)) { 1123: &Apache::lonnet::logthis("WARNING: ". 1124: "Could not unlink ".$fn.$file.""); 1125: } 1126: } 1127: } 1128: } 1129: return; 1130: } 1131: 1132: # ------------------------------------------------------- Evaluate state string 1133: 1134: sub evalstate { 1135: my $fn=$env{'request.course.fn'}.'.state'; 1136: my $state=''; 1137: if (-e $fn) { 1138: my @conditions=(); 1139: { 1140: open(my $fh,"<$fn"); 1141: @conditions=<$fh>; 1142: close($fh); 1143: } 1144: my $safeeval = new Safe; 1145: my $safehole = new Safe::Hole; 1146: $safeeval->permit("entereval"); 1147: $safeeval->permit(":base_math"); 1148: $safeeval->deny(":base_io"); 1149: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); 1150: foreach my $line (@conditions) { 1151: chomp($line); 1152: my ($condition,$weight)=split(/\:/,$line); 1153: if ($safeeval->reval($condition)) { 1154: if ($weight eq 'force') { 1155: $state.='3'; 1156: } else { 1157: $state.='2'; 1158: } 1159: } else { 1160: if ($weight eq 'stop') { 1161: $state.='0'; 1162: } else { 1163: $state.='1'; 1164: } 1165: } 1166: } 1167: } 1168: &Apache::lonnet::appenv({'user.state.'.$env{'request.course.id'} => $state}); 1169: return $state; 1170: } 1171: 1172: # This block seems to have code to manage/detect doubly defined 1173: # aliases in maps. 1174: 1175: { 1176: my %mapalias_cache; 1177: sub count_mapalias { 1178: my ($value,$resid) = @_; 1179: push(@{ $mapalias_cache{$value} }, $resid); 1180: } 1181: 1182: sub get_mapalias_errors { 1183: my $error_text; 1184: foreach my $mapalias (sort(keys(%mapalias_cache))) { 1185: next if (scalar(@{ $mapalias_cache{$mapalias} } ) == 1); 1186: my $count; 1187: my $which = 1188: join('</li><li>', 1189: map { 1190: my $id = $_; 1191: if (exists($hash{'src_'.$id})) { 1192: $count++; 1193: } 1194: my ($mapid) = split(/\./,$id); 1195: &mt('Resource "[_1]" in Map "[_2]"', 1196: $hash{'title_'.$id}, 1197: $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}}); 1198: } (@{ $mapalias_cache{$mapalias} })); 1199: next if ($count < 2); 1200: $error_text .= '<div class="LC_error">'. 1201: &mt('Error: Found the mapalias "[_1]" defined multiple times.', 1202: $mapalias). 1203: '</div><ul><li>'.$which.'</li></ul>'; 1204: } 1205: &clear_mapalias_count(); 1206: return $error_text; 1207: } 1208: sub clear_mapalias_count { 1209: undef(%mapalias_cache); 1210: } 1211: } 1212: 1; 1213: __END__ 1214: 1215: =head1 NAME 1216: 1217: Apache::lonuserstate - Construct and maintain state and binary representation 1218: of course for user 1219: 1220: =head1 SYNOPSIS 1221: 1222: Invoked by lonroles.pm. 1223: 1224: &Apache::lonuserstate::readmap($cdom.'/'.$cnum); 1225: 1226: =head1 INTRODUCTION 1227: 1228: This module constructs and maintains state and binary representation 1229: of course for user. 1230: 1231: This is part of the LearningOnline Network with CAPA project 1232: described at http://www.lon-capa.org. 1233: 1234: =head1 SUBROUTINES 1235: 1236: =over 1237: 1238: =item loadmap() 1239: 1240: Loads map from disk 1241: 1242: =item simplify() 1243: 1244: Simplify expression 1245: 1246: =item traceroute() 1247: 1248: Build condition hash 1249: 1250: =item accinit() 1251: 1252: Cascading conditions, quick access, parameters 1253: 1254: =item readmap() 1255: 1256: Read map and all submaps 1257: 1258: =item evalstate() 1259: 1260: Evaluate state string 1261: 1262: =back 1263: 1264: =cut