Parent Directory
| 
Revision Log
changed names of display modules in hardcoded path table.
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::URLPath; 7 8 =head1 NAME 9 10 WeBWorK::URLPath - the WeBWorK virtual URL heirarchy. 11 12 =cut 13 14 use strict; 15 use warnings; 16 17 # 18 # NOTE: see below for the implementation of the WeBWorK::URLPath class. 19 # 20 21 ################################################################################ 22 # tree of path types 23 ################################################################################ 24 25 our %pathTypes = ( 26 root => { 27 parent => '', 28 kids => [ qw(course_list) ], 29 match => qr|^/|, 30 capture => '', 31 produce => '/', 32 display => '', 33 }, 34 course_list => { # a 35 parent => 'root', 36 kids => [ qw(course_detail) ], 37 match => qr|^courses/|, 38 capture => '', 39 produce => 'courses/', 40 display => 'WeBWorK::Display::CourseList', 41 }, 42 course_detail => { # b 43 parent => 'course_list', 44 kids => [ qw(user_list_noset_noproblem set_list_nouser) ], 45 match => qr|^(\w+)/|, 46 capture => 'courseID', 47 produce => '$courseID/', 48 display => 'WeBWorK::Display::CourseDetail', 49 }, 50 user_list_noset_noproblem => { # c 51 parent => 'course_detail', 52 kids => [ qw(user_detail) ], 53 match => qr|^users/|, 54 capture => '', 55 produce => 'users/', 56 display => 'WeBWorK::Display::UserList', 57 }, 58 user_detail => { # d 59 parent => 'user_list_noset_noproblem', 60 kids => [ qw(set_list_withuser) ], 61 match => qr|^(\w+)/|, 62 capture => 'userID', 63 produce => '$userID/', 64 display => 'WeBWorK::Display::UserDetail', 65 }, 66 set_list_nouser => { # e 67 parent => 'course_detail', 68 kids => [ qw(set_detail_nouser) ], 69 match => qr|^sets/|, 70 capture => '', 71 produce => 'sets/', 72 display => 'WeBWorK::Display::SetList', 73 }, 74 set_detail_nouser => { # f 75 parent => 'set_list_nouser', 76 kids => [ qw(problem_list_nouser user_list_withset_noproblem) ], 77 match => qr|^(\w+)/|, 78 capture => 'setID', 79 produce => '$setID/', 80 display => 'WeBWorK::Display::SetDetail', 81 }, 82 problem_list_nouser => { # g 83 parent => 'set_detail_nouser', 84 kids => [ qw(probem_detail_nouser) ], 85 match => qr|^problems/|, 86 capture => '', 87 produce => 'problems/', 88 display => 'WeBWorK::Display::ProblemList', 89 }, 90 probem_detail_nouser => { # h 91 parent => 'problem_list_nouser', 92 kids => [ qw(user_list_withset_withproblem) ], 93 match => qr|^(\d+)/|, 94 capture => 'problemID', 95 produce => '$problemID/', 96 display => 'WeBWorK::Display::ProblemDetail', 97 }, 98 set_list_withuser => { # i 99 parent => 'user_detail', 100 kids => [ qw(set_detail_withuser_from_set_list_withuser) ], 101 match => qr|^sets/|, 102 capture => '', 103 produce => 'sets/', 104 display => 'WeBWorK::Display::SetList', 105 }, 106 set_detail_withuser_from_set_list_withuser => { # j 107 parent => 'set_list_withuser', 108 kids => [ qw(problem_list_withuser) ], 109 match => qr|^(\w+)/|, 110 capture => 'setID', 111 produce => '$setID/', 112 display => 'WeBWorK::Display::SetDetail', 113 }, 114 problem_list_withuser => { # k 115 parent => 'set_detail_withuser_from_set_list_withuser', 116 kids => [ qw(problem_detail_withuser_from_problem_list_withuser) ], 117 match => qr|^problems/|, 118 capture => '', 119 produce => 'problems/', 120 display => 'WeBWorK::Display::ProblemList', 121 }, 122 problem_detail_withuser_from_problem_list_withuser => { # l 123 parent => 'problem_list_withuser', 124 kids => [ qw() ], 125 match => qr|^(\d+)/|, 126 capture => 'problemID', 127 produce => '$problemID/', 128 display => 'WeBWorK::Display::ProblemDetail', 129 }, 130 user_list_withset_noproblem => { # m 131 parent => 'set_detail_nouser', 132 kids => [ qw(set_detail_withuser_from_user_list_withset_noproblem) ], 133 match => qr|^users/|, 134 capture => '', 135 produce => 'users/', 136 display => 'WeBWorK::Display::UserList', 137 }, 138 set_detail_withuser_from_user_list_withset_noproblem => { # n 139 parent => 'user_list_withset_noproblem', 140 kids => [ qw() ], 141 match => qr|^(\w+)/|, 142 capture => 'userID', 143 produce => '$userID/', 144 display => 'WeBWorK::Display::SetDetail', 145 }, 146 user_list_withset_withproblem => { # o 147 parent => 'probem_detail_nouser', 148 kids => [ qw(problem_detail_withuser_from_user_list_withset_withproblem) ], 149 match => qr|^users/|, 150 capture => '', 151 produce => 'users/', 152 display => 'WeBWorK::Display::UserList', 153 }, 154 problem_detail_withuser_from_user_list_withset_withproblem => { # p 155 parent => 'user_list_withset_withproblem', 156 kids => [ qw() ], 157 match => qr|^(\w+)/|, 158 capture => 'userID', 159 produce => '$userID/', 160 display => 'WeBWorK::Display::ProblemDetail', 161 }, 162 ); 163 164 ################################################################################ 165 # low level functions for traversing the path types tree 166 ################################################################################ 167 168 sub getpathType($) { 169 my ($path) = @_; 170 171 my %args; 172 my $context = visitPathTypeNode("root", $path, \%args, 0); 173 174 return $context, %args; 175 } 176 177 sub reconstructPath($) { 178 my ($type) = @_; 179 180 my $path = ""; 181 182 while ($type) { 183 $path = $pathTypes{$type}->{produce} . $path; 184 $type = $pathTypes{$type}->{parent}; 185 }; 186 187 return $path; 188 } 189 190 sub visitPathTypeNode($$$$); 191 192 sub visitPathTypeNode($$$$) { 193 my ($nodeID, $path, $argsRef, $indent) = @_; 194 print "\t"x$indent, "visiting node $nodeID with path $path\n"; 195 196 my %node = %{ $pathTypes{$nodeID} }; 197 my $match = $node{match}; 198 199 print "\t"x$indent, "trying to match $match: "; 200 if ($path =~ s/$match//) { 201 print "success!\n"; 202 my $capture = $node{capture}; 203 if ($capture) { 204 print "\t"x$indent, "captured $capture $1\n"; 205 $argsRef->{$capture} = $1; 206 } 207 } else { 208 print "failed.\n"; 209 return 0; 210 } 211 212 if ($path eq "") { 213 print "\t"x$indent, "no path left, type is $nodeID\n"; 214 return $nodeID; 215 } 216 217 print "\t"x$indent, "but path remains: $path\n"; 218 my @kids = @{ $node{kids} }; 219 if (@kids) { 220 foreach my $kid (@kids) { 221 print "\t"x$indent, "trying child $kid:\n"; 222 my $result = visitPathTypeNode($kid, $path, $argsRef, $indent+1); 223 return $result if $result; 224 } 225 print "\t"x$indent, "no children claimed the remaining path: failed.\n"; 226 } else { 227 print "\t"x$indent, "no children to claim the remaining path: failed.\n"; 228 } 229 return 0; 230 } 231 232 ################################################################################ 233 # the WeBWorK::URLPath class 234 ################################################################################ 235 236 =head1 CONSTRUCTORS 237 238 =over 239 240 =item new 241 242 Creates an empty WeBWorK::URLPath. Don't use this, use C<newFromPath> instead. 243 244 =cut 245 246 sub new { 247 my ($invocant, %fields) = @_; 248 my $class = ref $invocant || $invocant; 249 my $self = { 250 type => undef, 251 args => {}, 252 %fields, 253 }; 254 return bless $self, $class; 255 } 256 257 =item newFromType($type, $argsRef) 258 259 Creates a new WeBWorK::URLPath given a type name and a hashref containing type 260 arguments. You will probably never use this. Use C<newFromPath> instead. 261 262 =cut 263 264 sub newFromType { 265 my ($invocant, $type, %args) = @_; 266 return $invocant->new( 267 type => $type, 268 args => \%args, 269 ); 270 } 271 272 =item newFromPath($path) 273 274 Creates a new WeBWorK::URLPath by parsing the path given in C<$path>. It the 275 path is invalid, an undefined value is returned. 276 277 =cut 278 279 sub newFromPath { 280 my ($invocant, $path) = @_; 281 my ($type, %args) = getpathType($path); 282 return undef unless $type; 283 return $invocant->new( 284 type => $type, 285 args => \%args, 286 ); 287 } 288 289 =back 290 291 =head1 METHODS 292 293 =over 294 295 =item parent() 296 297 Returns a new WeBWorK::URLPath representing the parent of the current URLPath. 298 Returns an undefined value if the URLPath has no parent. 299 300 =cut 301 302 sub parent { 303 my ($self) = @_; 304 305 my $newType = $pathTypes{$self->{type}}->{parent}; 306 return undef unless $newType; 307 308 # remove any argument added by the current node (and therefore not needed by the parent) 309 my %newArgs = %{ $self->{args} }; 310 my $currArg = $pathTypes{$self->{type}}->{capture}; 311 delete $newArgs{$currArg} if $currArg; 312 313 return $self->newFromType($newType, %newArgs); 314 } 315 316 =item child($module, %newArgs) 317 318 Returns a new WeBWorK::URLPath representing the child of the current URLPath 319 whose display module is C<$module>. If no child matches, an undefined value is 320 returned. Pass additional arguments needed by the child in C<%newArgs>. 321 322 =cut 323 324 sub child { 325 my ($self, $module, %newArgs) = @_; 326 327 my @kids = @{ $pathTypes{$self->{type}}->{kids} }; 328 my $newType; 329 foreach my $kid (@kids) { 330 if ($pathTypes{$kid}->{module} eq $module) { 331 $newType = $kid; 332 last; 333 } 334 } 335 336 if ($newType) { 337 return $self->newFromType($newType, %newArgs); 338 } else { 339 return undef; 340 } 341 } 342 343 =item displayModule() 344 345 Returns the name of the display module that will handle this WeBWorK::URLPath. 346 347 =cut 348 349 sub displayModule { 350 my ($self) = @_; 351 return $pathTypes{$self->{type}}->{display}; 352 } 353 354 =item displayArgs() 355 356 Returns a hash of arguments to supply to the display module that will handle 357 this WeBWorK::URLPath. 358 359 =cut 360 361 sub displayArgs { 362 my ($self) = @_; 363 return %{ $self->{args} }; 364 } 365 366 =item path(%newArgs) 367 368 Reconstructs the path string from a WeBWorK::URLPath. The contents of 369 C<%newArgs> will override the arguments stored in the URLPath. 370 371 =cut 372 373 sub path { 374 my ($self, %newArgs) = @_; 375 376 my %args = ( 377 %{ $self->{args} }, 378 %newArgs, 379 ); 380 381 my $path = reconstructPath($self->{type}); 382 $path =~ s/\$(\w+)/$args{$1} || "\$$1"/eg; # variable interpolation 383 return $path; 384 } 385 386 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |