Parent Directory
| 
Revision Log
put "grades" in alphabetical order. added newFromModule for creating a URLPath to a particular module with particular args. reorganized the code somewhat. constructors now throw an exception if they can't find an appropriate path type.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork-modperl/lib/WeBWorK/URLPath.pm,v 1.3 2004/03/06 18:50:00 gage Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::URLPath; 18 19 =head1 NAME 20 21 WeBWorK::URLPath - the WeBWorK virtual URL heirarchy. 22 23 =cut 24 25 use strict; 26 use warnings; 27 28 sub debug { 29 my ($label, $indent, @message) = @_; 30 print STDERR " "x$indent; 31 print STDERR "$label: " if $label ne ""; 32 print STDERR @message; 33 } 34 35 =head1 VIRTUAL HEIRARCHY 36 37 root / 38 39 set_list /$courseID/ 40 41 equation_display /$courseID/equation/ 42 feedback /$courseID/feedback/ 43 gateway_quiz /$courseID/quiz_mode/$setID/ 44 grades /$courseID/grades/ 45 hardcopy /$courseID/hardcopy/ 46 hardcopy_preselect_set /$courseID/hardcopy/$setID/ 47 logout /$courseID/logout/ 48 options /$courseID/options/ 49 50 instructor_tools /$courseID/instructor/ 51 52 instructor_user_list /$courseID/instructor/users/ 53 instructor_user_detail /$courseID/instructor/users/$userID/ 54 instructor_sets_assigned_to_user /$courseID/instructor/users/$userID/sets/ 55 56 instructor_set_list /$courseID/instructor/sets/ 57 instructor_set_detail /$courseID/instructor/sets/$setID/ 58 instructor_problem_list /$courseID/instructor/sets/$setID/problems/ 59 [instructor_problem_detail] /$courseID/instructor/sets/$setID/problems/$problemID/ 60 instructor_users_assigned_to_set /$courseID/instructor/sets/$setID/users/ 61 62 instructor_add_users /$courseID/instructor/add_users/ 63 instructor_set_assigner /$courseID/instructor/assigner/ 64 instructor_file_transfer /$courseID/instructor/files/ 65 66 instructor_problem_editor /$courseID/instructor/pgProblemEditor/ 67 instructor_problem_editor_withset /$courseID/instructor/pgProblemEditor/$setID/ 68 instructor_problem_editor_withset_withproblem 69 /$courseID/instructor/pgProblemEditor/$setID/$problemID/ 70 71 instructor_scoring /$courseID/instructor/scoring/ 72 instructor_scoring_download /$courseID/instructor/scoringDownload/ 73 instructor_mail_merge /$courseID/instructor/send_mail/ 74 instructor_answer_log /$courseID/instructor/show_answers/ 75 instructor_statistics /$courseID/instructor/stats/ 76 77 problem_list /$courseID/$setID/ 78 problem_detail /$courseID/$setID/$problemID/ 79 80 =cut 81 82 ################################################################################ 83 # tree of path types 84 ################################################################################ 85 86 our %pathTypes = ( 87 root => { 88 name => 'WeBWorK', 89 parent => '', 90 kids => [ qw/set_list/ ], 91 match => qr|^/|, 92 capture => [ qw// ], 93 produce => '/', 94 display => 'WeBWorK::ContentGenerator::Home', 95 }, 96 97 ################################################################################ 98 99 set_list => { 100 name => '$courseID', 101 parent => 'root', 102 kids => [ qw/equation_display feedback gateway_quiz grades hardcopy 103 logout options instructor_tools problem_list 104 / ], 105 match => qr|^([^/]+)/|, 106 capture => [ qw/courseID/ ], 107 produce => '$courseID/', 108 display => 'WeBWorK::ContentGenerator::ProblemSets', 109 }, 110 111 ################################################################################ 112 113 equation_display => { 114 name => 'Equation Display', 115 parent => 'set_list', 116 kids => [ qw// ], 117 match => qr|^equation/|, 118 capture => [ qw// ], 119 produce => 'equation/', 120 display => 'WeBWorK::ContentGenerator::EquationDisplay', 121 }, 122 feedback => { 123 name => 'Feedback', 124 parent => 'set_list', 125 kids => [ qw// ], 126 match => qr|^feedback/|, 127 capture => [ qw// ], 128 produce => 'feedback/', 129 display => 'WeBWorK::ContentGenerator::Feedback', 130 }, 131 gateway_quiz => { 132 name => 'Gateway Quiz $setID', 133 parent => 'set_list', 134 kids => [ qw// ], 135 match => qr|^quiz_mode/([^/]+)/|, 136 capture => [ qw/setID/ ], 137 produce => 'quiz_mode/$setID/', 138 display => 'WeBWorK::ContentGenerator::GatewayQuiz', 139 }, 140 grades => { 141 name => 'Student Grades', 142 parent => 'set_list', 143 kids => [ qw// ], 144 match => qr|^grades/|, 145 capture => [ qw// ], 146 produce => 'grades/', 147 display => 'WeBWorK::ContentGenerator::Grades', 148 }, 149 hardcopy => { 150 name => 'Hardcopy Generator', 151 parent => 'set_list', 152 kids => [ qw// ], 153 match => qr|^hardcopy/|, 154 capture => [ qw// ], 155 produce => 'hardcopy/', 156 display => 'WeBWorK::ContentGenerator::Hardcopy', 157 }, 158 hardcopy_preselect_set => { 159 name => 'Hardcopy Generator', 160 parent => 'hardcopy', 161 kids => [ qw// ], 162 match => qr|^([^/]+)/|, 163 capture => [ qw/setID/ ], 164 produce => '$setID/', 165 display => 'WeBWorK::ContentGenerator::Hardcopy', 166 }, 167 logout => { 168 name => 'Log Out', 169 parent => 'set_list', 170 kids => [ qw// ], 171 match => qr|^logout/|, 172 capture => [ qw// ], 173 produce => 'logout/', 174 display => 'WeBWorK::ContentGenerator::Logout', 175 }, 176 options => { 177 name => 'User Options', 178 parent => 'set_list', 179 kids => [ qw// ], 180 match => qr|^options/|, 181 capture => [ qw// ], 182 produce => 'options/', 183 display => 'WeBWorK::ContentGenerator::Options', 184 }, 185 186 ################################################################################ 187 188 instructor_tools => { 189 name => 'Instructor Tools', 190 parent => 'set_list', 191 kids => [ qw/instructor_user_list instructor_set_list instructor_add_users 192 instructor_set_assigner instructor_file_transfer instructor_problem_editor 193 instructor_scoring instructor_scoring_download instructor_mail_merge 194 instructor_answer_log instructor_statistics 195 / ], 196 match => qr|^instructor/|, 197 capture => [ qw// ], 198 produce => 'instructor/', 199 display => 'WeBWorK::ContentGenerator::Instructor::Index', 200 }, 201 202 ################################################################################ 203 204 instructor_user_list => { 205 name => 'User List', 206 parent => 'instructor_tools', 207 kids => [ qw/instructor_user_detail/ ], 208 match => qr|^users/|, 209 capture => [ qw// ], 210 produce => 'users/', 211 display => 'WeBWorK::ContentGenerator::Instructor::UserList', 212 }, 213 instructor_user_detail => { 214 name => '$userID', 215 parent => 'instructor_user_list', 216 kids => [ qw/instructor_sets_assigned_to_user/ ], 217 match => qr|^([^/]+)/|, 218 capture => [ qw/userID/ ], 219 produce => '$userID/', 220 display => 'WeBWorK::ContentGenerator::Instructor::UserDetail', 221 }, 222 instructor_sets_assigned_to_user => { 223 name => 'Sets Assigned to User', 224 parent => 'instructor_tools', 225 kids => [ qw/instructor_user_detail/ ], 226 match => qr|^sets/|, 227 capture => [ qw// ], 228 produce => 'sets/', 229 display => 'WeBWorK::ContentGenerator::Instructor::SetsAssignedToUser', 230 }, 231 232 ################################################################################ 233 234 instructor_set_list => { 235 name => 'Set List', 236 parent => 'instructor_tools', 237 kids => [ qw/instructor_set_detail/ ], 238 match => qr|^sets/|, 239 capture => [ qw// ], 240 produce => 'sets/', 241 display => 'WeBWorK::ContentGenerator::Instructor::ProblemSetList', 242 }, 243 instructor_set_detail => { 244 name => '$setID', 245 parent => 'instructor_set_list', 246 kids => [ qw/instructor_problem_list instructor_users_assigned_to_set/ ], 247 match => qr|^([^/]+)/|, 248 capture => [ qw/setID/ ], 249 produce => '$setID/', 250 display => 'WeBWorK::ContentGenerator::Instructor::ProblemSetEditor', 251 }, 252 instructor_problem_list => { 253 name => 'Problems', 254 parent => 'instructor_set_detail', 255 kids => [ qw// ], 256 match => qr|^problems/|, 257 capture => [ qw// ], 258 produce => 'problems/', 259 display => 'WeBWorK::ContentGenerator::Instructor::ProblemList', 260 }, 261 instructor_users_assigned_to_set => { 262 name => 'Users Assigned to Set', 263 parent => 'instructor_set_detail', 264 kids => [ qw// ], 265 match => qr|^users/|, 266 capture => [ qw// ], 267 produce => 'users/', 268 display => 'WeBWorK::ContentGenerator::Instructor::UsersAssignedToSet', 269 }, 270 271 ################################################################################ 272 273 instructor_add_users => { 274 name => 'Add Users', 275 parent => 'instructor_tools', 276 kids => [ qw// ], 277 match => qr|^add_users/|, 278 capture => [ qw// ], 279 produce => 'add_users/', 280 display => 'WeBWorK::ContentGenerator::Instructor::AddUsers', 281 }, 282 instructor_set_assigner => { 283 name => 'Set Assigner', 284 parent => 'instructor_tools', 285 kids => [ qw// ], 286 match => qr|^assigner/|, 287 capture => [ qw// ], 288 produce => 'assigner/', 289 display => 'WeBWorK::ContentGenerator::Instructor::Assigner', 290 }, 291 instructor_file_transfer => { 292 name => 'File Transfer', 293 parent => 'instructor_tools', 294 kids => [ qw// ], 295 match => qr|^files/|, 296 capture => [ qw// ], 297 produce => 'files/', 298 display => 'WeBWorK::ContentGenerator::Instructor::FileXfer', 299 }, 300 instructor_problem_editor => { 301 name => 'Problem Editor', 302 parent => 'instructor_tools', 303 kids => [ qw/instructor_problem_editor_withset/ ], 304 match => qr|^pgProblemEditor/|, 305 capture => [ qw// ], 306 produce => 'pgProblemEditor/', 307 display => '', 308 }, 309 instructor_problem_editor_withset => { 310 name => 'Problem Editor', 311 parent => 'instructor_problem_editor', 312 kids => [ qw/instructor_problem_editor_withset_withproblem/ ], 313 match => qr|^([^/]+)/|, 314 capture => [ qw/setID/ ], 315 produce => '$setID/', 316 display => '', 317 }, 318 instructor_problem_editor_withset_withproblem => { 319 name => 'Problem Editor', 320 parent => 'instructor_problem_editor_withset', 321 kids => [ qw// ], 322 match => qr|^([^/]+)/|, 323 capture => [ qw/problemID/ ], 324 produce => '$problemID/', 325 display => 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', 326 }, 327 instructor_scoring => { 328 name => 'Scoring Tools', 329 parent => 'instructor_tools', 330 kids => [ qw// ], 331 match => qr|^scoring/|, 332 capture => [ qw// ], 333 produce => 'scoring/', 334 display => 'WeBWorK::ContentGenerator::Instructor::Scoring', 335 }, 336 instructor_scoring_download => { 337 name => 'Scoring Download', 338 parent => 'instructor_tools', 339 kids => [ qw// ], 340 match => qr|^scoringDownload/|, 341 capture => [ qw// ], 342 produce => 'scoringDownload/', 343 display => 'WeBWorK::ContentGenerator::Instructor::ScoringDownload', 344 }, 345 instructor_mail_merge => { 346 name => 'Mail Merge', 347 parent => 'instructor_tools', 348 kids => [ qw// ], 349 match => qr|^send_mail/|, 350 capture => [ qw// ], 351 produce => 'send_mail/', 352 display => 'WeBWorK::ContentGenerator::Instructor::SendMail', 353 }, 354 instructor_answer_log => { 355 name => 'Answer Log', 356 parent => 'instructor_tools', 357 kids => [ qw// ], 358 match => qr|^show_answers/|, 359 capture => [ qw// ], 360 produce => 'show_answers/', 361 display => 'WeBWorK::ContentGenerator::Instructor::ShowAnswers', 362 }, 363 364 ################################################################################ 365 366 instructor_statistics => { 367 name => 'Statistics', 368 parent => 'instructor_tools', 369 kids => [ qw/instructor_set_statistics instructor_user_statistics/ ], 370 match => qr|^stats/|, 371 capture => [ qw// ], 372 produce => 'stats/', 373 display => 'WeBWorK::ContentGenerator::Instructor::Stats', 374 }, 375 instructor_set_statistics => { 376 name => 'Statistics', 377 parent => 'instructor_statistics', 378 kids => [ qw// ], 379 match => qr|^(set)/([^/]+)/|, 380 capture => [ qw/statType setID/ ], 381 produce => 'set/$setID/', 382 display => 'WeBWorK::ContentGenerator::Instructor::Stats', 383 }, 384 instructor_user_statistics => { 385 name => 'Statistics', 386 parent => 'instructor_statistics', 387 kids => [ qw// ], 388 match => qr|^(student)/([^/]+)/|, 389 capture => [ qw/statType userID/ ], 390 produce => 'student/$userID/', 391 display => 'WeBWorK::ContentGenerator::Instructor::Stats', 392 }, 393 394 ################################################################################ 395 396 problem_list => { 397 name => '$setID', 398 parent => 'set_list', 399 kids => [ qw/problem_detail/ ], 400 match => qr|^([^/]+)/|, 401 capture => [ qw/setID/ ], 402 produce => '$setID/', 403 display => 'WeBWorK::ContentGenerator::ProblemSet', 404 }, 405 problem_detail => { 406 name => '$problemID', 407 parent => 'problem_list', 408 kids => [ qw// ], 409 match => qr|^([^/]+)/|, 410 capture => [ qw/problemID/ ], 411 produce => '$problemID/', 412 display => 'WeBWorK::ContentGenerator::Problem', 413 }, 414 415 ); 416 417 =for comment 418 419 a handy template: 420 421 id => { 422 name => '', 423 parent => '', 424 kids => [ qw// ], 425 match => qr|^/|, 426 capture => [ qw// ], 427 produce => '', 428 display => '', 429 }, 430 431 =cut 432 433 ################################################################################ 434 435 =head1 CONSTRUCTORS 436 437 =over 438 439 =item new(%fields) 440 441 Creates a new WeBWorK::URLPath. %fields may contain the following: 442 443 type => the internal path type associated with this 444 args => a reference to a hash associating path arguments with values 445 446 This constructor is used internally. Refer to newFromPath() and newFromModule() 447 for more useful constructors. 448 449 =cut 450 451 sub new { 452 my ($invocant, %fields) = @_; 453 my $class = ref $invocant || $invocant; 454 my $self = { 455 type => undef, 456 args => {}, 457 %fields, 458 }; 459 return bless $self, $class; 460 } 461 462 =item newFromPath($path) 463 464 Creates a new WeBWorK::URLPath by parsing the path given in $path. It the path 465 is invalid, an exception is thrown. 466 467 =cut 468 469 sub newFromPath { 470 my ($invocant, $path) = @_; 471 472 my ($type, %args) = getPathType($path); 473 die "no type matches path $path" unless $type; 474 475 return $invocant->new( 476 type => $type, 477 args => \%args, 478 ); 479 } 480 481 =item newFromModule($module, %args) 482 483 Creates a new WeBWorK::URLPath by finding a path type which matches the module 484 and path arguments given. If no type matches, an exception is thrown. 485 486 =cut 487 488 sub newFromModule { 489 my ($invocant, $module, %args) = @_; 490 491 my $type = getModuleType($module, keys %args); 492 die "no type matches module $module with args", map { " $_=>$args{$_}" } keys %args unless $type; 493 494 return $invocant->new( 495 type => $type, 496 args => \%args 497 ); 498 } 499 500 =back 501 502 =cut 503 504 ################################################################################ 505 506 =head1 METHODS 507 508 =head2 Methods that return information from the object itself 509 510 =over 511 512 =item type() 513 514 Returns the path type of the WeBWorK::URLPath. 515 516 =cut 517 518 sub type { 519 my ($self) = @_; 520 my $type = $self->{type}; 521 522 return $type; 523 } 524 525 =item args() 526 527 Returns a hash of arguments derived from the WeBWorK::URLPath. 528 529 =cut 530 531 sub args { 532 my ($self) = @_; 533 my %args = %{ $self->{args} }; 534 535 return %args; 536 } 537 538 =item arg($name) 539 540 Returns the named argument, as derived from the WeBWorK::URLPath. 541 542 =cut 543 544 sub arg { 545 my ($self, $name) = @_; 546 my %args = %{ $self->{args} }; 547 548 return $args{$name}; 549 } 550 551 =back 552 553 =cut 554 555 # ------------------------------------------------------------------------------ 556 557 =head2 Methods that return information from path node associated with the object 558 559 =over 560 561 =item name() 562 563 Returns the human-readable name of this WeBWorK::URLPath. 564 565 =cut 566 567 sub name { 568 my ($self) = @_; 569 my $type = $self->{type}; 570 my %args = $self->args; 571 572 my $name = $pathTypes{$type}->{name}; 573 $name = interpolate($name, %args); 574 575 return $name; 576 } 577 578 =item module() 579 580 Returns the name of the module that will handle this WeBWorK::URLPath. 581 582 =cut 583 584 sub module { 585 my ($self) = @_; 586 my $type = $self->{type}; 587 588 return $pathTypes{$type}->{display}; 589 } 590 591 =back 592 593 =cut 594 595 # ------------------------------------------------------------------------------ 596 597 =head2 Methods that search the virtual heirarchy 598 599 =over 600 601 =item parent() 602 603 Returns a new WeBWorK::URLPath representing the parent of the current URLPath. 604 Returns an undefined value if the URLPath has no parent. 605 606 =cut 607 608 sub parent { 609 my ($self) = @_; 610 my $type = $self->{type}; 611 612 my $newType = $pathTypes{$self->{type}}->{parent}; 613 return undef unless $newType; 614 615 # remove any arguments added by the current node (and therefore not needed by the parent) 616 my @currArgs = @{ $pathTypes{$type}->{capture} }; 617 my %newArgs = %{ $self->{args} }; 618 delete @newArgs{@currArgs} if @currArgs; 619 620 return $self->new(type => $newType, args => \%newArgs); 621 } 622 623 =item child($module, %newArgs) 624 625 Returns a new WeBWorK::URLPath representing the child of the current URLPath 626 whose module is C<$module>. If no child matches, an undefined value is returned. 627 Pass additional arguments needed by the child in C<%newArgs>. 628 629 =cut 630 631 sub child { 632 my ($self, $module, %newArgs) = @_; 633 my $type = $self->{type}; 634 635 my @kids = @{ $pathTypes{$type}->{kids} }; 636 my $newType; 637 foreach my $kid (@kids) { 638 if ($pathTypes{$kid}->{module} eq $module) { 639 $newType = $kid; 640 last; 641 } 642 } 643 644 if ($newType) { 645 return $self->new(type => $newType, args => \%newArgs); 646 } else { 647 return undef; 648 } 649 } 650 651 =item path() 652 653 Reconstructs the path string from a WeBWorK::URLPath. 654 655 =cut 656 657 sub path { 658 my ($self) = @_; 659 my $type = $self->type; 660 my %args = %{ $self->{args} }; 661 662 my $path = buildPathFromType($type); 663 $path = interpolate($path, %args); 664 665 return $path; 666 } 667 668 =back 669 670 =cut 671 672 ################################################################################ 673 674 =head1 UTILITY FUNCTIONS 675 676 =head2 677 678 =over 679 680 =item interpolate($string, %symbols) 681 682 Replaces simple scalars (\$\w+) in $string with values in %symbols. If a scalar 683 does not exist in %symbols, it is left alone. 684 685 =cut 686 687 sub interpolate { 688 my ($string, %symbols) = @_; 689 690 $string =~ s/\$(\w+)/exists $symbols{$1} ? $symbols{$1} : "\$$1"/eg; 691 692 return $string; 693 } 694 695 =back 696 697 =cut 698 699 # ------------------------------------------------------------------------------ 700 701 =head2 702 703 =over 704 705 =item getPathType($path) 706 707 Parse the string $path, determining the path type. Returns ($type, %args), where 708 $type is the type of the path and %args contains any extracted path arguments. 709 If conversion fails, a false value is returned. 710 711 =cut 712 713 sub getPathType($) { 714 my ($path) = @_; 715 716 my %args; 717 my $context = visitPathTypeNode("root", $path, \%args, 0); 718 719 return $context, %args; 720 } 721 722 =item getModuleType($module, @args) 723 724 Returns the path type matching the given module and argument names, or a false 725 value if no type matches. 726 727 =cut 728 729 sub getModuleType { 730 my ($module, @args) = @_; 731 @args = sort @args; 732 my %args; 733 @args{@args} = (); 734 735 NODE: foreach my $nodeID (keys %pathTypes) { 736 my $node = $pathTypes{$nodeID}; 737 738 # module name matches? 739 next NODE unless $node->{display} eq $module; 740 741 # collect all captures from here to root 742 my @captures; 743 my $tmpNodeID = $nodeID; 744 while ($tmpNodeID) { 745 my $tmpNode = $pathTypes{$tmpNodeID}; 746 push @captures, @{ $tmpNode->{capture} }; 747 $tmpNodeID = $tmpNode->{parent}; 748 } 749 750 # same number of captures? 751 next NODE unless @captures == @args; 752 753 # same captures? 754 @captures = sort @captures; 755 for (my $i = 0; $i < @args; $i++) { 756 next NODE unless $args[$i] eq $captures[$i]; 757 } 758 759 # if we got here, this node matches 760 return $nodeID; 761 } 762 763 return 0; # no node matches 764 } 765 766 =item buildPathFromType($type) 767 768 Returns a string path for the given path type. Since arguments are not supplied, 769 the string may contain scalar variables ripe for interpolation. 770 771 =cut 772 773 sub buildPathFromType($) { 774 my ($type) = @_; 775 776 my $path = ""; 777 778 while ($type) { 779 $path = $pathTypes{$type}->{produce} . $path; 780 $type = $pathTypes{$type}->{parent}; 781 }; 782 783 return $path; 784 } 785 786 =item visitPathTypeNode($nodeID, $path, $argsRef, $indent) 787 788 Internal search function. See getPathType(). 789 790 =cut 791 792 sub visitPathTypeNode($$$$); 793 794 sub visitPathTypeNode($$$$) { 795 my ($nodeID, $path, $argsRef, $indent) = @_; 796 debug("visitPathTypeNode", $indent, "visiting node $nodeID with path $path\n"); 797 798 unless (exists $pathTypes{$nodeID}) { 799 debug("visitPathTypeNode", $indent, "node $nodeID doesn't exist in node list: failed\n"); 800 die "node $nodeID doesn't exist in node list: failed"; 801 } 802 803 my %node = %{ $pathTypes{$nodeID} }; 804 my $match = $node{match}; 805 my @capture_names = @{ $node{capture} }; 806 807 debug("visitPathTypeNode", $indent, "trying to match $match: "); 808 if ($path =~ s/($match)//) { 809 debug("", 0, "success!\n"); 810 my @capture_values = $1 =~ m/$match/; 811 if (@capture_names) { 812 my $nexpected = @capture_names; 813 my $ncaptured = @capture_values; 814 my $max = $nexpected > $ncaptured ? $nexpected : $ncaptured; 815 warn "captured $ncaptured arguments, expected $nexpected." unless $ncaptured == $nexpected; 816 for (my $i = 0; $i < $max; $i++) { 817 my $name = $capture_names[$i]; 818 my $value = $capture_values[$i]; 819 if ($i > $nexpected) { 820 warn "captured an unexpected argument: $value -- ignoring it."; 821 next; 822 } 823 if ($i > $ncaptured) { 824 warn "expected an uncaptured argument named: $name -- ignoring it."; 825 next; 826 } 827 if (exists $argsRef->{$name}) { 828 my $old = $argsRef->{$name}; 829 warn "encountered an existing argument again, old value: $old new value: $value -- replacing."; 830 } 831 debug("visitPathTypeNode", $indent, "setting argument $name => $value.\n"); 832 $argsRef->{$name} = $value; 833 } 834 } 835 } else { 836 debug("", 0, "failed.\n"); 837 return 0; 838 } 839 840 if ($path eq "") { 841 debug("visitPathTypeNode", $indent, "no path left, type is $nodeID\n"); 842 return $nodeID; 843 } 844 845 debug("visitPathTypeNode", $indent, "but path remains: $path\n"); 846 my @kids = @{ $node{kids} }; 847 if (@kids) { 848 foreach my $kid (@kids) { 849 debug("visitPathTypeNode", $indent, "trying child $kid:\n"); 850 my $result = visitPathTypeNode($kid, $path, $argsRef, $indent+1); 851 return $result if $result; 852 } 853 debug("visitPathTypeNode", $indent, "no children claimed the remaining path: failed.\n"); 854 } else { 855 debug("visitPathTypeNode", $indent, "no children to claim the remaining path: failed.\n"); 856 } 857 return 0; 858 } 859 860 =back 861 862 =cut 863 864 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |