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