[system] / trunk / webwork-modperl / lib / WeBWorK / URLPath.pm Repository:
ViewVC logotype

Annotation of /trunk/webwork-modperl/lib/WeBWorK/URLPath.pm

Parent Directory Parent Directory | Revision Log Revision Log

Revision 2238 - (view) (download) (as text)

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