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