Diff of /branches/rel-2-1-patches/webwork-modperl/lib/WeBWorK/ContentGenerator.pm

Revision 1881		Revision 1882
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

 Legend:



Removed from v.1881
 


changed lines


 
Added in v.1882
 Legend:



Removed from v.1881
 


changed lines


 
Added in v.1882
-Removed from v.1881
+Added in v.1882

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9