| … | |
… | |
| 44 | |
44 | |
| 45 | # This stuff is pretty much copied out of the O'Reilly mod_perl book. |
45 | # This stuff is pretty much copied out of the O'Reilly mod_perl book. |
| 46 | # It's for figuring out the basepath. I may change this up if I find a |
46 | # It's for figuring out the basepath. I may change this up if I find a |
| 47 | # better way to do it. |
47 | # better way to do it. |
| 48 | my $path_info = $r->path_info || ""; |
48 | my $path_info = $r->path_info || ""; |
|
|
49 | $path_info =~ s!/+!/!g; # strip multiple forward slashes |
| 49 | my $current_uri = $r->uri; |
50 | my $current_uri = $r->uri; |
| 50 | my $args = $r->args; |
51 | my $args = $r->args; |
| 51 | |
52 | |
| 52 | $current_uri =~ m/^(.*)$path_info/; |
53 | my $urlRoot = $current_uri =~ m/^(.*)$path_info/; |
| 53 | my $urlRoot = $1; |
|
|
| 54 | |
54 | |
| 55 | # If it's a valid WeBWorK URI, it ends in a /. This is assumed |
55 | # If it's a valid WeBWorK URI, it ends in a /. This is assumed |
| 56 | # alllll over the place. |
56 | # alllll over the place. |
| 57 | unless (substr($current_uri,-1) eq '/') { |
57 | unless (substr($current_uri,-1) eq '/') { |
| 58 | $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : "")); |
58 | $r->header_out(Location => "$current_uri/" . ($args ? "?$args" : "")); |