Parent Directory
| 
Revision Log
precompile many modules at server start time. this allows more compiled code (parse trees, bytecode, etc.) to be shared among child processes, and speeds child start time, since that compilation has already been done in the master process. you may want to turn this off for development, since it makes the server take a really long time to start.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/URLPath.pm,v 1.32 2006/09/01 17:28: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 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_transfer 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_transfer => { 371 name => 'File Transfer', 372 parent => 'instructor_tools', 373 kids => [ qw// ], 374 match => qr|^file_xfer/|, 375 capture => [ qw// ], 376 produce => 'file_xfer/', 377 display => 'WeBWorK::ContentGenerator::Instructor::FileXfer', 378 }, 379 instructor_file_manager => { 380 name => 'File Manager', 381 parent => 'instructor_tools', 382 kids => [ qw// ], 383 match => qr|^file_manager/|, 384 capture => [ qw// ], 385 produce => 'file_manager/', 386 display => 'WeBWorK::ContentGenerator::Instructor::FileManager', 387 }, 388 instructor_problem_editor => { 389 name => 'Problem Editor', 390 parent => 'instructor_tools', 391 kids => [ qw/instructor_problem_editor_withset/ ], 392 match => qr|^pgProblemEditor/|, 393 capture => [ qw// ], 394 produce => 'pgProblemEditor/', 395 display => 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', 396 }, 397 instructor_problem_editor_withset => { 398 name => '$setID', 399 parent => 'instructor_problem_editor', 400 kids => [ qw/instructor_problem_editor_withset_withproblem/ ], 401 match => qr|^([^/]+)/|, 402 capture => [ qw/setID/ ], 403 produce => '$setID/', 404 display => undef, 405 }, 406 instructor_problem_editor_withset_withproblem => { 407 name => '$problemID', 408 parent => 'instructor_problem_editor_withset', 409 kids => [ qw// ], 410 match => qr|^([^/]+)/|, 411 capture => [ qw/problemID/ ], 412 produce => '$problemID/', 413 display => 'WeBWorK::ContentGenerator::Instructor::PGProblemEditor', 414 }, 415 instructor_scoring => { 416 name => 'Scoring Tools', 417 parent => 'instructor_tools', 418 kids => [ qw// ], 419 match => qr|^scoring/|, 420 capture => [ qw// ], 421 produce => 'scoring/', 422 display => 'WeBWorK::ContentGenerator::Instructor::Scoring', 423 }, 424 instructor_scoring_download => { 425 name => 'Scoring Download', 426 parent => 'instructor_tools', 427 kids => [ qw// ], 428 match => qr|^scoringDownload/|, 429 capture => [ qw// ], 430 produce => 'scoringDownload/', 431 display => 'WeBWorK::ContentGenerator::Instructor::ScoringDownload', 432 }, 433 instructor_mail_merge => { 434 name => 'Email', 435 parent => 'instructor_tools', 436 kids => [ qw// ], 437 match => qr|^send_mail/|, 438 capture => [ qw// ], 439 produce => 'send_mail/', 440 display => 'WeBWorK::ContentGenerator::Instructor::SendMail', 441 }, 442 instructor_answer_log => { 443 name => 'Answer Log', 444 parent => 'instructor_tools', 445 kids => [ qw// ], 446 match => qr|^show_answers/|, 447 capture => [ qw// ], 448 produce => 'show_answers/', 449 display => 'WeBWorK::ContentGenerator::Instructor::ShowAnswers', 450 }, 451 instructor_preflight => { 452 name => 'Preflight Log', 453 parent => 'instructor_tools', 454 kids => [ qw// ], 455 match => qr|^preflight/|, 456 capture => [ qw// ], 457 produce => 'preflight/', 458 display => 'WeBWorK::ContentGenerator::Instructor::Preflight', 459 }, 460 461 ################################################################################ 462 463 instructor_statistics => { 464 name => 'Statistics', 465 parent => 'instructor_tools', 466 kids => [ qw/instructor_set_statistics instructor_user_statistics/ ], 467 match => qr|^stats/|, 468 capture => [ qw// ], 469 produce => 'stats/', 470 display => 'WeBWorK::ContentGenerator::Instructor::Stats', 471 }, 472 instructor_set_statistics => { 473 name => 'Statistics', 474 parent => 'instructor_statistics', 475 kids => [ qw// ], 476 match => qr|^(set)/([^/]+)/|, 477 capture => [ qw/statType setID/ ], 478 produce => 'set/$setID/', 479 display => 'WeBWorK::ContentGenerator::Instructor::Stats', 480 }, 481 instructor_user_statistics => { 482 name => 'Statistics', 483 parent => 'instructor_statistics', 484 kids => [ qw// ], 485 match => qr|^(student)/([^/]+)/|, 486 capture => [ qw/statType userID/ ], 487 produce => 'student/$userID/', 488 display => 'WeBWorK::ContentGenerator::Instructor::Stats', 489 }, 490 491 ################################################################################ 492 493 instructor_progress => { 494 name => 'Student Progress', 495 parent => 'instructor_tools', 496 kids => [ qw/instructor_set_progress instructor_user_progress/ ], 497 match => qr|^progress/|, 498 capture => [ qw// ], 499 produce => 'progress/', 500 display => 'WeBWorK::ContentGenerator::Instructor::StudentProgress', 501 }, 502 instructor_set_progress => { 503 name => 'Student Progress', 504 parent => 'instructor_progress', 505 kids => [ qw// ], 506 match => qr|^(set)/([^/]+)/|, 507 capture => [ qw/statType setID/ ], 508 produce => 'set/$setID/', 509 display => 'WeBWorK::ContentGenerator::Instructor::StudentProgress', 510 }, 511 instructor_user_progress => { 512 name => 'Student Progress', 513 parent => 'instructor_progress', 514 kids => [ qw// ], 515 match => qr|^(student)/([^/]+)/|, 516 capture => [ qw/statType userID/ ], 517 produce => 'student/$userID/', 518 display => 'WeBWorK::ContentGenerator::Instructor::StudentProgress', 519 }, 520 521 ################################################################################ 522 523 problem_list => { 524 name => '$setID', 525 parent => 'set_list', 526 kids => [ qw/problem_detail/ ], 527 match => qr|^([^/]+)/|, 528 capture => [ qw/setID/ ], 529 produce => '$setID/', 530 display => 'WeBWorK::ContentGenerator::ProblemSet', 531 }, 532 problem_detail => { 533 name => '$problemID', 534 parent => 'problem_list', 535 kids => [ qw// ], 536 match => qr|^([^/]+)/|, 537 capture => [ qw/problemID/ ], 538 produce => '$problemID/', 539 display => 'WeBWorK::ContentGenerator::Problem', 540 }, 541 542 ); 543 544 =for comment 545 546 a handy template: 547 548 id => { 549 name => '', 550 parent => '', 551 kids => [ qw// ], 552 match => qr|^/|, 553 capture => [ qw// ], 554 produce => '', 555 display => '', 556 }, 557 558 =cut 559 560 ################################################################################ 561 562 =head1 CONSTRUCTORS 563 564 =over 565 566 =item new(%fields) 567 568 Creates a new WeBWorK::URLPath. %fields may contain the following: 569 570 type => the internal path type associated with this 571 args => a reference to a hash associating path arguments with values 572 573 This constructor is used internally. Refer to newFromPath() and newFromModule() 574 for more useful constructors. 575 576 =cut 577 578 sub new { 579 my ($invocant, %fields) = @_; 580 my $class = ref $invocant || $invocant; 581 my $self = { 582 type => undef, 583 args => {}, 584 %fields, 585 }; 586 return bless $self, $class; 587 } 588 589 =item newFromPath($path) 590 591 Creates a new WeBWorK::URLPath by parsing the path given in $path. It the path 592 is invalid, an exception is thrown. 593 594 =cut 595 596 sub newFromPath { 597 my ($invocant, $path) = @_; 598 599 my ($type, %args) = getPathType($path); 600 croak "no type matches path $path" unless $type; 601 602 return $invocant->new( 603 type => $type, 604 args => \%args, 605 ); 606 } 607 608 =item newFromModule($module, %args) 609 610 Creates a new WeBWorK::URLPath by finding a path type which matches the module 611 and path arguments given. If no type matches, an exception is thrown. 612 613 =cut 614 615 sub newFromModule { 616 my ($invocant, $module, %args) = @_; 617 618 my $type = getModuleType($module, keys %args); 619 croak "no type matches module $module with args", map { " $_=>$args{$_}" } keys %args unless $type; 620 621 return $invocant->new( 622 type => $type, 623 args => \%args 624 ); 625 } 626 627 =back 628 629 =cut 630 631 ################################################################################ 632 633 =head1 METHODS 634 635 =head2 Methods that return information from the object itself 636 637 =over 638 639 =item type() 640 641 Returns the path type of the WeBWorK::URLPath. 642 643 =cut 644 645 sub type { 646 my ($self) = @_; 647 my $type = $self->{type}; 648 649 return $type; 650 } 651 652 =item args() 653 654 Returns a hash of arguments derived from the WeBWorK::URLPath. 655 656 =cut 657 658 sub args { 659 my ($self) = @_; 660 my %args = %{ $self->{args} }; 661 662 return %args; 663 } 664 665 =item arg($name) 666 667 Returns the named argument, as derived from the WeBWorK::URLPath. 668 669 =cut 670 671 sub arg { 672 my ($self, $name) = @_; 673 my %args = %{ $self->{args} }; 674 675 return $args{$name}; 676 } 677 678 =back 679 680 =cut 681 682 # ------------------------------------------------------------------------------ 683 684 =head2 Methods that return information from path node associated with the object 685 686 =over 687 688 =item name() 689 690 Returns the human-readable name of this WeBWorK::URLPath. 691 692 =cut 693 694 sub name { 695 my ($self) = @_; 696 my $type = $self->{type}; 697 my %args = $self->args; 698 699 my $name = $pathTypes{$type}->{name}; 700 $name = interpolate($name, %args); 701 702 return $name; 703 } 704 705 =item module() 706 707 Returns the name of the module that will handle this WeBWorK::URLPath. 708 709 =cut 710 711 sub module { 712 my ($self) = @_; 713 my $type = $self->{type}; 714 715 return $pathTypes{$type}->{display}; 716 } 717 718 =back 719 720 =cut 721 722 # ------------------------------------------------------------------------------ 723 724 =head2 Methods that search the virtual heirarchy 725 726 =over 727 728 =item parent() 729 730 Returns a new WeBWorK::URLPath representing the parent of the current URLPath. 731 Returns an undefined value if the URLPath has no parent. 732 733 =cut 734 735 sub parent { 736 my ($self) = @_; 737 my $type = $self->{type}; 738 739 my $newType = $pathTypes{$self->{type}}->{parent}; 740 return undef unless $newType; 741 742 # remove any arguments added by the current node (and therefore not needed by the parent) 743 my @currArgs = @{ $pathTypes{$type}->{capture} }; 744 my %newArgs = %{ $self->{args} }; 745 delete @newArgs{@currArgs} if @currArgs; 746 747 return $self->new(type => $newType, args => \%newArgs); 748 } 749 750 =item child($module, %newArgs) 751 752 Returns a new WeBWorK::URLPath representing the child of the current URLPath 753 whose module is C<$module>. If no child matches, an undefined value is returned. 754 Pass additional arguments needed by the child in C<%newArgs>. 755 756 =cut 757 758 sub child { 759 my ($self, $module, %newArgs) = @_; 760 my $type = $self->{type}; 761 762 my @kids = @{ $pathTypes{$type}->{kids} }; 763 my $newType; 764 foreach my $kid (@kids) { 765 if ($pathTypes{$kid}->{module} eq $module) { 766 $newType = $kid; 767 last; 768 } 769 } 770 771 if ($newType) { 772 return $self->new(type => $newType, args => \%newArgs); 773 } else { 774 return undef; 775 } 776 } 777 778 =item path() 779 780 Reconstructs the path string from a WeBWorK::URLPath. 781 782 =cut 783 784 sub path { 785 my ($self) = @_; 786 my $type = $self->type; 787 my %args = %{ $self->{args} }; 788 789 my $path = buildPathFromType($type); 790 $path = interpolate($path, %args); 791 792 return $path; 793 } 794 795 =back 796 797 =cut 798 799 ################################################################################ 800 801 =head1 UTILITY FUNCTIONS 802 803 =over 804 805 =item all_modules() 806 807 Return a list of the display modules associated with all possible path types. 808 809 =cut 810 811 sub all_modules { 812 my @modules = grep { defined } map { $pathTypes{$_}{display} } keys %pathTypes; 813 my %modules; @modules{@modules} = (); # remove duplicates 814 return keys %modules; 815 } 816 817 =item interpolate($string, %symbols) 818 819 Replaces simple scalars (\$\w+) in $string with values in %symbols. If a scalar 820 does not exist in %symbols, it is left alone. 821 822 =cut 823 824 sub interpolate { 825 my ($string, %symbols) = @_; 826 827 $string =~ s/\$(\w+)/exists $symbols{$1} ? $symbols{$1} : "\$$1"/eg; 828 829 return $string; 830 } 831 832 =back 833 834 =cut 835 836 # ------------------------------------------------------------------------------ 837 838 =over 839 840 =item getPathType($path) 841 842 Parse the string $path, determining the path type. Returns ($type, %args), where 843 $type is the type of the path and %args contains any extracted path arguments. 844 If conversion fails, a false value is returned. 845 846 =cut 847 848 sub getPathType($) { 849 my ($path) = @_; 850 851 my %args; 852 my $context = visitPathTypeNode("root", $path, \%args, 0); 853 854 return $context, %args; 855 } 856 857 =item getModuleType($module, @args) 858 859 Returns the path type matching the given module and argument names, or a false 860 value if no type matches. 861 862 =cut 863 864 sub getModuleType { 865 my ($module, @args) = @_; 866 @args = sort @args; 867 my %args; 868 @args{@args} = (); 869 870 NODE: foreach my $nodeID (keys %pathTypes) { 871 my $node = $pathTypes{$nodeID}; 872 873 # module name matches? 874 next NODE unless defined $node->{display} and $node->{display} eq $module; 875 876 # collect all captures from here to root 877 my @captures; 878 my $tmpNodeID = $nodeID; 879 while ($tmpNodeID) { 880 my $tmpNode = $pathTypes{$tmpNodeID}; 881 push @captures, @{ $tmpNode->{capture} }; 882 $tmpNodeID = $tmpNode->{parent}; 883 } 884 885 # same number of captures? 886 next NODE unless @captures == @args; 887 888 # same captures? 889 @captures = sort @captures; 890 for (my $i = 0; $i < @args; $i++) { 891 next NODE unless $args[$i] eq $captures[$i]; 892 } 893 894 # if we got here, this node matches 895 return $nodeID; 896 } 897 898 return 0; # no node matches 899 } 900 901 =item buildPathFromType($type) 902 903 Returns a string path for the given path type. Since arguments are not supplied, 904 the string may contain scalar variables ripe for interpolation. 905 906 =cut 907 908 sub buildPathFromType($) { 909 my ($type) = @_; 910 911 my $path = ""; 912 913 while ($type) { 914 $path = $pathTypes{$type}->{produce} . $path; 915 $type = $pathTypes{$type}->{parent}; 916 }; 917 918 return $path; 919 } 920 921 =item visitPathTypeNode($nodeID, $path, $argsRef, $indent) 922 923 Internal search function. See getPathType(). 924 925 Returns the nodeID of the node that consumed the final characters in $path, or 926 the following failure conditions: 927 928 Returns 0 if $nodeID doesn't match $path. 929 930 Returns -1 if $nodeID matched $path, but no children of $nodeID consumed the 931 remaining path. In this case, the stack is unwound immediately. 932 933 =cut 934 935 sub visitPathTypeNode($$$$); 936 937 sub visitPathTypeNode($$$$) { 938 my ($nodeID, $path, $argsRef, $indent) = @_; 939 debug("visitPathTypeNode", $indent, "visiting node $nodeID with path $path"); 940 941 unless (exists $pathTypes{$nodeID}) { 942 debug("visitPathTypeNode", $indent, "node $nodeID doesn't exist in node list: failed"); 943 die "node $nodeID doesn't exist in node list: failed"; 944 } 945 946 my %node = %{ $pathTypes{$nodeID} }; 947 my $match = $node{match}; 948 my @capture_names = @{ $node{capture} }; 949 950 # attempt to match $path against $match. 951 debug("visitPathTypeNode", $indent, "trying to match $match: "); 952 if ($path =~ s/($match)//) { 953 # it matches! store captured strings in $argsRef and remove the matched 954 # characters from $path. waste a lot of lines on sanity checking... ;) 955 debug("", 0, "success!"); 956 my @capture_values = $1 =~ m/$match/; 957 if (@capture_names) { 958 my $nexpected = @capture_names; 959 my $ncaptured = @capture_values; 960 my $max = $nexpected > $ncaptured ? $nexpected : $ncaptured; 961 warn "captured $ncaptured arguments, expected $nexpected." unless $ncaptured == $nexpected; 962 for (my $i = 0; $i < $max; $i++) { 963 my $name = $capture_names[$i]; 964 my $value = $capture_values[$i]; 965 if ($i > $nexpected) { 966 warn "captured an unexpected argument: $value -- ignoring it."; 967 next; 968 } 969 if ($i > $ncaptured) { 970 warn "expected an uncaptured argument named: $name -- ignoring it."; 971 next; 972 } 973 if (exists $argsRef->{$name}) { 974 my $old = $argsRef->{$name}; 975 warn "encountered argument $name again, old value: $old new value: $value -- replacing."; 976 } 977 debug("visitPathTypeNode", $indent, "setting argument $name => $value."); 978 $argsRef->{$name} = $value; 979 } 980 } 981 } else { 982 # it doesn't match. bail out now with return value 0 983 debug("", 0, "failed."); 984 return 0; 985 } 986 987 ##### if we're here we matched ##### 988 989 # if there's no more path left, then this node is the one! return $nodeID 990 if ($path eq "") { 991 debug("visitPathTypeNode", $indent, "no path left, type is $nodeID"); 992 return $nodeID; 993 } 994 995 # otherwise, we have to send the remaining path to the node's children 996 debug("visitPathTypeNode", $indent, "but path remains: $path"); 997 my @kids = @{ $node{kids} }; 998 if (@kids) { 999 foreach my $kid (@kids) { 1000 debug("visitPathTypeNode", $indent, "trying child $kid:"); 1001 my $result = visitPathTypeNode($kid, $path, $argsRef, $indent+1); 1002 # we return in two situations: 1003 # if $result is -1, then the kid matched but couldn't consume the rest of the path 1004 # if $result is the ID of a node, then the kid matched and consumed the rest of the path 1005 # these are all true values (assuming that "0" isn't a valid node ID), so we say: 1006 return $result if $result; 1007 } 1008 debug("visitPathTypeNode", $indent, "no children claimed the remaining path: failed."); 1009 } else { 1010 debug("visitPathTypeNode", $indent, "no children to claim the remaining path: failed."); 1011 } 1012 1013 # in both of the above cases, we matched but couldn't provide children that 1014 # would consume the rest of the path. so we return -1, causing the whole 1015 # stack to unwind. WHEEEEEEE! 1016 return -1; 1017 } 1018 1019 =back 1020 1021 =cut 1022 1023 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |