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