| 1 | ################################################################################ |
1 | ################################################################################ |
| 2 | # WeBWorK Online Homework Delivery System |
2 | # WeBWorK Online Homework Delivery System |
| 3 | # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ |
3 | # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ |
| 4 | # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator.pm,v 1.84 2004/03/11 03:07:46 sh002i Exp $ |
4 | # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator.pm,v 1.85 2004/03/15 03:18:15 sh002i Exp $ |
| 5 | # |
5 | # |
| 6 | # This program is free software; you can redistribute it and/or modify it under |
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 |
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 |
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. |
9 | # version, or (b) the "Artistic License" which comes with this package. |
| … | |
… | |
| 42 | =cut |
42 | =cut |
| 43 | |
43 | |
| 44 | use strict; |
44 | use strict; |
| 45 | use warnings; |
45 | use warnings; |
| 46 | use Apache::Constants qw(:common); |
46 | use Apache::Constants qw(:common); |
|
|
47 | use Carp; |
| 47 | use CGI::Pretty qw(*ul *li); |
48 | use CGI::Pretty qw(*ul *li); |
| 48 | use URI::Escape; |
49 | use URI::Escape; |
| 49 | use WeBWorK::Template qw(template); |
50 | use WeBWorK::Template qw(template); |
| 50 | |
51 | |
| 51 | ################################################################################ |
52 | ################################################################################ |
| … | |
… | |
| 477 | if ($key) { |
478 | if ($key) { |
| 478 | my $courseID = $urlpath->arg("courseID"); |
479 | my $courseID = $urlpath->arg("courseID"); |
| 479 | my $userID = $r->param("user"); |
480 | my $userID = $r->param("user"); |
| 480 | my $eUserID = $r->param("effectiveUser"); |
481 | my $eUserID = $r->param("effectiveUser"); |
| 481 | |
482 | |
| 482 | my $stopActingURL = $self->systemLink($urlpath, effectiveUserID => $userID); |
483 | my $stopActingURL = $self->systemLink($urlpath, # current path |
|
|
484 | values => { |
|
|
485 | effectiveUser => $userID, |
|
|
486 | }, |
|
|
487 | ); |
| 483 | my $logoutURL = $self->systemLink($urlpath->newFromModule(__PACKAGE__ . "::Logout", courseID => $courseID)); |
488 | my $logoutURL = $self->systemLink($urlpath->newFromModule(__PACKAGE__ . "::Logout", courseID => $courseID)); |
| 484 | |
489 | |
| 485 | print "\n<!-- BEGIN " . __PACKAGE__ . "::loginstatus -->\n"; |
490 | print "\n<!-- BEGIN " . __PACKAGE__ . "::loginstatus -->\n"; |
| 486 | |
491 | |
| 487 | print "Logged in as $userID. "; |
492 | print "Logged in as $userID. "; |
| … | |
… | |
| 560 | unshift @path, $urlpath->name, $r->location . $urlpath->path; |
565 | unshift @path, $urlpath->name, $r->location . $urlpath->path; |
| 561 | } while ($urlpath = $urlpath->parent); |
566 | } while ($urlpath = $urlpath->parent); |
| 562 | |
567 | |
| 563 | $path[$#path] = ""; # we don't want the last path element to be a link |
568 | $path[$#path] = ""; # we don't want the last path element to be a link |
| 564 | |
569 | |
| 565 | print "\n<!-- BEGIN " . __PACKAGE__ . "::path -->\n"; |
570 | #print "\n<!-- BEGIN " . __PACKAGE__ . "::path -->\n"; |
| 566 | print $self->pathMacro($args, @path); |
571 | print $self->pathMacro($args, @path); |
| 567 | print "<!-- END " . __PACKAGE__ . "::path -->\n"; |
572 | #print "<!-- END " . __PACKAGE__ . "::path -->\n"; |
| 568 | |
573 | |
| 569 | return ""; |
574 | return ""; |
| 570 | } |
575 | } |
| 571 | |
576 | |
| 572 | =item siblings() |
577 | =item siblings() |
| … | |
… | |
| 614 | sub title { |
619 | sub title { |
| 615 | my ($self, $args) = @_; |
620 | my ($self, $args) = @_; |
| 616 | my $r = $self->r; |
621 | my $r = $self->r; |
| 617 | |
622 | |
| 618 | |
623 | |
| 619 | print "\n<!-- BEGIN " . __PACKAGE__ . "::title -->\n"; |
624 | #print "\n<!-- BEGIN " . __PACKAGE__ . "::title -->\n"; |
| 620 | print $r->urlpath->name; |
625 | print $r->urlpath->name; |
| 621 | print "<!-- END " . __PACKAGE__ . "::title -->\n"; |
626 | #print "<!-- END " . __PACKAGE__ . "::title -->\n"; |
| 622 | |
627 | |
| 623 | return ""; |
628 | return ""; |
| 624 | } |
629 | } |
| 625 | |
630 | |
| 626 | =item warnings() |
631 | =item warnings() |
| … | |
… | |
| 1046 | Generate a link to another part of the system. $urlpath is WeBWorK::URLPath |
1051 | Generate a link to another part of the system. $urlpath is WeBWorK::URLPath |
| 1047 | object from which the base path will be taken. %options can consist of: |
1052 | object from which the base path will be taken. %options can consist of: |
| 1048 | |
1053 | |
| 1049 | =over |
1054 | =over |
| 1050 | |
1055 | |
|
|
1056 | =item params |
|
|
1057 | |
|
|
1058 | A reference to a list containing names of parameters to add to the URL. The |
|
|
1059 | parameter values are taken from the current request. |
|
|
1060 | |
|
|
1061 | =item values |
|
|
1062 | |
|
|
1063 | A reference to a hash associating request parameters with replacement values. If |
|
|
1064 | parameter is given in C<params> above, the value given here will be substituted |
|
|
1065 | for that in the current request. |
|
|
1066 | |
| 1051 | =item authen |
1067 | =item authen |
| 1052 | |
1068 | |
| 1053 | Boolen, whether to include authentication information in the resulting URL. If |
1069 | If true, authentication parameters (C<user>, C<effectiveUser>, and <key>) will |
|
|
1070 | be included in the list of C<params>. Since this is usually what you want, if |
| 1054 | not given, a true value is assumed. |
1071 | this option is not given a true value is assumed. |
| 1055 | |
|
|
| 1056 | =item realUserID |
|
|
| 1057 | |
|
|
| 1058 | If C<authen> is true, the current real user ID is replaced with this value. |
|
|
| 1059 | |
|
|
| 1060 | =item sessionKey |
|
|
| 1061 | |
|
|
| 1062 | If C<authen> is true, the current session key is replaced with this value. |
|
|
| 1063 | |
|
|
| 1064 | =item effectiveUserID |
|
|
| 1065 | |
|
|
| 1066 | If C<authen> is true, the current effective user ID is replaced with this value. |
|
|
| 1067 | |
1072 | |
| 1068 | =back |
1073 | =back |
| 1069 | |
1074 | |
| 1070 | =cut |
1075 | =cut |
| 1071 | |
1076 | |
|
|
1077 | # FIXME: there should probably be an option for prepending "http://hostname:port" |
| 1072 | sub systemLink { |
1078 | sub systemLink { |
| 1073 | my ($self, $urlpath, %options) = @_; |
1079 | my ($self, $urlpath, %options) = @_; |
| 1074 | my $r = $self->r; |
1080 | my $r = $self->r; |
| 1075 | |
1081 | |
| 1076 | my $authen = $options{authen} || 1; |
1082 | my @params = (); |
|
|
1083 | if (exists $options{params}) { |
|
|
1084 | croak "option 'params' is not an arrayref" unless ref $options{params} eq "ARRAY"; |
|
|
1085 | @params = @{ $options{params} }; |
|
|
1086 | } |
|
|
1087 | |
|
|
1088 | my %values = (); |
|
|
1089 | if (exists $options{values}) { |
|
|
1090 | croak "option 'values' is not an hashref" unless ref $options{values} eq "HASH"; |
|
|
1091 | %values = %{ $options{values} }; |
|
|
1092 | } |
|
|
1093 | |
|
|
1094 | my $authen = $options{authen} || not exists $options{authen}; |
|
|
1095 | push @params, qw/user effectiveUser key/ if $authen; |
|
|
1096 | |
|
|
1097 | foreach my $param (@params) { |
|
|
1098 | next if exists $values{$param}; |
|
|
1099 | $values{$param} = $r->param($param); |
|
|
1100 | } |
| 1077 | |
1101 | |
| 1078 | my $url = $r->location . $urlpath->path; |
1102 | my $url = $r->location . $urlpath->path; |
| 1079 | |
1103 | |
| 1080 | if ($authen) { |
1104 | if (keys %values) { |
| 1081 | my $realUserID = $options{realUserID} || $r->param("user"); |
1105 | $url .= "?"; |
| 1082 | my $sessionKey = $options{sessionKey} || $r->param("key"); |
1106 | $url .= join("&", map { "$_=$values{$_}" } keys %values); |
| 1083 | my $effectiveUserID = $options{effectiveUserID} || $r->param("effectiveUser"); |
|
|
| 1084 | |
|
|
| 1085 | my @params; |
|
|
| 1086 | defined $realUserID and push @params, "user=$realUserID"; |
|
|
| 1087 | defined $sessionKey and push @params, "key=$sessionKey"; |
|
|
| 1088 | defined $effectiveUserID and push @params, "effectiveUser=$effectiveUserID"; |
|
|
| 1089 | |
|
|
| 1090 | $url .= "?" . join("&", @params) if @params; |
|
|
| 1091 | } |
1107 | } |
| 1092 | |
1108 | |
| 1093 | return $url; |
1109 | return $url; |
| 1094 | } |
1110 | } |
| 1095 | |
1111 | |