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

Revision 1663		Revision 1880
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$	4	# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator.pm,v 1.84 2004/03/11 03:07:46 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.
…		…
18		18
19	=head1 NAME	19	=head1 NAME
20		20
21	WeBWorK::ContentGenerator - base class for modules that generate page content.	21	WeBWorK::ContentGenerator - base class for modules that generate page content.
22		22
		23	=head1 SYNOPSIS
		24
		25	# start with a WeBWorK::Request object: $r
		26
		27	use WeBWorK::ContentGenerator::SomeSubclass;
		28
		29	my $cg = WeBWorK::ContentGenerator::SomeSubclass->new($r);
		30	my $result = $cg->go();
		31
		32	=head1 DESCRIPTION
		33
		34	WeBWorK::ContentGenerator provides the framework for generating page content.
		35	"Content generators" are subclasses of this class which provide content for
		36	particular parts of the system.
		37
		38	Default versions of methods used by the templating system are provided. Several
		39	useful methods are provided for rendering common output idioms and some
		40	miscellaneous utilities are provided.
		41
23	=cut	42	=cut
24		43
25	use strict;	44	use strict;
26	use warnings;	45	use warnings;
27	use Apache::Constants qw(:common);	46	use Apache::Constants qw(:common);
28	use CGI qw();	47	use CGI::Pretty qw(ul li);
29	use URI::Escape;	48	use URI::Escape;
30	use WeBWorK::Authz;	49	use WeBWorK::Template qw(template);
31	use WeBWorK::DB;
32	use WeBWorK::Utils qw(readFile);
33		50
34	################################################################################	51	################################################################################
35	# This is a very unruly file, so I'm going to use very large comments to divide
36	# it into logical sections.
37	################################################################################
38		52
39	# new(Apache::Request, WeBWorK::CourseEnvironment, WeBWorK::DB) - create a new	53	=head1 CONSTRUCTOR
40	# instance of a content generator. Usually only called by the dispatcher, although	54
41	# one might be able to use it for things like "sub-requests". Uh... uh... I have	55	=over
42	# to think about that one. The dispatcher uses this idiom:	56
43	#	57	=item new($r)
44	# WeBWorK::ContentGenerator::WHATEVER->new($r, $ce, $db)->go(@whatever);	58
45	#	59	Creates a new instance of a content generator. Supply a WeBWorK::Request object
46	# and throws away the result ;)	60	$r.
47	#	61
		62	=cut
		63
48	sub new {	64	sub new {
49	my ($invocant, $r, $ce, $db) = @_;	65	my ($invocant, $r) = @_;
50	my $class = ref($invocant) \|\| $invocant;	66	my $class = ref($invocant) \|\| $invocant;
51	my $self = {	67	my $self = {
52	r => $r,	68	r => $r, # this is now a WeBWorK::Request
53	ce => $ce,	69	ce => $r->ce(), # these three are here for
54	db => $db,	70	db => $r->db(), # backward-compatability
55	authz => WeBWorK::Authz->new($r, $ce, $db),	71	authz => $r->authz(), # with unconverted CGs
56	noContent => undef,	72	noContent => undef, # this should get clobbered at some point
57	};	73	};
58	bless $self, $class;	74	bless $self, $class;
59	return $self;	75	return $self;
60	}	76	}
61		77
		78	=back
		79
		80	=cut
		81
62	################################################################################	82	################################################################################
63	# Invocation and template processing
64	################################################################################
65		83
66	# go(@otherArguments) - render a page, using methods from the particular	84	=head1 INVOCATION
67	# subclass of ContentGenerator. @otherArguments is passed to each method, so	85
68	# that the dispatcher can pass CG-specific data. The order of calls looks like	86	=over
69	# this:	87
70	#	88	=item go()
71	# * &pre_header_initialize - give subclasses a chance to do initialization	89
72	# necessary for generating the HTTP header.	90	Generates a page, using methods from the particular subclass of ContentGenerator
73	# * &header - this class provides a standard HTTP header with Content-Type	91	that is instantiated. Generatoion is broken up into several steps, to give
74	# text/html. Subclasses are welcome to overload this for things like	92	subclasses ample control over the process.
75	# an image-creation content generator or a PDF generator.	93
76	# In addition, if &header returns a value, that will be the value	94	=over
77	# returned by the entire PerlHandler.	95
78	# * &initialize - let subclasses do post-header initialization.	96	=item 1
79	# * any "template escapes" defined in the system template and supported by	97
80	# the subclass.	98	go() will attempt to call the method pre_header_initialize(). This method may be
81	# (if &content exists on a content generator, it is called	99	implemented in subclasses which must do processing before the HTTP header is
82	# and no template processing occurs.)	100	emitted.
83	#	101
84	# If &pre_header_initialize or &header sets $self->{noContent} to a true value,	102	=item 2
85	# &initialize will not be run and the content or template processing code	103
86	# will not be executed. This is probably only desirable if a redirect has been	104	go() will attempt to call the method header(). This method emits the HTTP
87	# issued.	105	header. It is defined in this class (see below), but may be overridden in
		106	subclasses which need to send different header information. For some reason, the
		107	return value of header() will be used as the result of this function, if it is
		108	defined.
		109
		110	=item 3
		111
		112	At this point, go() will terminate if the request is a HEAD request or if the
		113	field $self->{noContent} contains a true value.
		114
		115	=item 4
		116
		117	If the field $self->{sendFile} is defined, the method sendFile() is called to
		118	send the specified file to the client, and go() terminates. See below.
		119
		120	=item 5
		121
		122	go() then attempts to call the method initialize(). This method may be
		123	implemented in subclasses which must do processing after the HTTP header is sent
		124	but before any content is sent.
		125
		126	=item 6
		127
		128	The method content() is called to send the page content to client.
		129
		130	=back
		131
		132	=cut
		133
88	sub go {	134	sub go {
89	my $self = shift;	135	my ($self) = @_;
90
91	my $r = $self->{r};	136	my $r = $self->r;
92	my $ce = $self->{ce};	137	my $ce = $r->ce;
		138
93	my $returnValue = OK;	139	my $returnValue = OK;
94		140
95	$self->pre_header_initialize(@_) if $self->can("pre_header_initialize");	141	$self->pre_header_initialize(@_) if $self->can("pre_header_initialize");
		142
96	my $headerReturn = $self->header(@_);	143	my $headerReturn = $self->header(@_);
97	$returnValue = $headerReturn if defined $headerReturn;	144	$returnValue = $headerReturn if defined $headerReturn;
98	return $returnValue if $r->header_only or $self->{noContent};	145	return $returnValue if $r->header_only or $self->{noContent};
99		146
100	# if the sendFile flag is set, send the file and exit;	147	# if the sendFile flag is set, send the file and exit;
101	if ($self->{sendFile}) {	148	if ($self->{sendFile}) {
102	return $self->sendFile;	149	return $self->sendFile;
103	}	150	}
104		151
105	$self->initialize(@_) if $self->can("initialize");	152	$self->initialize() if $self->can("initialize");
106		153
107	# A content generator will have a "content" method if it does not
108	# wish to be passed through template processing, but wishes to be
109	# completely responsible for it's own output.
110	if ($self->can("content")) {
111	$self->content(@_);	154	$self->content();
112	} else {
113	# if the content generator specifies a custom template name, use that
114	# field in the $ce->{templates} hash instead of "system" if it exists.
115	my $templateName;
116	if ($self->can("templateName")) {
117	$templateName = $self->templateName;
118	} else {
119	$templateName = "system";
120	}
121	$templateName = "system" unless exists $ce->{templates}->{$templateName};
122	$self->template($ce->{templates}->{$templateName}, @_);
123	}
124		155
125	return $returnValue;	156	return $returnValue;
126	}	157	}
		158
		159	=item sendFile()
		160
		161	Sends the file specified in $self->{sendFile} to the client. $self->{sendFile}
		162	should be a reference to a hash containing the following fields:
		163
		164	source => full path to the file to send
		165	type => the content type of the file
		166	name => the name that the client should give to the file upon download
		167
		168	This method is called internally by go() if the field $self->{sendFile} is
		169	present.
		170
		171	This mechanism relies on the header() method to send appropriate C<Content-Type>
		172	and C<Content-Disposition> headers.
		173
		174	This mechanism is fragile and will probably be replaced by something else in the
		175	future.
		176
		177	=cut
127		178
128	sub sendFile {	179	sub sendFile {
129	my ($self) = @_;	180	my ($self) = @_;
130		181
131	my $file = $self->{sendFile}->{source};	182	my $file = $self->{sendFile}->{source};
…		…
141	close $fh;	192	close $fh;
142		193
143	return OK;	194	return OK;
144	}	195	}
145		196
146	# template(STRING, @otherArguments) - parse a template, looking for escapes of	197	=item r()
147	# the form <!--#NAME ARG1="FOO" ARG2="BAR"--> and calling a member function NAME	198
148	# (if available) for each NAME. The escapes are called like:	199	Returns a reference to the WeBWorK::Request object associated with this
149	#	200	instance.
150	# $self->NAME(@otherArguments, \%escapeArguments)	201
151	#	202	=cut
152	# where @otherArguments originates in the dispatcher and %escapeArguments is	203
153	# parsed out of the escape itself (i.e. ARG1 => FOO, ARG2 => BAR)	204	sub r {
154	#	205	my ($self) = @_;
155	sub template {	206
156	my ($self, $templateFile) = (shift, shift);	207	return $self->{r};
		208	}
		209
		210	=back
		211
		212	=cut
		213
		214	################################################################################
		215
		216	=head1 STANDARD METHODS
		217
		218	The following are the standard content generator methods. Some are defined here,
		219	but may be overridden in a subclass. Others are not defined unless they are
		220	defined in a subclass.
		221
		222	=over
		223
		224	=item pre_header_initialize()
		225
		226	Not defined in this package.
		227
		228	May be defined by a subclass to perform any processing that must occur before
		229	the HTTP header is sent.
		230
		231	=cut
		232
		233	#sub pre_header_initialize { }
		234
		235	=item header()
		236
		237	Defined in this package.
		238
		239	Generates and sends a default HTTP header. If the field $self->{sendFile} is
		240	present, sends the following headers (where TYPE is $self->{sendFile}->{type}
		241	and NAME is $self->{sendFile}->{name}):
		242
		243	Content-Type: TYPE
		244	Content-Disposition: attachment; filename=NAME
		245
		246	If $self->{sendFile} is not present, sends the following headers:
		247
		248	Content-Type: text/html
		249
		250	See sendFile() above for more information on the sendFile mechanism.
		251
		252	=cut
		253
		254	sub header {
		255	my $self = shift;
157	my $r = $self->{r};	256	my $r = $self->r;
158	my $courseEnvironment = $self->{ce};
159	my @ifstack = (1); # Start off in printing mode
160	# say $ifstack[-1] to get the result of the last <#!--if-->
161		257
162	# so even though the variable $/ APPEARS to contain a newline,	258	if ($self->{sendFile}) {
163	# <TEMPLATE> is slurping the whole file into the first element of	259	my $contentType = $self->{sendFile}->{type};
164	# @template ONLY AFTER THE TRANSLATOR RUNS. WTF!!!	260	my $fileName = $self->{sendFile}->{name};
165	#	261	$r->content_type($contentType);
166	#open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile";	262	$r->header_out("Content-Disposition" => "attachment; filename=\"$fileName\"");
167	#my @template = <TEMPLATE>;	263	} else {
168	#close TEMPLATE;	264	$r->content_type("text/html");
169	#
170	# Let's try something else instead:
171	my @template = split /\n/, readFile($templateFile);
172
173	foreach my $line (@template) {
174	# This is incremental regex processing.
175	# the /c is so that pos($line) doesn't die when the regex fails.
176	while ($line =~ m/\G(.?)<!--#(\w)((?:\s+.*?)?)-->/gc) {
177	my ($before, $function, $raw_args) = ($1, $2, $3);
178	my @args = ($raw_args =~ /\S/) ? cook_args($raw_args) : ();
179		265
180	if ($ifstack[-1]) {	266	}
181	print $before;	267
		268	$r->send_http_header();
		269	return OK;
		270	}
		271
		272	=item initialize()
		273
		274	Not defined in this package.
		275
		276	May be defined by a subclass to perform any processing that must occur after the
		277	HTTP header is sent but before any content is sent.
		278
		279	=cut
		280
		281	#sub initialize { }
		282
		283	=item content()
		284
		285	Defined in this package.
		286
		287	Print the content of the generated page.
		288
		289	The implementation in this package uses WeBWorK::Template to define the content
		290	of the page. See WeBWorK::Template for details.
		291
		292	If a method named templateName() exists, it it called to determine the name of
		293	the template to use. If not, the default template, "system", is used. The
		294	location of the template is looked up in the course environment.
		295
		296	=cut
		297
		298	sub content {
		299	my ($self) = @_;
		300	my $ce = $self->r->ce;
		301
		302	# if the content generator specifies a custom template name, use that
		303	# field in the $ce->{templates} hash instead of "system" if it exists.
		304	my $templateName;
		305	if ($self->can("templateName")) {
		306	$templateName = $self->templateName;
		307	} else {
		308	$templateName = "system";
		309	}
		310	$templateName = "system" unless exists $ce->{templates}->{$templateName};
		311	template($ce->{templates}->{$templateName}, $self);
		312	}
		313
		314	=back
		315
		316	=cut
		317
		318	# ------------------------------------------------------------------------------
		319
		320	=head2 Template escape handlers
		321
		322	Template escape handlers are invoked when the template processor encounters a
		323	matching escape sequence in the template. The escapse sequence's arguments are
		324	passed to the methods as a reference to a hash.
		325
		326	For more information, refer to WeBWorK::Template.
		327
		328	The following template escapes handlers are defined here or may be defined in
		329	subclasses. For methods that are not defined in this package, the documentation
		330	defines the interface and behavior that any subclass implementation must follow.
		331
		332	=over
		333
		334	=item head()
		335
		336	Not defined in this package.
		337
		338	Any tags that should appear in the HEAD of the document.
		339
		340	=cut
		341
		342	#sub head { }
		343
		344	=item info()
		345
		346	Not defined in this package.
		347
		348	Auxiliary information related to the content displayed in the C<body>.
		349
		350	=cut
		351
		352	#sub info { }
		353
		354	=item links()
		355
		356	Defined in this package.
		357
		358	Links that should appear on every page.
		359
		360	=cut
		361
		362	sub links {
		363	my ($self) = @_;
		364	my $r = $self->r;
		365	my $db = $r->db;
		366	my $urlpath = $r->urlpath;
		367
		368	# we're linking to other places in the same course, so grab the courseID from the current path
		369	my $courseID = $urlpath->arg("courseID");
		370
		371	# to make things more concise
		372	my %args = ( courseID => $courseID );
		373	my $pfx = "WeBWorK::ContentGenerator::";
		374
		375	my $sets = $urlpath->newFromModule("${pfx}ProblemSets", %args);
		376	my $options = $urlpath->newFromModule("${pfx}Options", %args);
		377	my $grades = $urlpath->newFromModule("${pfx}Grades", %args);
		378	my $logout = $urlpath->newFromModule("${pfx}Logout", %args);
		379
		380	print "\n<!-- BEGIN " . __PACKAGE__ . "::links -->\n";
		381	print CGI::start_ul({class=>"LinksMenu"});
		382	print CGI::li(CGI::span({style=>"font-size:larger"},
		383	CGI::a({href=>$self->systemLink($sets)}, "Problem Sets")));
		384	print CGI::li(CGI::a({href=>$self->systemLink($options)}, $options->name));
		385	print CGI::li(CGI::a({href=>$self->systemLink($grades)}, $grades->name));
		386	print CGI::li(CGI::a({href=>$self->systemLink($logout)}, $logout->name));
		387
		388	my $PermissionLevel = $db->getPermissionLevel($r->param("user")); # checked
		389	my $permLevel = $PermissionLevel ? $PermissionLevel->permission : 0;
		390
		391	if ($permLevel > 0) {
		392	my $ipfx = "${pfx}Instructor::";
		393
		394	my $userID = $r->param("effectiveUser");
		395	my $setID = $urlpath->arg("setID");
		396	my $problemID = $urlpath->arg("problemID");
		397
		398	my $instr = $urlpath->newFromModule("${ipfx}Index", %args);
		399	my $userList = $urlpath->newFromModule("${ipfx}UserList", %args);
		400
		401	# set list links
		402	my $setList = $urlpath->newFromModule("${ipfx}ProblemSetList", %args);
		403	my $setDetail = $urlpath->newFromModule("${ipfx}ProblemSetEditor", %args, setID => $setID);
		404	my $problemEditor = $urlpath->newFromModule("${ipfx}PGProblemEditor", %args, setID => $setID, problemID => $problemID);
		405
		406	my $mail = $urlpath->newFromModule("${ipfx}SendMail", %args);
		407	my $scoring = $urlpath->newFromModule("${ipfx}Scoring", %args);
		408
		409	# statistics links
		410	my $stats = $urlpath->newFromModule("${ipfx}Stats", %args);
		411	my $userStats = $urlpath->newFromModule("${ipfx}Stats", %args, statType => "student", userID => $userID);
		412	my $setStats = $urlpath->newFromModule("${ipfx}Stats", %args, statType => "set", setID => $setID);
		413
		414	my $files = $urlpath->newFromModule("${ipfx}FileXfer", %args);
		415
		416	print CGI::start_li();
		417	print CGI::span({style=>"font-size:larger"}, CGI::a({href=>$self->systemLink($instr)}, $instr->name));
		418	print CGI::start_ul();
		419	print CGI::li(CGI::a({href=>$self->systemLink($userList)}, $userList->name));
		420	print CGI::start_li();
		421	print CGI::a({href=>$self->systemLink($setList)}, $setList->name);
		422	if (defined $setID and $setID ne "") {
		423	print CGI::start_ul();
		424	print CGI::start_li();
		425	print CGI::a({href=>$self->systemLink($setDetail)}, $setID);
		426	if (defined $problemID and $problemID ne "") {
		427	print CGI::ul(
		428	CGI::li(CGI::a({href=>$self->systemLink($problemEditor)}, $problemID))
		429	);
182	}	430	}
183		431	print CGI::end_li();
184	if ($function eq "if") {	432	print CGI::end_ul();
185	# a predicate can only be true if everything else on the ifstack is already true, for ANDing
186	push @ifstack, ($self->$function(@_, [@args]) && $ifstack[-1]);
187	} elsif ($function eq "else" and @ifstack > 1) {
188	$ifstack[-1] = not $ifstack[-1];
189	} elsif ($function eq "endif" and @ifstack > 1) {
190	pop @ifstack;
191	} elsif ($ifstack[-1]) {
192	if ($self->can($function)) {
193	my @result = $self->$function(@_, {@args});
194	if (@result) {
195	print @result;
196	} else {
197	warn "Template escape $function returned an empty list.";
198	}
199	}
200	}
201	}	433	}
202		434	print CGI::end_li();
203	if ($ifstack[-1]) {	435	print CGI::li(CGI::a({href=>$self->systemLink($mail)}, $mail->name));
204	print substr($line, (defined pos $line) ? pos $line : 0), "\n";	436	print CGI::li(CGI::a({href=>$self->systemLink($scoring)}, $scoring->name));
		437	print CGI::start_li();
		438	print CGI::a({href=>$self->systemLink($stats)}, $stats->name);
		439	if (defined $userID and $userID ne "") {
		440	print CGI::ul(
		441	CGI::li(CGI::a({href=>$self->systemLink($userStats)}, $userID))
		442	);
205	}	443	}
206	}	444	if (defined $setID and $setID ne "") {
207	}	445	print CGI::ul(
208		446	CGI::li(CGI::a({href=>$self->systemLink($setStats)}, $setID))
209	# cook_args(STRING) - parses a string of the form ARG1="FOO" ARG2="BAR". Returns	447	);
210	# a list which pairs into key/values and fits nicely in {}s.
211	#
212	sub cook_args($) { # ... also used by bin/wwdb, so watch out
213	my ($raw_args) = @_;
214	my @args = ();
215
216	# Boy I love m//g in scalar context! Go read the camel book, heathen.
217	# First, get the whole token with the quotes on both ends...
218	while ($raw_args =~ m/\G\s(\w)="((?:[^"\\]\|\\.)*)"/g) {
219	my ($key, $value) = ($1, $2);
220	# ... then, rip out all the protecty backspaces
221	$value =~ s/\\(.)/$1/g;
222	push @args, $key => $value;
223	}
224
225	return @args;
226	}
227
228	# This is different. It probably shouldn't print anything (except in debugging cases)
229	# and it should return a boolean, not a string. &if is called in a nonstandard way
230	# by &template, with $args as an arrayref instead of a hashref. this is a hack! yay!
231
232	# OK, this is a pluggin architecture. it iterates through attributes of the "if" tag,
233	# and for each predicate $p, it calls &if_$p in an object-oriented way, continuing the
234	# grand templating theme of an object-oriented pluggable architecture using ->can($).
235	sub if {
236	my ($self, $args) = @_[0,-1];
237	# A single if "or"s it's components. Nesting produces "and".
238
239	my @args = @$args; # Hahahahaha, get it?!
240
241	if (@args % 2 != 0) {
242	# flip out and kill people, but do not commit seppuku
243	print '<!--&if recieved an uneven number of arguments. This shouldn\'t happen, but I\'ll let it slide.-->\n';
244	}
245
246	while (@args > 1) {
247	my ($key, $value) = (shift @args, shift @args);
248
249	# a non-existent &if_$key is the same as a false result, but we're ORing, so it's OK
250	my $sub = "if_$key"; # perl doesn't like it when you try to construct a string right in a method invocation
251	if ($self->can("if_$key") and $self->$sub("$value")) {
252	return 1;
253	}	448	}
		449	print CGI::end_li();
		450	print CGI::li(CGI::a({href=>$self->systemLink($files)}, $files->name));
		451	print CGI::end_ul();
		452	print CGI::end_li();
		453	}
		454
		455	print CGI::end_ul();
		456	print "<!-- end " . __PACKAGE__ . "::links -->\n";
		457
		458	return "";
		459	}
		460
		461	=item loginstatus()
		462
		463	Defined in this package.
		464
		465	Print a notification message announcing the current real user and effective
		466	user, a link to stop acting as the effective user, and a link to logout.
		467
		468	=cut
		469
		470	sub loginstatus {
		471	my ($self) = @_;
		472	my $r = $self->r;
		473	my $urlpath = $r->urlpath;
		474
		475	my $key = $r->param("key");
		476
		477	if ($key) {
		478	my $courseID = $urlpath->arg("courseID");
		479	my $userID = $r->param("user");
		480	my $eUserID = $r->param("effectiveUser");
		481
		482	my $stopActingURL = $self->systemLink($urlpath, effectiveUserID => $userID);
		483	my $logoutURL = $self->systemLink($urlpath->newFromModule(__PACKAGE__ . "::Logout", courseID => $courseID));
		484
		485	print "\n<!-- BEGIN " . __PACKAGE__ . "::loginstatus -->\n";
		486
		487	print "Logged in as $userID. ";
		488	print CGI::a({href=>$logoutURL}, "Log Out");
		489
		490	if ($eUserID ne $userID) {
		491	print " \| Acting as $eUserID. ";
		492	print CGI::a({href=>$stopActingURL}, "Stop Acting");
254	}	493	}
		494
		495	print "<!-- END " . __PACKAGE__ . "::loginstatus -->\n";
		496	}
255		497
		498	return "";
		499	}
		500
		501	=item nav($args)
		502
		503	Not defined in this package.
		504
		505	Links to the previous, next, and parent objects.
		506
		507	$args is a reference to a hash containing the following fields:
		508
		509	style => text\|image
		510	imageprefix => prefix to prepend to base image URL
		511	imagesuffix => suffix to append to base image URL
		512	separator => HTML to place in between links
		513
		514	If C<style> is "image", image URLs are constructed by prepending C<imageprefix>
		515	and postpending C<imagesuffix> to the image base names defined by the
		516	implementor. (Examples of base names include "Prev", "Next", "ProbSet", and
		517	"Up"). Each concatenated string should form an absolute URL to an image file.
		518	For example:
		519
		520	<!--#nav style="images" imageprefix="/webwork2_files/images/nav"
		521	imagesuffix=".gif" separator=" "-->
		522
		523	=cut
		524
		525	#sub nav { }
		526
		527	=item options()
		528
		529	Not defined in this package.
		530
		531	Print an auxiliary options form, related to the content displayed in the
		532	C<body>.
		533
		534	=item path($args)
		535
		536	Defined in this package.
		537
		538	Print "breadcrubs" from the root of the virtual hierarchy to the current page.
		539	$args is a reference to a hash containing the following fields:
		540
		541	style => type of separator: text\|image
		542	image => if style=image, URL of image to use as path separator
		543	text => if style=text, text to use as path separator
		544	if style=image, the ALT text of each separator image
		545	textonly => suppress all HTML, return only plain text
		546
		547	The implementation in this package takes information from the WeBWorK::URLPath
		548	associated with the current request.
		549
		550	=cut
		551
		552	sub path {
		553	my ($self, $args) = @_;
		554	my $r = $self->r;
		555
		556	my @path;
		557
		558	my $urlpath = $r->urlpath;
		559	do {
		560	unshift @path, $urlpath->name, $r->location . $urlpath->path;
		561	} while ($urlpath = $urlpath->parent);
		562
		563	$path[$#path] = ""; # we don't want the last path element to be a link
		564
		565	print "\n<!-- BEGIN " . __PACKAGE__ . "::path -->\n";
		566	print $self->pathMacro($args, @path);
		567	print "<!-- END " . __PACKAGE__ . "::path -->\n";
		568
		569	return "";
		570	}
		571
		572	=item siblings()
		573
		574	Not defined in this package.
		575
		576	Print links to siblings of the current object.
		577
		578	=cut
		579
		580	#sub siblings { }
		581
		582	=item submiterror()
		583
		584	Defined in this package.
		585
		586	Print any error messages resulting from the last form submission.
		587
		588	The implementation in this package prints the value of the field
		589	$self->{submitError}, if it is present.
		590
		591	=cut
		592
		593	sub submiterror {
		594	my ($self) = @_;
		595
		596	print "\n<!-- BEGIN " . __PACKAGE__ . "::submiterror -->\n";
		597	print $self->{submitError} if exists $self->{submitError};
		598	print "<!-- END " . __PACKAGE__ . "::submiterror -->\n";
		599
		600	return "";
		601	}
		602
		603	=item title()
		604
		605	Defined in this package.
		606
		607	Print the title of the current page.
		608
		609	The implementation in this package takes information from the WeBWorK::URLPath
		610	associated with the current request.
		611
		612	=cut
		613
		614	sub title {
		615	my ($self, $args) = @_;
		616	my $r = $self->r;
		617
		618
		619	print "\n<!-- BEGIN " . __PACKAGE__ . "::title -->\n";
		620	print $r->urlpath->name;
		621	print "<!-- END " . __PACKAGE__ . "::title -->\n";
		622
		623	return "";
		624	}
		625
		626	=item warnings()
		627
		628	Defined in this package.
		629
		630	Print accumulated warnings.
		631
		632	The implementation in this package checks for a note in the request named
		633	"warnings". If present, its contents are formatted and returned.
		634
		635	=cut
		636
		637	sub warnings {
		638	my ($self) = @_;
		639	my $r = $self->r;
		640
		641	print "\n<!-- BEGIN " . __PACKAGE__ . "::warnings -->\n";
		642	print $self->warningOutput($r->notes("warnings")) if $r->notes("warnings");
		643	print "<!-- END " . __PACKAGE__ . "::warnings -->\n";
		644
		645	return "";
		646	}
		647
		648	=back
		649
		650	=cut
		651
		652	# ------------------------------------------------------------------------------
		653
		654	=head2 Conditional predicates
		655
		656	Conditional predicate methods are invoked when the C<#if> escape sequence is
		657	encountered in the template. If a method named C<if_predicate> is defined in
		658	here or in the instantiated subclass, it is invoked.
		659
		660	The following predicates are currently defined:
		661
		662	=over
		663
		664	=item if_can($function)
		665
		666	If a function named $function is present in the current content generator (or
		667	any superclass), a true value is returned. Otherwise, a false value is returned.
		668
		669	The implementation in this package uses the method UNIVERSAL->can(function) to
		670	arrive at the result.
		671
		672	A subclass could redefine this method to, for example, "hide" a method from the
		673	template:
		674
		675	sub if_can {
		676	my ($self, $arg) = @_;
		677
		678	if ($arg eq "floobar") {
256	return 0;	679	return 0;
		680	} else {
		681	return $self->SUPER::if_can($arg);
		682	}
		683	}
		684
		685	=cut
		686
		687	sub if_can {
		688	my ($self, $arg) = @_;
		689
		690	return $self->can($arg) ? 1 : 0;
257	}	691	}
		692
		693	=item if_loggedin($arg)
		694
		695	If the user is currently logged in, $arg is returned. Otherwise, the inverse of
		696	$arg is returned.
		697
		698	The implementation in this package always returns $arg, since most content
		699	generators are only reachable when the user is authenticated. It is up to
		700	classes that can be reached without logging in to override this method and
		701	provide the correct behavior.
		702
		703	This is suboptimal, and may change in the future.
		704
		705	=cut
		706
		707	sub if_loggedin {
		708	my ($self, $arg) = @_;
		709
		710	return $arg;
		711	}
		712
		713	=item if_submiterror($arg)
		714
		715	If the last form submission generated an error, $arg is returned. Otherwise, the
		716	inverse of $arg is returned.
		717
		718	The implementation in this package checks for the field $self->{submitError} to
		719	determine if an error condition is present.
		720
		721	If a subclass uses some other method to classify submission results, this method could be
		722	redefined to handle that variance:
		723
		724	sub if_submiterror {
		725	my ($self, $arg) = @_;
		726
		727	my $status = $self->{processReturnValue};
		728	if ($status != 0) {
		729	return $arg;
		730	} else {
		731	return !$arg;
		732	}
		733	}
		734
		735	=cut
		736
		737	sub if_submiterror {
		738	my ($self, $arg) = @_;
		739
		740	if (exists $self->{submitError}) {
		741	return $arg;
		742	} else {
		743	return !$arg;
		744	}
		745	}
		746
		747	=item if_warnings
		748
		749	If warnings have been emitted while handling this request, $arg is returned.
		750	Otherwise, the inverse of $arg is returned.
		751
		752	The implementation in this package checks for a note in the request named
		753	"warnings". This is set by the WARN handler in Apache::WeBWorK when a warning is
		754	handled.
		755
		756	=cut
		757
		758	sub if_warnings {
		759	my ($self, $arg) = @_;
		760	my $r = $self->r;
		761
		762	if ($r->notes("warnings")) {
		763	return $arg;
		764	} else {
		765	!$arg;
		766	}
		767	}
		768
		769	=back
		770
		771	=cut
258		772
259	################################################################################	773	################################################################################
260	# Macros used by content generators to render common idioms
261	################################################################################
262		774
263	# pathMacro(HASHREF, LIST) - helper macro for <!--#path--> escape: the hash	775	=head1 HTML MACROS
		776
		777	Various routines are defined in this package for rendering common WeBWorK
		778	idioms.
		779
		780	FIXME: some of these should be moved to WeBWorK::HTML:: modules!
		781
		782	# ------------------------------------------------------------------------------
		783
		784	=head2 Template escape handler macros
		785
		786	These methods are used by implementations of the escape sequence handlers to
		787	maintain a consistent style.
		788
		789	=over
		790
		791	=item pathMacro($args, @path)
		792
		793	Helper macro for the C<#path> escape sequence: $args is a hash reference
264	# reference contains the "style", "image", and "text" arguments to the escape.	794	containing the "style", "image", "text", and "textonly" arguments to the escape.
265	# The LIST consists of ordered key-value pairs of the form:	795	@path consists of ordered key-value pairs of the form:
266	#	796
267	# "Page Name" => URL	797	"Page Name" => URL
268	#	798
269	# If the page should not have a link associated with it, the URL should be left	799	If the page should not have a link associated with it, the URL should be left
270	# empty. Authentication data is added to the URL so you don't have to. A fully-	800	empty. Authentication data is added to each URL so you don't have to. A fully-
271	# formed path line is returned, suitable for returning by a function	801	formed path line is returned, suitable for returning by a function implementing
272	# implementing the #path escape.	802	the C<#path> escape.
273	#	803
		804	FIXME: authentication data probably shouldn't be added here any more, now that
		805	we have systemLink().
		806
		807	=cut
		808
274	sub pathMacro {	809	sub pathMacro {
275	my $self = shift;	810	my ($self, $args, @path) = @_;
276	my %args = %{ shift() };	811	my %args = %$args;
277	my @path = @_;	812	$args{style} = "text" if $args{textonly};
		813
		814	my $auth = $self->url_authen_args;
278	my $sep;	815	my $sep;
279	if ($args{style} eq "image") {	816	if ($args{style} eq "image") {
280	$sep = CGI::img({-src=>$args{image}, -alt=>$args{text}});	817	$sep = CGI::img({-src=>$args{image}, -alt=>$args{text}});
281	} else {	818	} else {
282	$sep = $args{text};	819	$sep = $args{text};
283	}	820	}
284	my $auth = $self->url_authen_args;	821
285	my @result;	822	my @result;
286	while (@path) {	823	while (@path) {
287	my $name = shift @path;	824	my $name = shift @path;
288	my $url = shift @path;	825	my $url = shift @path;
289	push @result, $url	826	if ($url and not $args{textonly}) {
290	? CGI::a({-href=>"$url?$auth"}, $name)	827	push @result, CGI::a({-href=>"$url?$auth"}, $name);
291	: $name;	828	} else {
		829	push @result, $name;
292	}	830	}
		831	}
		832
293	return join($sep, @result) . "\n";	833	return join($sep, @result), "\n";
294	}	834	}
		835
		836	=item siblingsMacro(@siblings)
		837
		838	Helper macro for the C<#siblings> escape sequence. @siblings consists of ordered
		839	key-value pairs of the form:
		840
		841	"Sibling Name" => URL
		842
		843	If the sibling should not have a link associated with it, the URL should be left
		844	empty. Authentication data is added to each URL so you don't have to. A fully-
		845	formed siblings block is returned, suitable for returning by a function
		846	implementing the C<#siblings> escape.
		847
		848	FIXME: authentication data probably shouldn't be added here any more, now that
		849	we have systemLink().
		850
		851	=cut
295		852
296	sub siblingsMacro {	853	sub siblingsMacro {
297	my $self = shift;
298	my @siblings = @_;	854	my ($self, @siblings) = @_;
		855
		856	my $auth = $self->url_authen_args;
299	my $sep = CGI::br();	857	my $sep = CGI::br();
300	my $auth = $self->url_authen_args;	858
301	my @result;	859	my @result;
302	while (@siblings) {	860	while (@siblings) {
303	my $name = shift @siblings;	861	my $name = shift @siblings;
304	my $url = shift @siblings;	862	my $url = shift @siblings;
305	push @result, $url	863	push @result, $url
306	? CGI::a({-href=>"$url?$auth"}, $name)	864	? CGI::a({-href=>"$url?$auth"}, $name)
307	: $name;	865	: $name;
308	}	866	}
		867
309	return join($sep, @result), "\n";	868	return join($sep, @result) . "\n";
310	}	869	}
		870
		871	=item navMacro($args, $tail, @links)
		872
		873	Helper macro for the C<#nav> escape sequence: $args is a hash reference
		874	containing the "style", "imageprefix", "imagesuffix", and "separator" arguments
		875	to the escape. @siblings consists of ordered tuples of the form:
		876
		877	"Link Name", URL, ImageBaseName
		878
		879	If the sibling should not have a link associated with it, the URL should be left
		880	empty. ImageBaseName is placed between the C<imageprefix> and C<imagesuffix>.
		881	Authentication data is added to each URL so you don't have to. $tail is appended
		882	to each URL, after the authentication information. A fully-formed nav line is
		883	returned, suitable for returning by a function implementing the C<#nav> escape.
		884
		885	=cut
311		886
312	sub navMacro {	887	sub navMacro {
313	my $self = shift;	888	my ($self, $args, $tail, @links) = @_;
314	my %args = %{ shift() };	889	my $r = $self->r;
315	my $tail = shift;	890	my $ce = $r->ce;
316	my @links = @_;	891	my %args = %$args;
		892
317	my $auth = $self->url_authen_args;	893	my $auth = $self->url_authen_args;
318	my $ce = $self->{ce};
319	my $prefix = $ce->{webworkURLs}->{htdocs}."/images";	894	my $prefix = $ce->{webworkURLs}->{htdocs}."/images";
		895
320	my @result;	896	my @result;
321	while (@links) {	897	while (@links) {
322	my $name = shift @links;	898	my $name = shift @links;
323	my $url = shift @links;	899	my $url = shift @links;
324	my $img = shift @links;	900	my $img = shift @links;
…		…
333	push @result, $url	909	push @result, $url
334	? CGI::a({-href=>"$url?$auth$tail"}, $html)	910	? CGI::a({-href=>"$url?$auth$tail"}, $html)
335	: $html;	911	: $html;
336	}	912	}
337	}	913	}
		914
338	return join($args{separator}, @result) . "\n";	915	return join($args{separator}, @result) . "\n";
339	}	916	}
340		917
341	# hidden_fields(LIST) - return hidden <INPUT> tags for each field mentioned in	918	=back
		919
		920	=cut
		921
		922	# ------------------------------------------------------------------------------
		923
		924	=head2 Parameter management
		925
		926	Methods for formatting request parameters as hidden form fields or query string
		927	fragments.
		928
		929	=over
		930
		931	=item hidden_fields(@fields)
		932
		933	Return hidden <INPUT> tags for each field mentioned in @fields (or all fields if
342	# LIST (or all fields if list is empty), taking data from the current request.	934	list is empty), taking data from the current request.
343	#	935
		936	=cut
		937
344	sub hidden_fields($;@) {	938	sub hidden_fields {
345	my $self = shift;	939	my ($self, @fields) = @_;
346	my $r = $self->{r};	940	my $r = $self->r;
347	my @fields = @_;	941
348	@fields or @fields = $r->param;	942	@fields = $r->param unless @fields;
349	my $courseEnvironment = $self->{ce};	943
350	my $html = "";	944	my $html = "";
351
352	foreach my $param (@fields) {	945	foreach my $param (@fields) {
353	my $value = $r->param($param);	946	my @values = $r->param($param);
354	$html .= CGI::input({-type=>"hidden",-name=>"$param",-value=>"$value"});	947	$html .= CGI::hidden($param, @values);
355	}	948	}
356	return $html;	949	return $html;
357	}	950	}
358		951
359	# hidden_authen_fields() - use hidden_fields to return hidden <INPUT> tags for	952	=item hidden_authen_fields()
360	# request fields used in authentication.	953
361	#	954	Use hidden_fields to return hidden <INPUT> tags for request fields used in
		955	authentication.
		956
		957	=cut
		958
362	sub hidden_authen_fields($) {	959	sub hidden_authen_fields {
363	my $self = shift;	960	my ($self) = @_;
		961
364	return $self->hidden_fields("user","effectiveUser","key");	962	return $self->hidden_fields("user", "effectiveUser", "key");
365	}	963	}
366		964
367	# url_args(LIST) - return a URL query string (without the leading `?')	965	=item url_args(@fields)
368	# containing values for each field mentioned in LIST, or all fields if list is	966
369	# empty. Data is taken from the current request.	967	Return a URL query string (without the leading `?') containing values for each
370	#	968	field mentioned in @fields, or all fields if list is empty. Data is taken from
		969	the current request.
		970
		971	=cut
		972
371	sub url_args($;@) {	973	sub url_args {
372	my $self = shift;	974	my ($self, @fields) = @_;
373	my $r = $self->{r};	975	my $r = $self->r;
374	my @fields = @_;	976
375	@fields or @fields = $r->param; # If no fields are passed in, do them all.	977	@fields = $r->param unless @fields;
376	my $courseEnvironment = $self->{ce};
377		978
378	my @pairs;	979	my @pairs;
379	foreach my $param (@fields) {	980	foreach my $param (@fields) {
380	my @values = $r->param($param);	981	my @values = $r->param($param);
381	foreach my $value (@values) {	982	foreach my $value (@values) {
…		…
384	}	985	}
385		986
386	return join("&", @pairs);	987	return join("&", @pairs);
387	}	988	}
388		989
389	# url_authen_args() - use url_args to return a URL query string for request	990	=item url_authen_args()
390	# fields used in authentication.	991
391	#	992	Use url_args to return a URL query string for request fields used in
		993	authentication.
		994
		995	=cut
		996
392	sub url_authen_args($) {	997	sub url_authen_args {
393	my $self = shift;	998	my ($self) = @_;
394	my $r = $self->{r};	999
395	return $self->url_args("user","effectiveUser","key");	1000	return $self->url_args("user", "effectiveUser", "key");
396	}	1001	}
397		1002
398	# print_form_data(BEGIN, MIDDLE, END, OMIT) - return a string containing request	1003	=item print_form_data($begin, $middle, $end, $omit)
399	# fields not matched by OMIT, placing BEGIN before each field name, MIDDLE	1004
		1005	Return a string containing every request field not matched by the quoted reguar
		1006	expression $omit, placing $begin before each field name, $middle between each
400	# between each field and its value, and END after each value. Values are taken	1007	field name and its value, and $end after each value. Values are taken from the
401	# from the current request. OMIT is a quoted reguar expression.	1008	current request.
402	#	1009
		1010	=cut
		1011
403	sub print_form_data {	1012	sub print_form_data {
404	my ($self, $begin, $middle, $end, $qr_omit) = @_;	1013	my ($self, $begin, $middle, $end, $qr_omit) = @_;
		1014	my $r=$self->r;
		1015	my @form_data = $r->param;
		1016
405	my $return_string = "";	1017	my $return_string = "";
406	my $r=$self->{r};
407	my @form_data = $r->param;
408	foreach my $name (@form_data) {	1018	foreach my $name (@form_data) {
409	next if ($qr_omit and $name =~ /$qr_omit/);	1019	next if ($qr_omit and $name =~ /$qr_omit/);
410	my @values = $r->param($name);	1020	my @values = $r->param($name);
411	foreach my $variable (qw(begin name middle value end)) {	1021	foreach my $variable (qw(begin name middle value end)) {
		1022	# FIXME: can this loop be moved out of the enclosing loop?
412	no strict 'refs';	1023	no strict 'refs';
413	${$variable} = "" unless defined ${$variable};	1024	${$variable} = "" unless defined ${$variable};
414	}	1025	}
415	foreach my $value (@values) {	1026	foreach my $value (@values) {
416	$return_string .= "$begin$name$middle$value$end";	1027	$return_string .= "$begin$name$middle$value$end";
417	}	1028	}
418	}	1029	}
		1030
419	return $return_string;	1031	return $return_string;
420	}	1032	}
		1033
		1034	=back
		1035
		1036	=cut
		1037
		1038	# ------------------------------------------------------------------------------
		1039
		1040	=head2 Utilities
		1041
		1042	=over
		1043
		1044	=item systemLink($urlpath, %options)
		1045
		1046	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:
		1048
		1049	=over
		1050
		1051	=item authen
		1052
		1053	Boolen, whether to include authentication information in the resulting URL. If
		1054	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
		1068	=back
		1069
		1070	=cut
		1071
		1072	sub systemLink {
		1073	my ($self, $urlpath, %options) = @_;
		1074	my $r = $self->r;
		1075
		1076	my $authen = $options{authen} \|\| 1;
		1077
		1078	my $url = $r->location . $urlpath->path;
		1079
		1080	if ($authen) {
		1081	my $realUserID = $options{realUserID} \|\| $r->param("user");
		1082	my $sessionKey = $options{sessionKey} \|\| $r->param("key");
		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	}
		1092
		1093	return $url;
		1094	}
		1095
		1096	=item nbsp($string)
		1097
		1098	If string consists of only whitespace, the HTML entity C< > is returned.
		1099	Otherwise $string is returned.
		1100
		1101	=cut
		1102
		1103	sub nbsp {
		1104	my $self = shift;
		1105	my $str = shift;
		1106	($str =~/\S/) ? $str : ' ';
		1107	}
		1108
		1109	=item errorOutput($error, $details)
		1110
		1111	=cut
421		1112
422	sub errorOutput($$$) {	1113	sub errorOutput($$$) {
423	my ($self, $error, $details) = @_;	1114	my ($self, $error, $details) = @_;
424	return	1115	return
425	CGI::h3("Software Error"),	1116	CGI::h3("Software Error"),
…		…
427	WeBWorK has encountered a software error while attempting to process this	1118	WeBWorK has encountered a software error while attempting to process this
428	problem. It is likely that there is an error in the problem itself. If you are	1119	problem. It is likely that there is an error in the problem itself. If you are
429	a student, contact your professor to have the error corrected. If you are a	1120	a student, contact your professor to have the error corrected. If you are a
430	professor, please consut the error output below for more informaiton.	1121	professor, please consut the error output below for more informaiton.
431	EOF	1122	EOF
		1123	# FIXME: this message shouldn't refer the the "problem" since it is for general error reporting
432	CGI::h3("Error messages"), CGI::p(CGI::tt($error)),	1124	CGI::h3("Error messages"), CGI::p(CGI::tt($error)),
433	CGI::h3("Error context"), CGI::p(CGI::tt($details));	1125	CGI::h3("Error context"), CGI::p(CGI::tt($details));
434	}	1126	}
		1127
		1128	=item warningOutput($warnings)
		1129
		1130	=cut
435		1131
436	sub warningOutput($$) {	1132	sub warningOutput($$) {
437	my ($self, $warnings) = @_;	1133	my ($self, $warnings) = @_;
438		1134
439	my @warnings = split m/\n+/, $warnings;	1135	my @warnings = split m/\n+/, $warnings;
…		…
444	WeBWorK has encountered warnings while attempting to process this problem. It	1140	WeBWorK has encountered warnings while attempting to process this problem. It
445	is likely that this indicates an error or ambiguity in the problem itself. If	1141	is likely that this indicates an error or ambiguity in the problem itself. If
446	you are a student, contact your professor to have the problem corrected. If you	1142	you are a student, contact your professor to have the problem corrected. If you
447	are a professor, please consut the warning output below for more informaiton.	1143	are a professor, please consut the warning output below for more informaiton.
448	EOF	1144	EOF
		1145	# FIXME: this message shouldn't refer the the "problem" since it is for general warning reporting
449	CGI::h3("Warning messages"),	1146	CGI::h3("Warning messages"),
450	CGI::ul(CGI::li(\@warnings)),	1147	CGI::ul(CGI::li(\@warnings));
451	;
452	}	1148	}
453		1149
454	################################################################################	1150	=back
455	# Generic versions of template escapes
456	################################################################################
457		1151
458	# Reminder: here are the template functions currently defined:	1152	=head1 AUTHOR
459	# FIXME: this list is out of date!!!!!!!!
460	#
461	# head
462	# path
463	# style = text\|image
464	# image = URL of image
465	# text = text separator
466	# loginstatus
467	# links
468	# siblings
469	# nav
470	# style = text\|image
471	# imageprefix = prefix to image URL
472	# imagesuffix = suffix to image URL
473	# separator = HTML to place in between links
474	# title
475	# body
476		1153
477	sub header {	1154	Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu and Sam Hathaway,
478	my $self = shift;	1155	sh002i (at) math.rochester.edu.
479	my $r = $self->{r};
480
481	if ($self->{sendFile}) {
482	my $contentType = $self->{sendFile}->{type};
483	my $fileName = $self->{sendFile}->{name};
484	$r->content_type($contentType);
485	$r->header_out("Content-Disposition" => "attachment; filename=\"$fileName\"");
486	} else {
487	$r->content_type("text/html");
488
489	}
490
491	$r->send_http_header();
492	return OK;
493	}
494		1156
495	sub loginstatus {	1157	=cut
496	my $self = shift;
497	my $r = $self->{r};
498	my $user = $r->param("user");
499	my $eUser = $r->param("effectiveUser");
500	my $key = $r->param("key");
501	return "" unless $key;
502	my $exitURL = $r->uri() . "?user=$user&key=$key";
503	print CGI::small("User:", "$user");
504	if ($user ne $eUser) {
505	print CGI::br(), CGI::font({-color=>'red'},
506	CGI::small("Acting as:", "$eUser")
507	),
508	CGI::br(), CGI::a({-href=>$exitURL},
509	CGI::small("Stop Acting")
510	);
511	}
512	return "";
513	}
514
515	# FIXME: drunk code. rewrite.
516	# also, this should be structured s.t. subclasses can add items to the links
517	# area, i.e. "stacking"
518	sub links {
519	my $self = shift;
520	my @components = @_;
521	my $ce = $self->{ce};
522	my $db = $self->{db};
523	my $userName = $self->{r}->param("user");
524	my $courseName = $ce->{courseName};
525	my $root = $ce->{webworkURLs}->{root};
526
527	#my $Key = $db->getKey($userName); # checked
528	#my $key = (defiend $key
529	# ? $Key->key()
530	# : "");
531	#
532	#return "" unless defined $key;
533	# This has been replaced by using "#if loggedin" in ur.template.
534
535	# URLs to parts of the system
536	my $probSets = "$root/$courseName/?" . $self->url_authen_args();
537	my $prefs = "$root/$courseName/options/?" . $self->url_authen_args();
538	my $help = "$ce->{webworkURLs}->{docs}?" . $self->url_authen_args();
539	my $logout = "$root/$courseName/logout/?" . $self->url_authen_args();
540
541	my $PermissionLevel = $db->getPermissionLevel($userName); # checked
542	my $permLevel = (defined $PermissionLevel
543	? $PermissionLevel->permission()
544	: 0);
545
546	return join("",
547	CGI::a({-href=>$probSets}, "Problem Sets"), CGI::br(),
548	CGI::a({-href=>$prefs}, "User Prefs"), CGI::br(),
549	CGI::a({-href=>$help}, "Help"), CGI::br(),
550	CGI::a({-href=>$logout}, "Log Out"), CGI::br(),
551	($permLevel > 0
552	? $self->instructor_links(@components) : ""
553	),
554	);
555	}
556	sub instructor_links {
557	my $self = shift;
558	my @components = @_;
559	my $args = pop(@components); # get hash of option arguments
560	my $courseName = $self->{ce}->{courseName};
561	my $root = $self->{ce}->{webworkURLs}->{root};
562	my $userName = $self->{r}->param("effectiveUser");
563	$userName = $self->{r}->param("user") unless defined $userName;
564	my ($set, $prob) = @components;
565	my $instructor = "$root/$courseName/instructor/?" . $self->url_authen_args();
566	my $sets = "$root/$courseName/instructor/sets/?" . $self->url_authen_args();
567	my $users = "$root/$courseName/instructor/users/?" . $self->url_authen_args();
568	my $email = "$root/$courseName/instructor/send_mail/?" . $self->url_authen_args();
569	my $scoring = "$root/$courseName/instructor/scoring/?" . $self->url_authen_args();
570	my $statsRoot = "$root/$courseName/instructor/stats";
571	my $stats = $statsRoot. '/?'.$self->url_authen_args();
572	my $fileXfer = "$root/$courseName/instructor/files/?" . $self->url_authen_args();
573
574
575	# Add direct links to sets e.g. 3:4 for set3 problem 4
576	my $setURL = (defined $set)
577	? "$root/$courseName/instructor/sets/$set/?" . $self->url_authen_args()
578	: '';
579	my $probURL = (defined $set && defined $prob)
580	? "$root/$courseName/instructor/pgProblemEditor/$set/$prob?" . $self->url_authen_args()
581	: '';
582
583	my ($setLink, $problemLink) = ("", "");
584	if ($setURL) {
585	$setLink = "    "
586	. CGI::a({-href=>$setURL}, "Set $set")
587	. CGI::br();
588	if ($probURL) {
589	$problemLink = "    "
590	. CGI::a({-href=>$probURL}, "Problem $prob")
591	. CGI::br();
592	}
593	}
594
595	#my $setProb = ($setURL)
596	# ? CGI::a({-href=>$setURL}, $set)
597	# : '';
598	#$setProb .= ':' . CGI::a({-href=>$probURL},$prob) if $setProb && $probURL;
599
600	return join("",
601	CGI::hr(),
602	CGI::a({-href=>$instructor}, "Instructor Tools") , CGI::br(),
603	'  ',CGI::a({-href=>$sets}, "Set List"), CGI::br(),
604	$setLink,
605	$problemLink,
606	'  ',CGI::a({-href=>$users}, "User List"), CGI::br(),
607	'  ',CGI::a({-href=>$email}, "Send Email"), CGI::br(),
608	'  ',CGI::a({-href=>$scoring}, "Score Sets"), CGI::br(),
609	'  ',CGI::a({-href=>$stats}, 'Statistics'), CGI::br(),
610	(defined($set))
611	? '    '.CGI::a({-href=>"$statsRoot/set/$set/?".$self->url_authen_args}, "$set").CGI::br()
612	: '',
613	(defined($userName))
614	? '    '.CGI::a({-href=>"$statsRoot/student/$userName/?".$self->url_authen_args}, "$userName").CGI::br()
615	: '',
616	'  ',CGI::a({-href=>$fileXfer}, "File Transfer"), CGI::br(),
617	);
618	}
619
620	# &if_can will return 1 if the current object->can("do $_[1]")
621	sub if_can ($$) {
622	my ($self, $arg) = (@_);
623
624	if ($self->can("$arg")) {
625	return 1;
626	} else {
627	return 0;
628	}
629	}
630
631	# Every content generator is logged in unless it says otherwise.
632	sub if_loggedin($$) {
633	my ($self, $arg) = (@_);
634
635	return $arg;
636	}
637
638	# Handling of errors in submissions
639
640	sub if_submiterror($$) {
641	my ($self, $arg) = @_;
642	if (exists $self->{submitError}) {
643	return $arg;
644	} else {
645	return !$arg;
646	}
647	}
648
649	sub submiterror {
650	my ($self) = @_;
651	if (exists $self->{submitError}) {
652	return $self->{submitError};
653	} else {
654	return "";
655	}
656	}
657
658	# General warning handling
659
660	sub if_warnings($$) {
661	my ($self, $arg) = @_;
662	return $self->{r}->notes("warnings") ? $arg : !$arg;
663	}
664
665	sub warnings {
666	my ($self) = @_;
667	my $r = $self->{r};
668	if ($r->notes("warnings")) {
669	return $self->warningOutput($r->notes("warnings"));
670	} else {
671	return "";
672	}
673	}
674		1158
675	1;	1159	1;
676
677	__END__
678
679	=head1 AUTHOR
680
681	Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu
682	and Sam Hathaway, sh002i (at) math.rochester.edu.
683
684	=cut

 Legend:



Removed from v.1663
 


changed lines


 
Added in v.1880
 Legend:



Removed from v.1663
 


changed lines


 
Added in v.1880
-Removed from v.1663
+Added in v.1880

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9