loncom/lonmap.pm - view

File: [LON-CAPA] / loncom / lonmap.pm
Revision 1.11: download - view: text, annotated - select for diffs
Thu May 30 05:04:16 2013 UTC (10 years, 11 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- When users with pav and vgr priv (e.g., Course Coordinators)  print a
  folder of resources for anonymous CODE(s) or for named student(s), e.g.,
  for a bubblesheet exam, parameter in map for hiddenresource will be
  ignored when retrieving resources for folder in random order.
- Supports use case where CC sets hidden for exam folder while printing
  bubblesheet exam, and also while grading exam.

1: # The LearningOnline Network 2: # 3: # Read maps into a 'big hash'. 4: # 5: # $Id: lonmap.pm,v 1.11 2013/05/30 05:04:16 raeburn Exp $ 6: # 7: # Copyright Michigan State University Board of Trustees 8: # 9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 10: # 11: # LON-CAPA is free software; you can redistribute it and/or modify 12: # it under the terms of the GNU General Public License as published by 13: # the Free Software Foundation; either version 2 of the License, or 14: # (at your option) any later version. 15: # 16: # LON-CAPA is distributed in the hope that it will be useful, 17: # but WITHOUT ANY WARRANTY; without even the implied warranty of 18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19: # GNU General Public License for more details. 20: # 21: # You should have received a copy of the GNU General Public License 22: # along with LON-CAPA; if not, write to the Free Software 23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 24: # 25: # /home/httpd/html/adm/gpl.txt 26: # 27: # http://www.lon-capa.org/ 28: # 29: ### 30: 31: package Apache::lonmap; 32: use strict; 33: 34: #------------- Required external modules. 35: 36: use Error qw(:try); 37: 38: use HTML::TokeParser; 39: 40: 41: use LONCAPA; 42: use Apache::lonnet; 43: use Apache::lonlocal; 44: 45: use Data::Dumper; 46: 47: 48: #------------- File scoped variables: 49: 50: my $map_number = 0; # keep track of maps within the course. 51: my $course_id; # Will be the id of the course being read in. 52: 53: # 54: # The variables below are auxiliary hashes. They will be tacked onto the 55: # big hash though currently not used by clients.. you never know about later. 56: # 57: 58: my %randompick; 59: my %randompickseed; 60: my %randomorder; 61: my %encurl; 62: my %hiddenurl; 63: my %parmhash; 64: my @cond; # Array of conditions. 65: my $retfrid; 66: # 67: # Other stuff we make global (sigh) so that it does not need 68: # to be passed around all the time: 69: # 70: 71: my $username; # User for whom the map is being read. 72: my $userdomain; # Domain the user lives in. 73: my $short_name; # Course shortname. 74: my %mapalias_cache; # Keeps track of map aliases -> resources detects duplicates. 75: my %cenv; # Course environment. 76: 77: #------------- Executable code: 78: 79: 80: #---------------------------------------------------------------- 81: # 82: # General utilities: 83: 84: 85: # 86: # I _think_ this does common sub-expression simplification and 87: # optimization for condition strings...based on common pattern matching. 88: # Parameters: 89: # expression - the condition expression string. 90: # Returns: 91: # The optimized expression if an optimization could be found. 92: # 93: # NOTE: 94: # Added repetetive optimization..it's possible that an 95: # optimization results in an expression that can be recognized further in 96: # a subsequent optimization pass: 97: # 98: 99: sub simplify { 100: my $expression=shift; 101: 102: # (0&1) = 1 103: $expression=~s/$0\&([_\.\d]+)$/$1/g; 104: # (8)=8 105: $expression=~s/$([_\.\d]+)$/$1/g; 106: # 8&8=8 107: $expression=~s/([^_\.\d])([_\.\d]+)\&\2([^_\.\d])/$1$2$3/g; 108: # 8|8=8 109: $expression=~s/([^_\.\d])([_\.\d]+)(?:\|\2)+([^_\.\d])/$1$2$3/g; 110: # (5&3)&4=5&3&4 111: $expression=~s/$([_\.\d]+)((?:\&[_\.\d]+)+)$\&([_\.\d]+[^_\.\d])/$1$2\&$3/g; 112: # (((5&3)|(4&6)))=((5&3)|(4&6)) 113: $expression=~ 114: s/$(\(\([_\.\d]+(?:\&[_\.\d]+)*$(?:\|$[_\.\d]+(?:\&[_\.\d]+)*$)+\))\)/$1/g; 115: # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2) 116: $expression=~ 117: s/$(\([_\.\d]+(?:\&[_\.\d]+)*$)((?:\|$[_\.\d]+(?:\&[_\.\d]+)*$)+)\)\|($[_\.\d]+(?:\&[_\.\d]+)*$)/$$1$2\|$3$/g; 118: 119: 120: return $expression; 121: } 122: 123: 124: # 125: # Merge the conditions into the big hash 126: # these will result in hash entries of the form: 127: # 'condition.n' where 'n' is the array index of the condition in the 128: # @cond array above. 129: # 130: # Parameters: 131: # $hash - big hashthat's being built up. 132: # 133: sub merge_conditions { 134: my $hash = shift; 135: 136: for (my $i = 0; $i < scalar(@cond); $i++) { 137: $hash->{'condition' . '.' . $i} = $cond[$i]; 138: } 139: } 140: 141: # Merge the contents of a 'child hash' into a parent hash hanging it off another key. 142: # This is _not_ done by hanging a reference to the child hash as the parent may be 143: # bound to a GDBM file e.g. and shared by more than one process ..and references are 144: # pretty clearly not going to work across process boundaries. 145: # 146: # Parameters: 147: # $parent - The hash to which the child will be merged (reference) 148: # $key - The key in the parent hash on which the child elements will be hung. 149: # given a key named $childkey the final parent hash entry will be 150: # $parent . '.' $childkey 151: # $child - The hash whose contents we merge into the parent (reference) 152: # 153: sub merge_hash { 154: my ($parent, $key, $child) = @_; 155: 156: if ($key ne '') { 157: $key .= '.'; # If we are prefixing, prefix then . 158: } 159: 160: foreach my $childkey (keys (%$child)) { 161: $parent->{$key . $childkey} = $child->{$childkey}; 162: } 163: } 164: 165: #---------------------------------------------------------------------------------- 166: # 167: # Code to keep track of map aliases and to determine if there are doubly 168: # defined aliases. 169: # 170: 171: # 172: # Maintains the mapalias hash. This is a hash of arrays. Each array 173: # is indexed by the alias and contains the set of resource ids pointed to by that 174: # alias. In an ideal world, there will only be one element in each array. 175: # The point of this, however is to determine which aliases might be doubley defined 176: # due to map nesting e.g. 177: # 178: # Parameters: 179: # $value - Alias name. 180: # $resid - Resource id pointed to by the alias. 181: # 182: # 183: sub count_mapalias { 184: my ($value,$resid) = @_; 185: push(@{ $mapalias_cache{$value} }, $resid); 186: } 187: # 188: # Looks at each key in the mapalias hash and, for each case where an 189: # alias points to more than one value adds an error text to the 190: # result string.' 191: # 192: # Parameters: 193: # hash - Reference to the hash we are trying t build up. 194: # Implicit inputs 195: # %mapalias - a hash that is indexed by map aliases and contains for each key 196: # an array of the resource id's the alias 'points to'. 197: # Returns: 198: # A hopefully empty string of messages that descsribe the aliases that have more 199: # than one value. This string is formatted like an html list. 200: # 201: # 202: sub get_mapalias_errors { 203: my $hash = shift; 204: my $error_text; 205: foreach my $mapalias (sort(keys(%mapalias_cache))) { 206: next if (scalar(@{ $mapalias_cache{$mapalias} } ) == 1); 207: my $count; 208: my $which = 209: join('</li><li>', 210: map { 211: my $id = $_; 212: if (exists($hash->{'src_'.$id})) { 213: $count++; 214: } 215: my ($mapid) = split(/\./,$id); 216: &mt('Resource "[_1]" <br /> in Map "[_2]"', 217: $hash->{'title_'.$id}, 218: $hash->{'title_'.$hash->{'ids_'.$hash->{'map_id_'.$mapid}}}); 219: } (@{ $mapalias_cache{$mapalias} })); 220: next if ($count < 2); 221: $error_text .= '<div class="LC_error">'. 222: &mt('Error: Found the mapalias "[_1]" defined multiple times.', 223: $mapalias). 224: '</div><ul><li>'.$which.'</li></ul>'; 225: } 226: &clear_mapalias_count(); 227: return $error_text; 228: } 229: # 230: # Clears the map aliase hash. 231: # 232: sub clear_mapalias_count { 233: undef(%mapalias_cache); 234: } 235: 236: #---------------------------------------------------------------- 237: # 238: # Code dealing with resource versions. 239: # 240: 241: # 242: # Put a version into a src element of a hash or url: 243: # 244: # Parameters: 245: # uri - URI into which the version must be added. 246: # hash - Reference to the hash being built up. 247: # short- Short coursename. 248: # 249: 250: sub putinversion { 251: my ($uri, $hash, $short) = @_; 252: my $key=$short.'_'.&Apache::lonnet::clutter($uri); 253: if ($hash->{'version_'.$uri}) { 254: my $version=$hash->{'version_'.$uri}; 255: if ($version eq 'mostrecent') { return $uri; } 256: if ($version eq &Apache::lonnet::getversion( 257: &Apache::lonnet::filelocation('',$uri))) 258: { return $uri; } 259: $uri=~s/\.(\w+)$/\.$version\.$1/; 260: } 261: &Apache::lonnet::do_cache_new('courseresversion',$key,&Apache::lonnet::declutter($uri),600); 262: return $uri; 263: } 264: 265: 266: # 267: # Create hash entries for each version of the course. 268: # Parameters: 269: # $cenv - Reference to a course environment from lonnet::coursedescription. 270: # $hash - Reference to a hash that will be populated. 271: 272: # 273: sub process_versions { 274: my ($cenv, $hash) = @_; 275: 276: 277: my %versions = &Apache::lonnet::dump('resourceversions', 278: $cenv->{'domain'}, 279: $cenv->{'num'}); 280: 281: foreach my $ver (keys (%versions)) { 282: if ($ver =~/^error\:/) { # lonc/lond transaction failed. 283: throw Error::Simple('lonc/lond returned error: ' . $ver); 284: } 285: $hash->{'version_'.$ver} = $versions{$ver}; 286: } 287: } 288: 289: # 290: # Generate text for a version discrepancy error: 291: # Parameters: 292: # $uri - URI of the resource. 293: # $used - Version used. 294: # $unused - Veresion of duplicate. 295: # 296: sub versionerror { 297: my ($uri, $used, $unused) = @_; 298: return '<br />'. 299: &mt('Version discrepancy: resource [_1] included in both version [_2] and version [_3]. Using version [_2].', 300: $uri,$used,$unused).'<br />'; 301: 302: } 303: 304: # Removes the version number from a URI and returns the resulting 305: # URI (e.g. mumbly.version.stuff => mumbly.stuff). 306: # 307: # If the URI has not been seen with a version before the 308: # hash{'version_'.resultingURI} is set to the version number. 309: # If the hash has already been seen, but differs then 310: # an error is raised. 311: # 312: # Parameters: 313: # $uri - potentially with a version. 314: # $hash - reference to a hash to fill in. 315: # Returns: 316: # URI with the version cut out. 317: # 318: sub versiontrack { 319: my ($uri, $hash) = @_; 320: 321: 322: if ($uri=~/\.(\d+)\.\w+$/) { # URI like *.n.text it's version 'n' 323: my $version=$1; 324: $uri=~s/\.\d+\.(\w+)$/\.$1/; # elide the version. 325: unless ($hash->{'version_'.$uri}) { 326: $hash->{'version_'.$uri}=$version; 327: } elsif ($version!=$hash->{'version_'.$uri}) { 328: throw Error::Simple(&versionerror($uri, $hash->{'version_'.$uri}, $version)); 329: } 330: } 331: return $uri; 332: } 333: # 334: # Appends the version of a resource to its uri and also caches the 335: # URI (contents?) on the local server 336: # 337: # Parameters: 338: # $uri - URI of the course (without version informatino. 339: # $hash - What we have of the big hash. 340: # 341: # Side-Effects: 342: # The URI is cached by memcached. 343: # 344: # Returns: 345: # The version appended URI. 346: # 347: sub append_version { 348: my ($uri, $hash) = @_; 349: 350: # Create the key for the cache entry. 351: 352: my $key = $course_id . '_' . &Apache::lonnet::clutter($uri); 353: 354: # If there is a version it will already be in the hash: 355: 356: if ($hash->{'version_' . $uri}) { 357: my $version = $hash->{'version_' . $uri}; 358: if ($version eq 'mostrecent') { 359: return $uri; # Most recent version does not require decoration (or caching?). 360: } 361: if ($version eq 362: &Apache::lonnet::getversion(&Apache::lonnet::filelocation('', $uri))) { 363: return $uri; # version matches the most recent file version? 364: } 365: $uri =~ s/\.(\w+)$/\.$version\.$1/; # insert the versino prior to the last .word. 366: } 367: 368: # cache the version: 369: 370: &Apache::lonnet::do_cache_new('courseresversion', $key, 371: &Apache::lonnet::declutter($uri), 600); 372: 373: return $uri; 374: 375: } 376: #------------------------------------------------------------------------------ 377: # 378: # Misc. utilities that don't fit into the other classifications. 379: 380: # Determine if the specified user has an 'advanced' role in a course. 381: # Parameters: 382: # cenv - reference to a course environment. 383: # username - Name of the user we care about. 384: # domain - Domain in which the user is defined. 385: # Returns: 386: # 0 - User does not have an advanced role in the course. 387: # 1 - User does have an advanced role in the course. 388: # 389: sub has_advanced_role { 390: my ($username, $domain) = @_; 391: 392: my %adv_roles = &Apache::lonnet::get_course_adv_roles($short_name); 393: my $merged_username = $username . ':' . $domain; 394: foreach my $user (values %adv_roles) { 395: if ($merged_username eq $user) { 396: return 1; 397: } 398: } 399: return 0; 400: } 401: 402: #-------------------------------------------------------------------------------- 403: # Post processing subs: 404: sub hiddenurls { 405: my $hash = shift; 406: 407: my $uname = $hash->{'context.username'}; 408: my $udom = $hash->{'context.userdom'}; 409: my $courseid = $hash->{'context.courseid'}; 410: 411: my $randomoutentry=''; 412: foreach my $rid (keys %randompick) { 413: my $rndpick=$randompick{$rid}; 414: my $mpc=$hash->{'map_pc_'.$hash->{'src_'.$rid}}; 415: # ------------------------------------------- put existing resources into array 416: my @currentrids=(); 417: foreach my $key (sort(keys(%$hash))) { 418: if ($key=~/^src_($mpc\.\d+)/) { 419: if ($hash->{'src_'.$1}) { push @currentrids, $1; } 420: } 421: } 422: # rids are number.number and we want to numercially sort on 423: # the second number 424: @currentrids=sort { 425: my (undef,$aid)=split(/\./,$a); 426: my (undef,$bid)=split(/\./,$b); 427: $aid <=> $bid; 428: } @currentrids; 429: next if ($#currentrids<$rndpick); 430: # -------------------------------- randomly eliminate the ones that should stay 431: my (undef,$id)=split(/\./,$rid); 432: if ($randompickseed{$rid}) { $id=$randompickseed{$rid}; } 433: my $rndseed=&Apache::lonnet::rndseed($id, $courseid, $udom, $uname, \%cenv); # use id instead of symb 434: &Apache::lonnet::setup_random_from_rndseed($rndseed); 435: my @whichids=&Math::Random::random_permuted_index($#currentrids+1); 436: for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; } 437: 438: # -------------------------------------------------------- delete the leftovers 439: for (my $k=0; $k<=$#currentrids; $k++) { 440: if ($currentrids[$k]) { 441: $hash->{'randomout_'.$currentrids[$k]}='1'; 442: my ($mapid,$resid)=split(/\./,$currentrids[$k]); 443: $randomoutentry.='&'. 444: &Apache::lonnet::encode_symb($hash->{'map_id_'.$mapid}, 445: $resid, 446: $hash->{'src_'.$currentrids[$k]} 447: ).'&'; 448: } 449: } 450: } 451: # ------------------------------ take care of explicitly hidden urls or folders 452: foreach my $rid (keys %hiddenurl) { 453: $hash->{'randomout_'.$rid}='1'; 454: my ($mapid,$resid)=split(/\./,$rid); 455: $randomoutentry.='&'. 456: &Apache::lonnet::encode_symb($hash->{'map_id_'.$mapid},$resid, 457: $hash->{'src_'.$rid}).'&'; 458: } 459: # --------------------------------------- add randomout to the hash. 460: if ($randomoutentry) { 461: $hash->{'acc.randomout'} = $randomoutentry; 462: 463: } 464: } 465: 466: # 467: # It's not so clear to me what this sub does. 468: # 469: # Parameters 470: # uri - URI from the course description hash. 471: # short - Course short name. 472: # fn - Course filename. 473: # hash - Reference to the big hash as filled in so far 474: # 475: 476: sub accinit { 477: my ($uri, $short, $hash)=@_; 478: my %acchash=(); 479: my %captured=(); 480: my $condcounter=0; 481: $acchash{'acc.cond.'.$short.'.0'}=0; 482: 483: # This loop is only interested in conditions and 484: # parameters in the big hash: 485: 486: foreach my $key (keys(%$hash)) { 487: 488: # conditions: 489: 490: if ($key=~/^conditions/) { 491: my $expr=$hash->{$key}; 492: 493: # try to find and factor out common sub-expressions 494: # Any subexpression that is found is simplified, removed from 495: # the original condition expression and the simplified sub-expression 496: # substituted back in to the epxression..I'm not actually convinced this 497: # factors anything out...but instead maybe simplifies common factors(?) 498: 499: foreach my $sub ($expr=~m/($\([_\.\d]+(?:\&[_\.\d]+)+$(?:\|$[_\.\d]+(?:\&[_\.\d]+)+$)+\))/g) { 500: my $orig=$sub; 501: 502: my ($factor) = ($sub=~/$\(([_\.\d]+\&(:?[_\.\d]+\&)*)(?:[_\.\d]+\&*)+$(?:\|$\1(?:[_\.\d]+\&*)+$)+\)/); 503: next if (!defined($factor)); 504: 505: $sub=~s/\Q$factor\E//g; 506: $sub=~s/^\(/\($factor\(/; 507: $sub.=')'; 508: $sub=simplify($sub); 509: $expr=~s/\Q$orig\E/$sub/; 510: } 511: $hash->{$key}=$expr; 512: 513: # If not yet seen, record in acchash and that we've seen it. 514: 515: unless (defined($captured{$expr})) { 516: $condcounter++; 517: $captured{$expr}=$condcounter; 518: $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr; 519: } 520: # Parameters: 521: 522: } elsif ($key=~/^param_(\d+)\.(\d+)/) { 523: my $prefix=&Apache::lonnet::encode_symb($hash->{'map_id_'.$1},$2, 524: $hash->{'src_'.$1.'.'.$2}); 525: foreach my $param (split(/\&/,$hash->{$key})) { 526: my ($typename,$value)=split(/\=/,$param); 527: my ($type,$name)=split(/\:/,$typename); 528: $parmhash{$prefix.'.'.&unescape($name)}= 529: &unescape($value); 530: $parmhash{$prefix.'.'.&unescape($name).'.type'}= 531: &unescape($type); 532: } 533: } 534: } 535: # This loop only processes id entries in the big hash. 536: 537: foreach my $key (keys(%$hash)) { 538: if ($key=~/^ids/) { 539: foreach my $resid (split(/\,/,$hash->{$key})) { 540: my $uri=$hash->{'src_'.$resid}; 541: my ($uripath,$urifile) = 542: &Apache::lonnet::split_uri_for_cond($uri); 543: if ($uripath) { 544: my $uricond='0'; 545: if (defined($hash->{'conditions_'.$resid})) { 546: $uricond=$captured{$hash->{'conditions_'.$resid}}; 547: } 548: if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) { 549: if ($acchash{'acc.res.'.$short.'.'.$uripath}=~ 550: /(\&\Q$urifile\E\:[^\&]*)/) { 551: my $replace=$1; 552: my $regexp=$replace; 553: #$regexp=~s/\|/\\\|/g; 554: $acchash{'acc.res.'.$short.'.'.$uripath} =~ 555: s/\Q$regexp\E/$replace\|$uricond/; 556: } else { 557: $acchash{'acc.res.'.$short.'.'.$uripath}.= 558: $urifile.':'.$uricond.'&'; 559: } 560: } else { 561: $acchash{'acc.res.'.$short.'.'.$uripath}= 562: '&'.$urifile.':'.$uricond.'&'; 563: } 564: } 565: } 566: } 567: } 568: $acchash{'acc.res.'.$short.'.'}='&:0&'; 569: my $courseuri=$uri; 570: $courseuri=~s/^\/res\///; 571: my $regexp = 1; 572: 573: &merge_hash($hash, '', \%acchash); # there's already an acc prefix in the hash keys. 574: 575: 576: } 577: 578: 579: # 580: # Traces a route recursively through the map after it has been loaded 581: # (I believe this really visits each resource that is reachable fromt he 582: # start top node. 583: # 584: # - Marks hidden resources as hidden. 585: # - Marks which resource URL's must be encrypted. 586: # - Figures out (if necessary) the first resource in the map. 587: # - Further builds the chunks of the big hash that define how 588: # conditions work 589: # 590: # Note that the tracing strategy won't visit resources that are not linked to 591: # anything or islands in the map (groups of resources that form a path but are not 592: # linked in to the path that can be traced from the start resource...but that's ok 593: # because by definition, those resources are not reachable by users of the course. 594: # 595: # Parameters: 596: # sofar - _URI of the prior entry or 0 if this is the top. 597: # rid - URI of the resource to visit. 598: # beenhere - list of resources (each resource enclosed by &'s) that have 599: # already been visited. 600: # encflag - If true the resource that resulted in a recursive call to us 601: # has an encoded URL (which means contained resources should too). 602: # hdnflag - If true,the resource that resulted in a recursive call to us 603: # was hidden (which means contained resources should be hidden too). 604: # hash - Reference to the hash we are traversing. 605: # Returns 606: # new value indicating how far the map has been traversed (the sofar). 607: # 608: sub traceroute { 609: my ($sofar, $rid, $beenhere, $encflag, $hdnflag, $hash)=@_; 610: my $newsofar=$sofar=simplify($sofar); 611: 612: unless ($beenhere=~/\&\Q$rid\E\&/) { 613: $beenhere.=$rid.'&'; 614: my ($mapid,$resid)=split(/\./,$rid); 615: my $symb=&Apache::lonnet::encode_symb($hash->{'map_id_'.$mapid},$resid, 616: $hash->{'src_'.$rid}); 617: my $hidden=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb); 618: 619: if ($hdnflag || lc($hidden) eq 'yes') { 620: my $ignorehidden; 621: if (defined($hash->{'is_map_'.$rid})) { 622: if (($hash->{'context.nohideurl'}) && ($hash->{'context.nohideurl'} eq $hash->{'src_'.$rid})) { 623: $ignorehidden = 1; # Hidden parameter explicitly deleted 624: # if printing/grading bubblesheet exam 625: } 626: } 627: unless ($ignorehidden) { 628: $hiddenurl{$rid}=1; 629: } 630: } 631: if (!$hdnflag && lc($hidden) eq 'no') { 632: delete($hiddenurl{$rid}); 633: } 634: 635: my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb); 636: if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; } 637: 638: if (($retfrid eq '') && ($hash->{'src_'.$rid}) 639: && ($hash->{'src_'.$rid}!~/\.sequence$/)) { 640: $retfrid=$rid; 641: } 642: 643: if (defined($hash->{'conditions_'.$rid})) { 644: $hash->{'conditions_'.$rid}=simplify( 645: '('.$hash->{'conditions_'.$rid}.')|('.$sofar.')'); 646: } else { 647: $hash->{'conditions_'.$rid}=$sofar; 648: } 649: 650: # if the expression is just the 0th condition keep it 651: # otherwise leave a pointer to this condition expression 652: 653: $newsofar = ($sofar eq '0') ? $sofar : '_'.$rid; 654: 655: # Recurse if the resource is a map: 656: 657: if (defined($hash->{'is_map_'.$rid})) { 658: if (defined($hash->{'map_start_'.$hash->{'src_'.$rid}})) { 659: $sofar=$newsofar= 660: &traceroute($sofar, 661: $hash->{'map_start_'.$hash->{'src_'.$rid}}, 662: $beenhere, 663: $encflag || $encurl{$rid}, 664: $hdnflag || $hiddenurl{$rid}, $hash); 665: } 666: } 667: 668: # Processes links to this resource: 669: # - verify the existence of any conditionals on the link to here. 670: # - Recurse to any resources linked to us. 671: # 672: if (defined($hash->{'to_'.$rid})) { 673: foreach my $id (split(/\,/,$hash->{'to_'.$rid})) { 674: my $further=$sofar; 675: # 676: # If there's a condition associated with this link be sure 677: # it's been defined else that's an error: 678: # 679: if ($hash->{'undercond_'.$id}) { 680: if (defined($hash->{'condid_'.$hash->{'undercond_'.$id}})) { 681: $further=simplify('('.'_'.$rid.')&('. 682: $hash->{'condid_'.$hash->{'undercond_'.$id}}.')'); 683: } else { 684: my $errtext.=&mt('<br />Undefined condition ID: [_1]',$hash->{'undercond_'.$id}); 685: throw Error::Simple($errtext); 686: } 687: } 688: # Recurse to resoruces that have to's to us. 689: $newsofar=&traceroute($further,$hash->{'goesto_'.$id},$beenhere, 690: $encflag,$hdnflag, $hash); 691: } 692: } 693: } 694: return $newsofar; 695: } 696: 697: 698: #--------------------------------------------------------------------------------- 699: # 700: # Map parsing code: 701: # 702: 703: # 704: # Parse the <param> tag. for most parameters, the only action is to define/extend 705: # a has entry for {'param_{refid}'} where refid is the resource the parameter is 706: # attached to and the value built up is an & separated list of parameters of the form: 707: # type:part.name=value 708: # 709: # In addition there is special case code for: 710: # - randompick 711: # - randompickseed 712: # - randomorder 713: # 714: # - encrypturl 715: # - hiddenresource 716: # 717: # Parameters: 718: # token - The token array from HTML::TokeParse we mostly care about element [2] 719: # which is a hash of attribute => values supplied in the tag 720: # (remember this sub is only processing start tag tokens). 721: # mno - Map number. This is used to qualify resource ids within a map 722: # to make them unique course wide (a process known as uniquifaction). 723: # hash - Reference to the hash we are building. 724: # 725: sub parse_param { 726: my ($token, $mno, $hash) = @_; 727: 728: # Qualify the reference and name by the map number and part number. 729: # if no explicit part number is supplied, 0 is the implicit part num. 730: 731: my $referid=$mno.'.'.$token->[2]->{'to'}; # Resource param applies to. 732: my $name=$token->[2]->{'name'}; # Name of parameter 733: my $part; 734: 735: 736: if ($name=~/^parameter_(.*)_/) { 737: $part=$1; 738: } else { 739: $part=0; 740: } 741: 742: # Peel the parameter_ off the parameter name. 743: 744: $name=~s/^.*_([^_]*)$/$1/; 745: 746: # The value is: 747: # type.part.name.value 748: 749: my $newparam= 750: &escape($token->[2]->{'type'}).':'. 751: &escape($part.'.'.$name).'='. 752: &escape($token->[2]->{'value'}); 753: 754: # The hash key is param_resourceid. 755: # Multiple parameters for a single resource are & separated in the hash. 756: 757: 758: if (defined($hash->{'param_'.$referid})) { 759: $hash->{'param_'.$referid}.='&'.$newparam; 760: } else { 761: $hash->{'param_'.$referid}=''.$newparam; 762: } 763: # 764: # These parameters have to do with randomly selecting 765: # resources, therefore a separate hash is also created to 766: # make it easy to locate them when actually computing the resource set later on 767: # See the code conditionalized by ($randomize) in read_map(). 768: 769: if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) { # Random selection turned on 770: $randompick{$referid}=$token->[2]->{'value'}; 771: } 772: if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) { # Randomseed provided. 773: $randompickseed{$referid}=$token->[2]->{'value'}; 774: } 775: if ($token->[2]->{'name'}=~/^parameter_(0_)*randomorder$/) { # Random order turned on. 776: $randomorder{$referid}=$token->[2]->{'value'}; 777: } 778: 779: # These parameters have to do with how the URLs of resources are presented to 780: # course members(?). encrypturl presents encypted url's while 781: # hiddenresource hides the URL. 782: # 783: 784: if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) { 785: if ($token->[2]->{'value'}=~/^yes$/i) { 786: $encurl{$referid}=1; 787: } 788: } 789: if ($token->[2]->{'name'}=~/^parameter_(0_)*hiddenresource$/) { 790: if ($token->[2]->{'value'}=~/^yes$/i) { 791: $hiddenurl{$referid}=1; 792: } 793: } 794: } 795: 796: 797: # 798: # Parses a resource tag to produce the value to push into the 799: # map_ids array. 800: # 801: # 802: # Information about the actual type of resource is provided by the file extension 803: # of the uri (e.g. .problem, .sequence etc. etc.). 804: # 805: # Parameters: 806: # $token - A token from HTML::TokeParser 807: # This is an array that describes the most recently parsed HTML item. 808: # $lpc - Map nesting level (?) 809: # $ispage - True if this resource is encapsulated in a .page (assembled resourcde). 810: # $uri - URI of the enclosing resource. 811: # $code - CODE for which resource is being parsed (CODEd assignments). 812: # $hash - Reference to the hash we are building. 813: # 814: # Returns: 815: # Value of the id attribute of the tag. 816: # 817: # Note: 818: # The token is an array that contains the following elements: 819: # [0] => 'S' indicating this is a start token 820: # [1] => 'resource' indicating this tag is a <resource> tag. 821: # [2] => Hash of attribute =>value pairs. 822: # [3] => @(keys [2]). 823: # [4] => unused. 824: # 825: # The attributes of the resourcde tag include: 826: # 827: # id - The resource id. 828: # src - The URI of the resource. 829: # type - The resource type (e.g. start and finish). 830: # title - The resource title. 831: # 832: 833: sub parse_resource { 834: my ($token,$lpc,$ispage,$uri,$code,$hash) = @_; 835: 836: # I refuse to countenance code like this that has 837: # such a dirty side effect (and forcing this sub to be called within a loop). 838: # 839: # if ($token->[2]->{'type'} eq 'zombie') { next; } 840: # 841: # The original code both returns _and_ skips to the next pass of the >caller's< 842: # loop, that's just dirty. 843: # 844: 845: # Zombie resources don't produce anything useful. 846: 847: if ($token->[2]->{'type'} eq 'zombie') { 848: return undef; 849: } 850: 851: my $rid=$lpc.'.'.$token->[2]->{'id'}; # Resource id in hash is levelcounter.id-in-xml. 852: 853: # Save the hash element type and title: 854: 855: $hash->{'kind_'.$rid}='res'; 856: $hash->{'title_'.$rid}=$token->[2]->{'title'}; 857: 858: # Get the version free URI for the resource. 859: # If a 'version' attribute was supplied, and this resource's version 860: # information has not yet been stored, store it. 861: # 862: 863: 864: my $turi=&versiontrack($token->[2]->{'src'}); 865: if ($token->[2]->{'version'}) { 866: unless ($hash->{'version_'.$turi}) { 867: 868: #Where does the value of $1 below come from? 869: #$1 for the regexps in versiontrack should have gone out of scope. 870: # 871: # I think this may be dead code since versiontrack ought to set 872: # this hash element(?). 873: # 874: $hash->{'version_'.$turi}=$1; 875: } 876: } 877: # Pull out the title and do entity substitution on &colon 878: # Q: Why no other entity substitutions? 879: 880: my $title=$token->[2]->{'title'}; 881: $title=~s/\&colon\;/\:/gs; 882: 883: 884: 885: # I think the point of all this code is to construct a final 886: # URI that apache and its rewrite rules can use to 887: # fetch the resource. Thi s sonly necessary if the resource 888: # is not a page. If the resource is a page then it must be 889: # assembled (at fetch time?). 890: 891: unless ($ispage) { 892: $turi=~/\.(\w+)$/; 893: my $embstyle=&Apache::loncommon::fileembstyle($1); 894: if ($token->[2]->{'external'} eq 'true') { # external 895: $turi=~s/^https?\:\/\//\/adm\/wrapper\/ext\//; 896: } elsif ($turi=~/^\/*uploaded\//) { # uploaded 897: if (($embstyle eq 'img') 898: || ($embstyle eq 'emb') 899: || ($embstyle eq 'wrp')) { 900: $turi='/adm/wrapper'.$turi; 901: } elsif ($embstyle eq 'ssi') { 902: #do nothing with these 903: } elsif ($turi!~/\.(sequence|page)$/) { 904: $turi='/adm/coursedocs/showdoc'.$turi; 905: } 906: } elsif ($turi=~/\S/) { # normal non-empty internal resource 907: my $mapdir=$uri; 908: $mapdir=~s/[^\/]+$//; 909: $turi=&Apache::lonnet::hreflocation($mapdir,$turi); 910: if (($embstyle eq 'img') 911: || ($embstyle eq 'emb') 912: || ($embstyle eq 'wrp')) { 913: $turi='/adm/wrapper'.$turi; 914: } 915: } 916: } 917: # Store reverse lookup, remove query string resource 'ids'_uri => resource id. 918: # If the URI appears more than one time in the sequence, it's resourcde 919: # id's are constructed as a comma spearated list. 920: 921: my $idsuri=$turi; 922: $idsuri=~s/\?.+$//; 923: if (defined($hash->{'ids_'.$idsuri})) { 924: $hash->{'ids_'.$idsuri}.=','.$rid; 925: } else { 926: $hash->{'ids_'.$idsuri}=''.$rid; 927: } 928: 929: 930: 931: if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard|viewclasslist)$/) { 932: $turi.='?register=1'; 933: } 934: 935: 936: # resource id lookup: 'src'_resourc-di => URI decorated with a query 937: # parameter as above if necessary due to the resource type. 938: 939: $hash->{'src_'.$rid}=$turi; 940: 941: # Mark the external-ness of the resource: 942: 943: if ($token->[2]->{'external'} eq 'true') { 944: $hash->{'ext_'.$rid}='true:'; 945: } else { 946: $hash->{'ext_'.$rid}='false:'; 947: } 948: 949: # If the resource is a start/finish resource set those 950: # entries in the has so that navigation knows where everything starts. 951: # If there is a malformed sequence that has no start or no finish 952: # resource, should this be detected and errors thrown? How would such a 953: # resource come into being other than being manually constructed by a person 954: # and then uploaded? Could that happen if an author decided a sequence was almost 955: # right edited it by hand and then reuploaded it to 'fix it' but accidently cut the 956: # start or finish resources? 957: # 958: # All resourcess also get a type_id => (start | finish | normal) hash entr. 959: # 960: if ($token->[2]->{'type'}) { 961: $hash->{'type_'.$rid}=$token->[2]->{'type'}; 962: if ($token->[2]->{'type'} eq 'start') { 963: $hash->{'map_start_'.$uri}="$rid"; 964: } 965: if ($token->[2]->{'type'} eq 'finish') { 966: $hash->{'map_finish_'.$uri}="$rid"; 967: } 968: } else { 969: $hash->{'type_'.$rid}='normal'; 970: } 971: 972: # Sequences end pages are constructed entities. They require that the 973: # map that defines _them_ be loaded as well into the hash...with this resourcde 974: # as the base of the nesting. 975: # Resources like that are also marked with is_map_id => 1 entries. 976: # 977: 978: if (($turi=~/\.sequence$/) || 979: ($turi=~/\.page$/)) { 980: $hash->{'is_map_'.$rid}='1'; # String in lonuserstate. 981: if ($hiddenurl{$rid}) { 982: if (($hash->{'context.nohideurl'}) && 983: ($hash->{'context.nohideurl'} eq $hash->{'src_'.$rid})) { 984: delete($hiddenurl{$rid}); # Hidden parameter explicitly deleted 985: # if printing/grading bubblesheet exam 986: } 987: } 988: 989: &read_map($turi,$rid,$code,$hash); 990: } 991: return $token->[2]->{'id'}; 992: } 993: 994: # Links define how you are allowed to move from one resource to another. 995: # They are the transition edges in the directed graph that a map is. 996: # This sub takes informatino from a <link> tag and constructs the 997: # navigation bits and pieces of a map. There is no requirement that the 998: # resources that are linke are already defined, however clearly the map is 999: # badly broken if they are not _eventually_ defined. 1000: # 1001: # Note that links can be unconditional or conditional. 1002: # 1003: # Parameters: 1004: # linkpc - The link counter for this level of map nesting (this is 1005: # reset to zero by read_map prior to starting to process 1006: # links for map). 1007: # lpc - The map level ocounter (how deeply nested this map is in 1008: # the hierarchy of maps that are recursively read in. 1009: # to - resource id (within the XML) of the target of the edge. 1010: # from - resource id (within the XML) of the source of the edge. 1011: # condition- id of condition associated with the edge (also within the XML). 1012: # hash - reference to the hash we are building. 1013: 1014: # 1015: 1016: sub make_link { 1017: my ($linkpc,$lpc,$to,$from,$condition, $hash) = @_; 1018: 1019: # Compute fully qualified ids for the link, the 1020: # and from/to by prepending lpc. 1021: # 1022: 1023: my $linkid=$lpc.'.'.$linkpc; 1024: my $goesto=$lpc.'.'.$to; 1025: my $comesfrom=$lpc.'.'.$from; 1026: my $undercond='0'; 1027: 1028: 1029: # If there is a condition, qualify it with the level counter. 1030: 1031: if ($condition) { 1032: $undercond=$lpc.'.'.$condition; 1033: } 1034: 1035: # Links are represnted by: 1036: # goesto_.fuullyqualifedlinkid => fully qualified to 1037: # comesfrom.fullyqualifiedlinkid => fully qualified from 1038: # undercond_.fullyqualifiedlinkid => fully qualified condition id. 1039: 1040: $hash->{'goesto_'.$linkid}=$goesto; 1041: $hash->{'comesfrom_'.$linkid}=$comesfrom; 1042: $hash->{'undercond_'.$linkid}=$undercond; 1043: 1044: # In addition: 1045: # to_.fully qualified from => comma separated list of 1046: # link ids with that from. 1047: # Similarly: 1048: # from_.fully qualified to => comma separated list of link ids` 1049: # with that to. 1050: # That allows us given a resource id to know all edges that go to it 1051: # and leave from it. 1052: # 1053: 1054: if (defined($hash->{'to_'.$comesfrom})) { 1055: $hash->{'to_'.$comesfrom}.=','.$linkid; 1056: } else { 1057: $hash->{'to_'.$comesfrom}=''.$linkid; 1058: } 1059: if (defined($hash->{'from_'.$goesto})) { 1060: $hash->{'from_'.$goesto}.=','.$linkid; 1061: } else { 1062: $hash->{'from_'.$goesto}=''.$linkid; 1063: } 1064: } 1065: 1066: # ------------------------------------------------------------------- Condition 1067: # 1068: # Processes <condition> tags, storing sufficient information about them 1069: # in the hash so that they can be evaluated and used to conditionalize 1070: # what is presented to the student. 1071: # 1072: # these can have the following attributes 1073: # 1074: # id = A unique identifier of the condition within the map. 1075: # 1076: # value = Is a perl script-let that, when evaluated in safe space 1077: # determines whether or not the condition is true. 1078: # Normally this takes the form of a test on an Apache::lonnet::EXT call 1079: # to find the value of variable associated with a resource in the 1080: # map identified by a mapalias. 1081: # Here's a fragment of XML code that illustrates this: 1082: # 1083: # <param to="5" value="mainproblem" name="parameter_0_mapalias" type="string" /> 1084: # <resource src="" id="1" type="start" title="Start" /> 1085: # <resource src="/res/msu/albertel/b_and_c/p1.problem" id="5" title="p1.problem" /> 1086: # <condition value="&EXT('user.resource.resource.0.tries','mainproblem') 1087: # <2 " id="61" type="stop" /> 1088: # <link to="5" index="1" from="1" condition="61" /> 1089: # 1090: # In this fragment: 1091: # - The param tag establishes an alias to resource id 5 of 'mainproblem'. 1092: # - The resource that is the start of the map is identified. 1093: # - The resource tag identifies the resource associated with this tag 1094: # and gives it the id 5. 1095: # - The condition is true if the tries variable associated with mainproblem 1096: # is less than 2 (that is the user has had more than 2 tries). 1097: # The condition type is a stop condition which inhibits(?) the associated 1098: # link if the condition is false. 1099: # - The link to resource 5 from resource 1 is affected by this condition. 1100: # 1101: # type = Type of the condition. The type determines how the condition affects the 1102: # link associated with it and is one of 1103: # - 'force' 1104: # - 'stop' 1105: # anything else including not supplied..which treated as: 1106: # - 'normal'. 1107: # Presumably maps get created by the resource assembly tool and therefore 1108: # illegal type values won't squirm their way into the XML. 1109: # hash - Reference to the hash we are trying to build up. 1110: # 1111: # Side effects: 1112: # - The kind_level-qualified-condition-id hash element is set to 'cond'. 1113: # - The condition text is pushed into the cond array and its element number is 1114: # set in the condid_level-qualified-condition-id element of the hash. 1115: # - The condition type is colon appneded to the cond array element for this condition. 1116: sub parse_condition { 1117: my ($token, $lpc, $hash) = @_; 1118: my $rid=$lpc.'.'.$token->[2]->{'id'}; 1119: 1120: $hash->{'kind_'.$rid}='cond'; 1121: 1122: my $condition = $token->[2]->{'value'}; 1123: $condition =~ s/[\n\r]+/ /gs; 1124: push(@cond, $condition); 1125: $hash->{'condid_'.$rid}=$#cond; 1126: if ($token->[2]->{'type'}) { 1127: $cond[$#cond].=':'.$token->[2]->{'type'}; 1128: } else { 1129: $cond[$#cond].=':normal'; 1130: } 1131: } 1132: 1133: # 1134: # Parse mapalias parameters. 1135: # these are tags of the form: 1136: # <param to="nn" 1137: # value="some-alias-for-resourceid-nn" 1138: # name="parameter_0_mapalias" 1139: # type="string" /> 1140: # A map alias is a textual name for a resource: 1141: # - The to attribute identifies the resource (this gets level qualified below) 1142: # - The value attributes provides the alias string. 1143: # - name must be of the regexp form: /^parameter_(0_)*mapalias$/ 1144: # - e.g. the string 'parameter_' followed by 0 or more "0_" strings 1145: # terminating with the string 'mapalias'. 1146: # Examples: 1147: # 'parameter_mapalias', 'parameter_0_mapalias', parameter_0_0_mapalias' 1148: # Invalid to ids are silently ignored. 1149: # 1150: # Parameters: 1151: # token - The token array fromthe HMTML::TokeParser 1152: # lpc - The current map level counter. 1153: # hash - Reference to the hash that we are building. 1154: # 1155: sub parse_mapalias_param { 1156: my ($token, $lpc, $hash) = @_; 1157: 1158: # Fully qualify the to value and ignore the alias if there is no 1159: # corresponding resource. 1160: 1161: my $referid=$lpc.'.'.$token->[2]->{'to'}; 1162: return if (!exists($hash->{'src_'.$referid})); 1163: 1164: # If this is a valid mapalias parameter, 1165: # Append the target id to the count_mapalias element for that 1166: # alias so that we can detect doubly defined aliases 1167: # e.g.: 1168: # <param to="1" value="george" name="parameter_0_mapalias" type="string" /> 1169: # <param to="2" value="george" name="parameter_0_mapalias" type="string" /> 1170: # 1171: # The example above is trivial but the case that's important has to do with 1172: # constructing a map that includes a nested map where the nested map may have 1173: # aliases that conflict with aliases established in the enclosing map. 1174: # 1175: # ...and create/update the hash mapalias entry to actually store the alias. 1176: # 1177: 1178: if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) { 1179: &count_mapalias($token->[2]->{'value'},$referid); 1180: $hash->{'mapalias_'.$token->[2]->{'value'}}=$referid; 1181: } 1182: } 1183: 1184: 1185: #--------------------------------------------------------------------------------- 1186: # 1187: # Code to process the map file. 1188: 1189: # read a map file and add it to the hash. Since a course map can contain resources 1190: # that are themselves maps, read_map might be recursively called. 1191: # 1192: # Parameters: 1193: # $uri - URI of the course itself (not the map file). 1194: # $parent_rid - map number qualified id of the parent of the map being read. 1195: # For the top level course map this is 0.0. For the first nested 1196: # map 1.n where n is the id of the resource within the 1197: # top level map and so on. 1198: # $code - CODE for which map is being read (CODEd assignments). 1199: # $hash - Reference to a hash that will become the big hash for the course 1200: # This hash is modified as per the map description. 1201: # Side-effects: 1202: # $map_number - Will be incremented. This keeps track of the number of the map 1203: # we are currently working on (see parent_rid above, the number to the 1204: # left of the . in $parent_rid is the map number). 1205: # 1206: # 1207: sub read_map { 1208: my ($uri, $parent_rid, $code, $hash) = @_; 1209: 1210: 1211: # Check for duplication: A map may only be included once. 1212: 1213: if($hash->{'map_pc_' . $uri}) { 1214: throw Error::Simple('Duplicate map: ', $uri); 1215: } 1216: # count the map number and save it locally so that we don't lose it 1217: # when we recurse. 1218: 1219: $map_number++; 1220: my $lmap_no = $map_number; 1221: 1222: # save the map_pc and map_id elements of the hash for this map: 1223: # map_pc_uri is the map number of the map with that URI. 1224: # map_id_$lmap_no is the URI for this map level. 1225: # 1226: $hash->{'map_pc_' . $uri} = "$lmap_no"; # string form in lonuserstate. 1227: $hash->{'map_id_' . $lmap_no} = "$uri"; 1228: 1229: # Create the path up to the top of the course. 1230: # this is in 'map_hierarchy_mapno' that's a comma separated path down to us 1231: # in the hierarchy: 1232: 1233: if ($parent_rid =~/^(\d+).\d+$/) { 1234: my $parent_no = $1; # Parent's map number. 1235: if (defined($hash->{'map_hierarchy_' . $parent_no})) { 1236: $hash->{'map_hierarchy_' . $lmap_no} = 1237: $hash->{'map_hierarchy_' . $parent_no} . ',' . $parent_no; 1238: } else { 1239: # Only 1 level deep ..nothing to append to: 1240: 1241: $hash->{'map_hierarchy_' . $lmap_no} = $parent_no; 1242: } 1243: } 1244: 1245: # figure out the name of the map file we need to read. 1246: # ensure that it is a .page or a .sequence as those are the only 1247: # sorts of files that make sense for this sub 1248: 1249: my $filename = &Apache::lonnet::filelocation('', &append_version($uri, $hash)); 1250: 1251: 1252: my $ispage = ($filename =~/\.page$/); 1253: unless ($ispage || ($filename =~ /\.sequence$/)) { 1254: &Apache::lonnet::logthis("invalid: $filename : $uri"); 1255: throw Error::Simple(&mt("<br />Invalid map: <tt>[_1]</tt>", $filename)); 1256: } 1257: 1258: $filename =~ /\.(\w+)$/; 1259: 1260: $hash->{'map_type_'.$lmap_no}=$1; 1261: 1262: # Repcopy the file and get its contents...report errors if we can't 1263: 1264: my $contents = &Apache::lonnet::getfile($filename); 1265: if($contents eq -1) { 1266: throw Error::Simple(&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.', 1267: $filename)); 1268: } 1269: # Now that we succesfully retrieved the file we can make our parsing passes over it: 1270: # parsing is done in passes: 1271: # 1. Parameters are parsed. 1272: # 2. Resource, links and conditions are parsed. 1273: # 1274: # post processing takes care of the case where the sequence is random ordered 1275: # or randomselected. 1276: 1277: # Parse the parameters, This pass only cares about start tags for <param> 1278: # tags.. this is because there is no body to a <param> tag. 1279: # 1280: 1281: my $parser = HTML::TokeParser->new(\$contents); 1282: $parser->attr_encoded(1); # Don't interpret entities in attributes (leave &xyz; alone). 1283: 1284: while (my $token = $parser->get_token()) { 1285: if (($token->[0] eq 'S') && ($token->[1] eq 'param')) { 1286: &parse_param($token, $map_number, $hash); 1287: } 1288: } 1289: 1290: # ready for pass 2: Resource links and conditions. 1291: # Note that if the map is random-ordered link tags are computed by randomizing 1292: # resource order. Furthermore, since conditions are set on links rather than 1293: # resources, they are also not processed if random order is turned on. 1294: # 1295: 1296: $parser = HTML::TokeParser->new(\$contents); # no way to reset the existing parser 1297: $parser->attr_encoded(1); 1298: 1299: my $linkpc=0; 1300: my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i); 1301: 1302: my @map_ids; 1303: while (my $token = $parser->get_token) { 1304: next if ($token->[0] ne 'S'); 1305: 1306: # Resource 1307: 1308: if ($token->[1] eq 'resource') { 1309: my $resource_id = &parse_resource($token,$lmap_no,$ispage,$uri,$code,$hash); 1310: if (defined $resource_id) { 1311: push(@map_ids, $resource_id); 1312: } 1313: 1314: # Link 1315: 1316: } elsif ($token->[1] eq 'link' && !$randomize) { 1317: &make_link(++$linkpc,$lmap_no,$token->[2]->{'to'}, 1318: $token->[2]->{'from'}, 1319: $token->[2]->{'condition'}, $hash); # note ..condition may be undefined. 1320: 1321: # condition 1322: 1323: } elsif ($token->[1] eq 'condition' && !$randomize) { 1324: &parse_condition($token,$lmap_no, $hash); 1325: } 1326: } 1327: 1328: # This section handles random ordering by permuting the 1329: # IDs of the map according to the user's random seed. 1330: # 1331: 1332: if ($randomize) { 1333: if (!&has_advanced_role($username, $userdomain) || $code) { 1334: my $seed; 1335: 1336: # In the advanced role, the map's random seed 1337: # parameter is used as the basis for computing the 1338: # seed ... if it has been specified: 1339: 1340: if (defined($randompickseed{$parent_rid})) { 1341: $seed = $randompickseed{$parent_rid}; 1342: } else { 1343: 1344: # Otherwise the parent's fully encoded symb is used. 1345: 1346: my ($mapid,$resid)=split(/\./,$parent_rid); 1347: my $symb= 1348: &Apache::lonnet::encode_symb($hash->{'map_id_'.$mapid}, 1349: $resid,$hash->{'src_'.$parent_rid}); 1350: 1351: $seed = $symb; 1352: } 1353: 1354: 1355: my $rndseed=&Apache::lonnet::rndseed($seed, '', 1356: $userdomain, $username, 1357: \%cenv); 1358: 1359: 1360: &Apache::lonnet::setup_random_from_rndseed($rndseed); 1361: 1362: # Take the set of map ids we have decoded and permute them to a 1363: # random order based on the seed set above. All of this is 1364: # processing the randomorder parameter if it is set, not 1365: # randompick. 1366: 1367: @map_ids=&Math::Random::random_permutation(@map_ids); 1368: } 1369: my $from = shift(@map_ids); 1370: my $from_rid = $lmap_no.'.'.$from; 1371: $hash->{'map_start_'.$uri} = $from_rid; 1372: $hash->{'type_'.$from_rid}='start'; 1373: 1374: # Create links to reflect the random re-ordering done above. 1375: # In the code to process the map XML, we did not process links or conditions 1376: # if randomorder was set. This means that for an instructor to choose 1377: 1378: while (my $to = shift(@map_ids)) { 1379: &make_link(++$linkpc,$lmap_no,$to,$from, 0, $hash); 1380: my $to_rid = $lmap_no.'.'.$to; 1381: $hash->{'type_'.$to_rid}='normal'; 1382: $from = $to; 1383: $from_rid = $to_rid; 1384: } 1385: 1386: $hash->{'map_finish_'.$uri}= $from_rid; 1387: $hash->{'type_'.$from_rid}='finish'; 1388: } 1389: 1390: 1391: # The last parsing pass parses the <mapalias> tags that associate a name 1392: # with resource ids. 1393: 1394: $parser = HTML::TokeParser->new(\$contents); 1395: $parser->attr_encoded(1); 1396: 1397: while (my $token = $parser->get_token) { 1398: next if ($token->[0] ne 'S'); 1399: if ($token->[1] eq 'param') { 1400: &parse_mapalias_param($token,$lmap_no, $hash); 1401: } 1402: } 1403: 1404: } 1405: 1406: 1407: # 1408: # Load a map from file into a target hash. This is done by first parsing the 1409: # map file into local hashes and then unrolling those hashes into the big hash. 1410: # 1411: # Parameters: 1412: # 1413: # $cnum - number of course being read. 1414: # $cdom - Domain in which the course is evaluated. 1415: # $uname - Name of the user for whom the course is being read 1416: # $udom - Name of the domain of the user for whom the course is being read. 1417: # $code - CODE for which course is being read (CODEd assignments) 1418: # $nohideurl - URL for an exam folder for which hidden state is to be ignored. 1419: # $target_hash- Reference to the target hash into which all of this is read. 1420: # Note tht some of the hash entries we need to build require knowledge of the 1421: # course URI.. these are expected to be filled in by the caller. 1422: # 1423: # Errors are logged to lonnet and are managed via the Perl structured exception package. 1424: # 1425: # 1426: sub loadmap { 1427: my ($cnum, $cdom, $uname, $udom, $code, $nohideurl, $target_hash) = @_; 1428: 1429: 1430: 1431: # Clear the auxiliary hashes and the cond array. 1432: 1433: 1434: %randompick = (); 1435: %randompickseed = (); 1436: %encurl = (); 1437: %hiddenurl = (); 1438: %parmhash = (); 1439: @cond = ('true:normal'); # Initial value for cond 0. 1440: $retfrid = ''; 1441: $username = ''; 1442: $userdomain = ''; 1443: %mapalias_cache = (); 1444: %cenv = (); 1445: $map_number = 0; 1446: 1447: # 1448: 1449: $username = $uname; 1450: $userdomain = $udom; 1451: 1452: $short_name = $cdom .'/' . $cnum; 1453: my $retfurl; 1454: 1455: try { 1456: 1457: 1458: # Get the information we need about the course. 1459: # Return without filling in anything if we can't get any info: 1460: 1461: %cenv = &Apache::lonnet::coursedescription($short_name, 1462: {'freshen_cache' => 1, 1463: 'user' => $uname}); 1464: 1465: unless ($cenv{'url'}) { 1466: &Apache::lonnet::logthis("lonmap::loadmap failed: $cnum/$cdom - did not get url"); 1467: return; 1468: } 1469: 1470: $course_id = $cdom . '_' . $cnum; # Long course id. 1471: 1472: # Load the version information into the hash 1473: 1474: 1475: &process_versions(\%cenv, $target_hash); 1476: 1477: 1478: # Figure out the map filename's URI, and set up some starting points for the map. 1479: 1480: my $course_uri = $cenv{'url'}; 1481: my $map_uri = &Apache::lonnet::clutter($course_uri); 1482: 1483: $target_hash->{'src_0.0'} = &versiontrack($map_uri, $target_hash); 1484: $target_hash->{'title_0.0'} = &Apache::lonnet::metadata($course_uri, 'title'); 1485: if(!defined $target_hash->{'title_0.0'}) { 1486: $target_hash->{'title_0.0'} = ''; 1487: } 1488: $target_hash->{'ids_'.$map_uri} = '0.0'; 1489: $target_hash->{'is_map_0.0'} = '1'; 1490: 1491: # In some places we need a username a domain and the courseid...store that 1492: # in the target hash in the context.xxxx keys: 1493: 1494: $target_hash->{'context.username'} = $username; 1495: $target_hash->{'context.userdom'} = $userdomain; 1496: $target_hash->{'context.courseid'} = $course_id; 1497: 1498: # When grading or printing a bubblesheet exam ignore 1499: # "hidden" parameter set in the map containing the exam folder. 1500: $target_hash->{'context.nohideurl'} = $nohideurl; 1501: 1502: &read_map($course_uri, '0.0', $code, $target_hash); 1503: 1504: if (defined($target_hash->{'map_start_'.$map_uri})) { 1505: 1506: &traceroute('0',$target_hash->{'map_start_'.$course_uri},'&', 0, 0, $target_hash); 1507: &accinit($course_uri, $short_name, $target_hash); 1508: &hiddenurls($target_hash); 1509: } 1510: my $errors = &get_mapalias_errors($target_hash); 1511: if ($errors ne "") { 1512: throw Error::Simple("Map alias errors: ", $errors); 1513: } 1514: 1515: # Put the versions in to src: 1516: 1517: foreach my $key (keys(%$target_hash)) { 1518: if ($key =~ /^src_/) { 1519: $target_hash->{$key} = 1520: &putinversion($target_hash->{$key}, $target_hash, $short_name); 1521: } elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) { 1522: my ($type, $url) = ($1,$2); 1523: my $value = $target_hash->{$key}; 1524: $target_hash->{$type.&putinversion($url, $target_hash, $short_name)}=$value; 1525: } 1526: } 1527: # Mark necrypted URLS. 1528: 1529: foreach my $id (keys(%encurl)) { 1530: $target_hash->{'encrypted_'.$id}=1; 1531: } 1532: 1533: # Store first keys. 1534: 1535: $target_hash->{'first_rid'}=$retfrid; 1536: my ($mapid,$resid)=split(/\./,$retfrid); 1537: $target_hash->{'first_mapurl'}=$target_hash->{'map_id_'.$mapid}; 1538: my $symb=&Apache::lonnet::encode_symb($target_hash->{'map_id_'.$mapid}, 1539: $resid, 1540: $target_hash->{'src_'.$retfrid}); 1541: $retfurl=&add_get_param($target_hash->{'src_'.$retfrid},{ 'symb' => $symb }); 1542: if ($target_hash->{'encrypted_'.$retfrid}) { 1543: $retfurl=&Apache::lonenc::encrypted($retfurl, 1544: (&Apache::lonnet::allowed('adv') ne 'F')); 1545: } 1546: $target_hash->{'first_url'}=$retfurl; 1547: 1548: # Merge in the child hashes in case the caller wants that information as well. 1549: 1550: 1551: &merge_hash($target_hash, 'randompick', \%randompick); 1552: &merge_hash($target_hash, 'randompickseed', \%randompickseed); 1553: &merge_hash($target_hash, 'randomorder', \%randomorder); 1554: &merge_hash($target_hash, 'encurl', \%encurl); 1555: &merge_hash($target_hash, 'hiddenurl', \%hiddenurl); 1556: &merge_hash($target_hash, 'param', \%parmhash); 1557: &merge_conditions($target_hash); 1558: } 1559: otherwise { 1560: my $e = shift; 1561: &Apache::lonnet::logthis("lonmap::loadmap failed: " . $e->stringify()); 1562: } 1563: 1564: } 1565: 1566: 1567: 1; 1568: 1569: # 1570: # Module initialization code: 1571: # TODO: Fix the pod docs below. 1572: 1573: 1; 1574: __END__ 1575: 1576: =head1 NAME 1577: 1578: Apache::lonmap - Construct a hash that represents a course (Big Hash). 1579: 1580: =head1 SYNOPSIS 1581: 1582: &Apache::lonmap::loadmap($cnum, $cdom, $uname, $udom, $code, $nohideurl, \%target_hash); 1583: 1584: =head1 INTRODUCTION 1585: 1586: This module reads a course filename into a hash reference. It's up to the caller 1587: to do things like decide that the hash should be tied to some external file and handle the 1588: the locking if this file should be shared amongst several Apache children. 1589: 1590: =head1 SUBROUTINES 1591: 1592: =over 1593: 1594: =item loadmap($cnum, $cdom, $uname, $udom, $code, $nohideurl, $targethash) 1595: 1596: 1597: Reads the top-level map file into a target hash. This is done by first parsing the 1598: map file into local hashes and then unrolling those hashes into the big hash. 1599: 1600: =over 1601: 1602: =item $cnum - number of course being read. 1603: 1604: =item $cdom - domain in which the course is evaluated. 1605: 1606: =item $uname - name of the user for whom the course is being read. 1607: 1608: =item $udom - name of the domain of the user for whom the course is being read. 1609: 1610: =item $code - CODE for which course is being read (CODEd assignments). 1611: 1612: =item $nohideurl - URL for an exam folder for which hidden state is to be ignored. 1613: 1614: =item $targethash - A reference to hash into which the course is read 1615: 1616: =back 1617: 1618: =item process_versions($cenv, $hash) 1619: 1620: Makes hash entries for each version of a course described by a course environment 1621: returned from Apache::lonnet::coursedescription. 1622: 1623: =over 1624: 1625: =item $cenv - Reference to the environment hash returned by Apache::lonnet::coursedescription 1626: 1627: =item $hash - Hash to be filled in with 'version_xxx' entries as per the big hash. 1628: 1629: =back 1630: 1631: =back 1632: 1633: 1634: =cut