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