Diff of /trunk/webwork2/lib/WeBWorK/ContentGenerator.pm

Revision 1360		Revision 2906
1	################################################################################	1	################################################################################
2	# WeBWorK mod_perl (c) 2000-2002 WeBWorK Project	2	# WeBWorK Online Homework Delivery System
3	# $Id$	3	# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
		4	# $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator.pm,v 1.119 2004/10/10 20:53:19 sh002i Exp $
		5	#
		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
		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.
		10	#
		11	# This program is distributed in the hope that it will be useful, but WITHOUT
		12	# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
		13	# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
		14	# Artistic License for more details.
4	################################################################################	15	################################################################################
5		16
6	package WeBWorK::ContentGenerator;	17	package WeBWorK::ContentGenerator;
7		18
8	=head1 NAME	19	=head1 NAME
9		20
10	WeBWorK::ContentGenerator - base class for modules that generate page content.	21	WeBWorK::ContentGenerator - base class for modules that generate page content.
		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.
11		41
12	=cut	42	=cut
13		43
14	use strict;	44	use strict;
15	use warnings;	45	use warnings;
16	use Apache::Constants qw(:common);	46	use Apache::Constants qw(:response);
17	use CGI qw();	47	use Carp;
		48	use CGI::Pretty qw(ul li);
		49	use Date::Format;
18	use URI::Escape;	50	use URI::Escape;
19	use WeBWorK::Authz;	51	use WeBWorK::Template qw(template);
20	use WeBWorK::DB;
21	use WeBWorK::Utils qw(readFile);
22		52
23	################################################################################	53	###############################################################################
24	# This is a very unruly file, so I'm going to use very large comments to divide
25	# it into logical sections.
26	################################################################################
27		54
28	# new(Apache::Request, WeBWorK::CourseEnvironment) - create a new instance of a	55	=head1 CONSTRUCTOR
29	# content generator. Usually only called by the dispatcher, although one might	56
30	# be able to use it for things like "sub-requests". Uh... uh... I have to think	57	=over
31	# about that one. The dispatcher uses this idiom:	58
32	#	59	=item new($r)
33	# WeBWorK::ContentGenerator::WHATEVER->new($r, $ce)->go(@whatever);	60
34	#	61	Creates a new instance of a content generator. Supply a WeBWorK::Request object
35	# and throws away the result ;)	62	$r.
36	#	63
		64	=cut
		65
37	sub new($$$$) {	66	sub new {
38	my ($invocant, $r, $ce, $db) = @_;	67	my ($invocant, $r) = @_;
39	my $class = ref($invocant) \|\| $invocant;	68	my $class = ref($invocant) \|\| $invocant;
40	my $self = {	69	my $self = {
41	r => $r,	70	r => $r, # this is now a WeBWorK::Request
42	ce => $ce,	71	ce => $r->ce(), # these three are here for
43	db => $db,	72	db => $r->db(), # backward-compatability
44	authz => WeBWorK::Authz->new($r, $ce, $db)	73	authz => $r->authz(), # with unconverted CGs
		74	noContent => undef, # this should get clobbered at some point
45	};	75	};
46	bless $self, $class;	76	bless $self, $class;
47	return $self;	77	return $self;
48	}	78	}
49		79
		80	=back
		81
		82	=cut
		83
50	################################################################################	84	################################################################################
51	# Invocation and template processing	85
		86	=head1 INVOCATION
		87
		88	=over
		89
		90	=item go()
		91
		92	Generates a page, using methods from the particular subclass of ContentGenerator
		93	that is instantiated. Generatoion is broken up into several steps, to give
		94	subclasses ample control over the process.
		95
		96	=over
		97
		98	=item 1
		99
		100	go() will attempt to call the method pre_header_initialize(). This method may be
		101	implemented in subclasses which must do processing before the HTTP header is
		102	emitted.
		103
		104	=item 2
		105
		106	go() will attempt to call the method header(). This method emits the HTTP
		107	header. It is defined in this class (see below), but may be overridden in
		108	subclasses which need to send different header information. For some reason, the
		109	return value of header() will be used as the result of this function, if it is
		110	defined.
		111
		112	FIXME: figure out what the deal is with the return value of header(). If we sent
		113	a header, it's too late to set the status by returning. If we didn't, header()
		114	didn't perform its function!
		115
		116	=item 3
		117
		118	At this point, go() will terminate if the request is a HEAD request or if the
		119	field $self->{noContent} contains a true value.
		120
		121	FIXME: I don't think we'll need noContent after reply_with_redirect() is
		122	adopted by all modules.
		123
		124	=item 4
		125
		126	go() then attempts to call the method initialize(). This method may be
		127	implemented in subclasses which must do processing after the HTTP header is sent
		128	but before any content is sent.
		129
		130	=item 6
		131
		132	The method content() is called to send the page content to client.
		133
		134	=back
		135
		136	=cut
		137
		138	sub go {
		139	my ($self) = @_;
		140	my $r = $self->r;
		141	my $ce = $r->ce;
		142
		143	my $returnValue = OK;
		144
		145	$self->pre_header_initialize(@_) if $self->can("pre_header_initialize");
		146
		147	# send a file instead of a normal reply (reply_with_file() sets this field)
		148	defined $self->{reply_with_file} and do {
		149	return $self->do_reply_with_file($self->{reply_with_file});
		150	};
		151
		152	# send a Location: header instead of a normal reply (reply_with_redirect() sets this field)
		153	defined $self->{reply_with_redirect} and do {
		154	return $self->do_reply_with_redirect($self->{reply_with_redirect});
		155	};
		156
		157	my $headerReturn = $self->header(@_);
		158	$returnValue = $headerReturn if defined $headerReturn;
		159	# FIXME: we won't need noContent after reply_with_redirect() is adopted
		160	return $returnValue if $r->header_only or $self->{noContent};
		161
		162	$self->initialize() if $self->can("initialize");
		163
		164	$self->content();
		165
		166	return $returnValue;
		167	}
		168
		169	=item r()
		170
		171	Returns a reference to the WeBWorK::Request object associated with this
		172	instance.
		173
		174	=cut
		175
		176	sub r {
		177	my ($self) = @_;
		178
		179	return $self->{r};
		180	}
		181
		182	=item do_reply_with_file($fileHash)
		183
		184	Handler for reply_with_file(), used by go(). DO NOT CALL THIS METHOD DIRECTLY.
		185
		186	=cut
		187
		188	sub do_reply_with_file {
		189	my ($self, $fileHash) = @_;
		190	my $r = $self->r;
		191
		192	my $type = $fileHash->{type};
		193	my $source = $fileHash->{source};
		194	my $name = $fileHash->{name};
		195	my $delete_after = $fileHash->{delete_after};
		196
		197	# if there was a problem, we return here and let go() worry about sending the reply
		198	return NOT_FOUND unless -e $source;
		199	return FORBIDDEN unless -r $source;
		200
		201	# open the file now, so we can send the proper error status is we fail
		202	open my $fh, "<", $source or return SERVER_ERROR;
		203
		204	# send our custom HTTP header
		205	$r->content_type($type);
		206	$r->header_out("Content-Disposition" => "attachment; filename=\"$name\"");
		207	$r->send_http_header;
		208
		209	# send the file
		210	$r->send_fd($fh);
		211
		212	# close the file and go home
		213	close $fh;
		214
		215	if ($delete_after) {
		216	unlink $source or warn "failed to unlink $source after sending: $!";
		217	}
		218	}
		219
		220	=item do_reply_with_redirect($url)
		221
		222	Handler for reply_with_redirect(), used by go(). DO NOT CALL THIS METHOD DIRECTLY.
		223
		224	=cut
		225
		226	sub do_reply_with_redirect {
		227	my ($self, $url) = @_;
		228	my $r = $self->r;
		229
		230	$r->status(REDIRECT);
		231	$r->header_out(Location => $url);
		232	$r->send_http_header();
		233	}
		234
		235	=back
		236
		237	=cut
		238
52	################################################################################	239	################################################################################
53		240
54	# go(@otherArguments) - render a page, using methods from the particular	241	=head1 DATA MODIFIERS
55	# subclass of ContentGenerator. @otherArguments is passed to each method, so	242
56	# that the dispatcher can pass CG-specific data. The order of calls looks like	243	Modifiers allow the caller to register a piece of data for later retrieval in a
57	# this:	244	standard way.
58	#	245
59	# * &pre_header_initialize - give subclasses a chance to do initialization	246	=over
60	# necessary for generating the HTTP header.	247
61	# * &header - this class provides a standard HTTP header with Content-Type	248	=item reply_with_file($type, $source, $name, $delete_after)
62	# text/html. Subclasses are welcome to overload this for things like	249
63	# an image-creation content generator or a PDF generator.	250	Enables file sending mode, causing go() to send the file specified by $source to
64	# * &initialize - let subclasses do post-header initialization.	251	the client after calling pre_header_initialize(). The content type sent is
65	# * any "template escapes" defined in the system template and supported by	252	$type, and the suggested client-side file name is $name. If $delete_after is
66	# the subclass. Generic implementations of &title and &body are provided.	253	true, $source is deleted after it is sent.
67	#	254
68	sub go {	255	Must be called before the HTTP header is sent. Usually called from
		256	pre_header_initialize().
		257
		258	=cut
		259
		260	sub reply_with_file {
		261	my ($self, $type, $source, $name, $delete_after) = @_;
		262	$delete_after \|\|= "";
		263
		264	$self->{reply_with_file} = {
		265	type => $type,
		266	source => $source,
		267	name => $name,
		268	delete_after => $delete_after,
		269	};
		270	}
		271
		272	=item reply_with_redirect($url)
		273
		274	Enables redirect mode, causing go() to redirect to the given URL after calling
		275	pre_header_initialize().
		276
		277	Must be called before the HTTP header is sent. Usually called from
		278	pre_header_initialize().
		279
		280	=cut
		281
		282	sub reply_with_redirect {
		283	my ($self, $url) = @_;
		284
		285	$self->{reply_with_redirect} = $url;
		286	}
		287
		288	=item addmessage($message)
		289
		290	Adds a message to the list of messages to be printed by the message() template
		291	escape handler.
		292
		293	Must be called before the message() template escape is invoked.
		294
		295	=cut
		296
		297	# FIXME: we should probably
		298
		299	sub addmessage {
		300	my ($self, $message) = @_;
		301	$self->{status_message} .= $message;
		302	}
		303
		304	=item addgoodmessage($message)
		305
		306	Adds a success message to the list of messages to be printed by the
		307	message() template escape handler.
		308
		309	=cut
		310
		311
		312	sub addgoodmessage {
		313	my ($self, $message) = @_;
		314	$self->addmessage(CGI::div({class=>"ResultsWithoutError"}, $message));
		315	}
		316
		317	=item addbadmessage($message)
		318
		319	Adds a failure message to the list of messages to be printed by the
		320	message() template escape handler.
		321
		322	=cut
		323
		324
		325	sub addbadmessage {
		326	my ($self, $message) = @_;
		327	$self->addmessage(CGI::div({class=>"ResultsWithError"}, $message));
		328	}
		329
		330	=back
		331
		332	=cut
		333
		334	################################################################################
		335
		336	=head1 STANDARD METHODS
		337
		338	The following are the standard content generator methods. Some are defined here,
		339	but may be overridden in a subclass. Others are not defined unless they are
		340	defined in a subclass.
		341
		342	=over
		343
		344	=item pre_header_initialize()
		345
		346	Not defined in this package.
		347
		348	May be defined by a subclass to perform any processing that must occur before
		349	the HTTP header is sent.
		350
		351	=cut
		352
		353	#sub pre_header_initialize { }
		354
		355	=item header()
		356
		357	Defined in this package.
		358
		359	Generates and sends a default HTTP header, specifying the "text/html" content
		360	type.
		361
		362	=cut
		363
		364	sub header {
69	my $self = shift;	365	my $self = shift;
70
71	my $r = $self->{r};	366	my $r = $self->r;
72	my $courseEnvironment = $self->{ce};
73		367
74	$self->pre_header_initialize(@_) if $self->can("pre_header_initialize");	368	$r->content_type("text/html");
75	$self->header(@_);	369	$r->send_http_header();
76	return OK if $r->header_only;
77
78	$self->initialize(@_) if $self->can("initialize");
79	$self->template($courseEnvironment->{templates}->{system}, @_);
80
81	return OK;	370	return OK;
82	}	371	}
83		372
84	# template(STRING, @otherArguments) - parse a template, looking for escapes of	373	=item initialize()
85	# the form <!--#NAME ARG1="FOO" ARG2="BAR"--> and calling a member function NAME	374
86	# (if available) for each NAME. The escapes are called like:	375	Not defined in this package.
87	#	376
88	# $self->NAME(@otherArguments, \%escapeArguments)	377	May be defined by a subclass to perform any processing that must occur after the
89	#	378	HTTP header is sent but before any content is sent.
90	# where @otherArguments originates in the dispatcher and %escapeArguments is	379
91	# parsed out of the escape itself (i.e. ARG1 => FOO, ARG2 => BAR)	380	=cut
92	#	381
93	sub template {	382	#sub initialize { }
94	my ($self, $templateFile) = (shift, shift);	383
		384	=item content()
		385
		386	Defined in this package.
		387
		388	Print the content of the generated page.
		389
		390	The implementation in this package uses WeBWorK::Template to define the content
		391	of the page. See WeBWorK::Template for details.
		392
		393	If a method named templateName() exists, it it called to determine the name of
		394	the template to use. If not, the default template, "system", is used. The
		395	location of the template is looked up in the course environment.
		396
		397	=cut
		398
		399	sub content {
		400	my ($self) = @_;
		401	my $ce = $self->r->ce;
		402
		403	# if the content generator specifies a custom template name, use that
		404	# field in the $ce->{templates} hash instead of "system" if it exists.
		405	my $templateName;
		406	if ($self->can("templateName")) {
		407	$templateName = $self->templateName;
		408	} else {
		409	$templateName = "system";
		410	}
		411	$templateName = "system" unless exists $ce->{templates}->{$templateName};
		412	template($ce->{templates}->{$templateName}, $self);
		413	}
		414
		415	=back
		416
		417	=cut
		418
		419	# ------------------------------------------------------------------------------
		420
		421	=head2 Template escape handlers
		422
		423	Template escape handlers are invoked when the template processor encounters a
		424	matching escape sequence in the template. The escapse sequence's arguments are
		425	passed to the methods as a reference to a hash.
		426
		427	For more information, refer to WeBWorK::Template.
		428
		429	The following template escapes handlers are defined here or may be defined in
		430	subclasses. For methods that are not defined in this package, the documentation
		431	defines the interface and behavior that any subclass implementation must follow.
		432
		433	=over
		434
		435	=item head()
		436
		437	Not defined in this package.
		438
		439	Any tags that should appear in the HEAD of the document.
		440
		441	=cut
		442
		443	#sub head { }
		444
		445	=item info()
		446
		447	Not defined in this package.
		448
		449	Auxiliary information related to the content displayed in the C<body>.
		450
		451	=cut
		452
		453	#sub info { }
		454
		455	=item links()
		456
		457	Defined in this package.
		458
		459	Links that should appear on every page.
		460
		461	=cut
		462
		463	sub links {
		464	my ($self) = @_;
95	my $r = $self->{r};	465	my $r = $self->r;
96	my $courseEnvironment = $self->{ce};	466	my $db = $r->db;
97	my @ifstack = (1); # Start off in printing mode	467	my $authz = $r->authz;
98	# say $ifstack[-1] to get the result of the last <#!--if-->	468	my $ce = $r->ce;
		469	my $urlpath = $r->urlpath;
		470	my $user = $r->param('user');
99		471
100	# so even though the variable $/ APPEARS to contain a newline,	472	# we're linking to other places in the same course, so grab the courseID from the current path
101	# <TEMPLATE> is slurping the whole file into the first element of	473	my $courseID = $urlpath->arg("courseID");
102	# @template ONLY AFTER THE TRANSLATOR RUNS. WTF!!!
103	#
104	#open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile";
105	#my @template = <TEMPLATE>;
106	#close TEMPLATE;
107	#
108	# Let's try something else instead:
109	my @template = split /\n/, readFile($templateFile);
110		474
111	foreach my $line (@template) {	475	# to make things more concise
112	# This is incremental regex processing.	476	my %args = ( courseID => $courseID );
113	# the /c is so that pos($line) doesn't die when the regex fails.	477	my $pfx = "WeBWorK::ContentGenerator::";
114	while ($line =~ m/\G(.?)<!--#(\w)((?:\s+.*?)?)-->/gc) {	478
115	my ($before, $function, $raw_args) = ($1, $2, $3);	479	my $sets = $urlpath->newFromModule("${pfx}ProblemSets", %args);
116	my @args = ($raw_args =~ /\S/) ? cook_args($raw_args) : ();	480	my $options = $urlpath->newFromModule("${pfx}Options", %args);
		481	my $grades = $urlpath->newFromModule("${pfx}Grades", %args);
		482	my $logout = $urlpath->newFromModule("${pfx}Logout", %args);
		483
		484	print "\n<!-- BEGIN " . __PACKAGE__ . "::links -->\n";
		485
		486	# only users with appropriate permissions can report bugs
		487	if ($authz->hasPermissions($user, "report_bugs")) {
		488	print CGI::p(CGI::a({style=>"font-size:larger", href=>$ce->{webworkURLs}{bugReporter}}, "Report bugs")),CGI::hr();
		489	}
		490
		491	print CGI::start_ul({class=>"LinksMenu"});
		492	print CGI::li(CGI::span({style=>"font-size:larger"},
		493	CGI::a({href=>$self->systemLink($sets)}, sp2nbsp("Homework Sets"))));
		494
		495	if ($authz->hasPermissions($user, "change_password") or $authz->hasPermissions($user, "change_email_address")) {
		496	print CGI::li(CGI::a({href=>$self->systemLink($options)}, sp2nbsp($options->name)));
		497	}
		498
		499	print CGI::li(CGI::a({href=>$self->systemLink($grades)}, sp2nbsp($grades->name)));
		500	print CGI::li(CGI::a({href=>$self->systemLink($logout)}, sp2nbsp($logout->name)));
		501
		502	if ($authz->hasPermissions($user, "access_instructor_tools")) {
		503	my $ipfx = "${pfx}Instructor::";
117		504
118	if ($ifstack[-1]) {	505	my $userID = $r->param("effectiveUser");
119	print $before;	506	my $setID = $urlpath->arg("setID");
		507	$setID = "" if (defined $setID && !(grep /$setID/, $db->listUserSets($userID)));
		508	my $problemID = $urlpath->arg("problemID");
		509	$problemID = "" if (defined $problemID && !(grep /$problemID/, $db->listUserProblems($userID, $setID)));
		510
		511	my $instr = $urlpath->newFromModule("${ipfx}Index", %args);
		512	my $addUsers = $urlpath->newFromModule("${ipfx}AddUsers", %args);
		513	my $userList = $urlpath->newFromModule("${ipfx}UserList", %args);
		514
		515	# set list links
		516	my $setList = $urlpath->newFromModule("${ipfx}ProblemSetList", %args);
		517	my $setDetail = $urlpath->newFromModule("${ipfx}ProblemSetDetail", %args, setID => $setID);
		518	my $problemEditor = $urlpath->newFromModule("${ipfx}PGProblemEditor", %args, setID => $setID, problemID => $problemID);
		519
		520	my $maker = $urlpath->newFromModule("${ipfx}SetMaker", %args);
		521	my $assigner = $urlpath->newFromModule("${ipfx}Assigner", %args);
		522	my $mail = $urlpath->newFromModule("${ipfx}SendMail", %args);
		523	my $scoring = $urlpath->newFromModule("${ipfx}Scoring", %args);
		524
		525	# statistics links
		526	my $stats = $urlpath->newFromModule("${ipfx}Stats", %args);
		527	my $userStats = $urlpath->newFromModule("${ipfx}Stats", %args, statType => "student", userID => $userID);
		528	my $setStats = $urlpath->newFromModule("${ipfx}Stats", %args, statType => "set", setID => $setID);
		529
		530	# progress links
		531	my $progress = $urlpath->newFromModule("${ipfx}StudentProgress", %args);
		532	my $userProgress = $urlpath->newFromModule("${ipfx}StudentProgress", %args, statType => "student", userID => $userID);
		533	my $setProgress = $urlpath->newFromModule("${ipfx}StudentProgress", %args, statType => "set", setID => $setID);
		534
		535
		536	my $fileMgr = $urlpath->newFromModule("${ipfx}FileManager", %args);
		537	my $fileXfer = $urlpath->newFromModule("${ipfx}FileXfer", %args);
		538
		539	print CGI::hr();
		540	print CGI::start_li();
		541	print CGI::span({style=>"font-size:larger"},
		542	CGI::a({href=>$self->systemLink($instr)}, space2nbsp($instr->name))
		543	);
		544	print CGI::start_ul();
		545	#print CGI::li(CGI::a({href=>$self->systemLink($addUsers)}, sp2nbsp($addUsers->name))) if $authz->hasPermissions($user, "modify_student_data");
		546	print CGI::li(CGI::a({href=>$self->systemLink($userList)}, sp2nbsp($userList->name)));
		547	print CGI::start_li();
		548	print CGI::a({href=>$self->systemLink($setList)}, sp2nbsp($setList->name));
		549	if (defined $setID and $setID ne "") {
		550	print CGI::start_ul();
		551	print CGI::start_li();
		552	print CGI::a({href=>$self->systemLink($setDetail)}, $setID);
		553	if (defined $problemID and $problemID ne "") {
		554	print CGI::ul(
		555	CGI::li(CGI::a({href=>$self->systemLink($problemEditor)}, $problemID))
		556	);
120	}	557	}
		558	print CGI::end_li();
		559	print CGI::end_ul();
		560	}
		561	print CGI::end_li();
		562	print CGI::li(CGI::a({href=>$self->systemLink($maker)}, sp2nbsp($maker->name))) if $authz->hasPermissions($user, "modify_problem_sets");
		563	print CGI::li(CGI::a({href=>$self->systemLink($assigner)}, sp2nbsp($assigner->name))) if $authz->hasPermissions($user, "assign_problem_sets");
121		564
122	if ($function eq "if") {	565	print CGI::li(CGI::a({href=>$self->systemLink($stats)}, sp2nbsp($stats->name)));
123	# a predicate can only be true if everything else on the ifstack is already true, for ANDing	566
124	push @ifstack, ($self->$function(@_, [@args]) && $ifstack[-1]);	567	## Added Link for Student Progress
125	} elsif ($function eq "else" and @ifstack > 1) {	568	print CGI::li(CGI::a({href=>$self->systemLink($progress)}, sp2nbsp($progress->name)));
126	$ifstack[-1] = not $ifstack[-1];	569	print CGI::start_li();
127	} elsif ($function eq "endif" and @ifstack > 1) {	570	if (defined $userID and $userID ne "") {
128	pop @ifstack;	571	print CGI::ul(
129	} elsif ($ifstack[-1]) {	572	CGI::li(CGI::a({href=>$self->systemLink($userProgress)}, $userID))
130	if ($self->can($function)) {	573	);
131	my @result = $self->$function(@_, {@args});
132	if (@result) {
133	print @result;
134	} else {
135	warn "Template escape $function returned an empty list.";
136	}
137	}
138	}	574	}
		575	if (defined $setID and $setID ne "") {
		576	print CGI::ul(
		577	CGI::li(CGI::a({href=>$self->systemLink($setProgress)}, space2nbsp($setID)))
		578	);
		579	}
		580	print CGI::end_li();
		581
		582	print CGI::li(CGI::a({href=>$self->systemLink($scoring)}, sp2nbsp($scoring->name))) if $authz->hasPermissions($user, "score_sets");
		583	print CGI::li(CGI::a({href=>$self->systemLink($mail)}, sp2nbsp($mail->name))) if $authz->hasPermissions($user, "send_mail");
		584	print CGI::li(CGI::a({href=>$self->systemLink($fileMgr)}, sp2nbsp($fileMgr->name)));
		585	print CGI::li(CGI::a({href=>$self->systemLink($fileXfer)}, sp2nbsp($fileXfer->name)));
		586	print CGI::li( $self->helpMacro('instructor_links'));
		587	print CGI::end_ul();
		588
		589	}
		590
		591	print CGI::end_ul();
		592	print "<!-- end " . __PACKAGE__ . "::links -->\n";
		593
		594	return "";
		595	}
		596
		597	=item loginstatus()
		598
		599	Defined in this package.
		600
		601	Print a notification message announcing the current real user and effective
		602	user, a link to stop acting as the effective user, and a link to logout.
		603
		604	=cut
		605
		606	sub loginstatus {
		607	my ($self) = @_;
		608	my $r = $self->r;
		609	my $urlpath = $r->urlpath;
		610
		611	my $key = $r->param("key");
		612
		613	if ($key) {
		614	my $courseID = $urlpath->arg("courseID");
		615	my $userID = $r->param("user");
		616	my $eUserID = $r->param("effectiveUser");
		617
		618	my $stopActingURL = $self->systemLink($urlpath, # current path
		619	params => { effectiveUser => $userID },
		620	);
		621	my $logoutURL = $self->systemLink($urlpath->newFromModule(__PACKAGE__ . "::Logout", courseID => $courseID));
		622
		623	print "\n<!-- BEGIN " . __PACKAGE__ . "::loginstatus -->\n";
		624
		625	print "Logged in as $userID. ", CGI::br();
		626	print CGI::a({href=>$logoutURL}, "Log Out");
		627
		628	if ($eUserID ne $userID) {
		629	print " \| Acting as $eUserID. ";
		630	print CGI::a({href=>$stopActingURL}, "Stop Acting");
139	}	631	}
140		632
141	if ($ifstack[-1]) {	633	print "<!-- END " . __PACKAGE__ . "::loginstatus -->\n";
142	print substr($line, (defined pos $line) ? pos $line : 0), "\n";
143	}	634	}
144	}
145	}
146
147	# cook_args(STRING) - parses a string of the form ARG1="FOO" ARG2="BAR". Returns
148	# a list which pairs into key/values and fits nicely in {}s.
149	#
150	sub cook_args($) { # ... also used by bin/wwdb, so watch out
151	my ($raw_args) = @_;
152	my @args = ();
153		635
154	# Boy I love m//g in scalar context! Go read the camel book, heathen.	636	return "";
155	# First, get the whole token with the quotes on both ends...
156	while ($raw_args =~ m/\G\s(\w)="((?:[^"\\]\|\\.)*)"/g) {
157	my ($key, $value) = ($1, $2);
158	# ... then, rip out all the protecty backspaces
159	$value =~ s/\\(.)/$1/g;
160	push @args, $key => $value;
161	}
162
163	return @args;
164	}	637	}
165		638
166	# This is different. It probably shouldn't print anything (except in debugging cases)	639	=item nav($args)
167	# and it should return a boolean, not a string. &if is called in a nonstandard way
168	# by &template, with $args as an arrayref instead of a hashref. this is a hack! yay!
169		640
170	# OK, this is a pluggin architecture. it iterates through attributes of the "if" tag,	641	Not defined in this package.
171	# and for each predicate $p, it calls &if_$p in an object-oriented way, continuing the	642
172	# grand templating theme of an object-oriented pluggable architecture using ->can($).	643	Links to the previous, next, and parent objects.
173	sub if {	644
		645	$args is a reference to a hash containing the following fields:
		646
		647	style => text\|image
		648	imageprefix => prefix to prepend to base image URL
		649	imagesuffix => suffix to append to base image URL
		650	separator => HTML to place in between links
		651
		652	If C<style> is "image", image URLs are constructed by prepending C<imageprefix>
		653	and postpending C<imagesuffix> to the image base names defined by the
		654	implementor. (Examples of base names include "Prev", "Next", "ProbSet", and
		655	"Up"). Each concatenated string should form an absolute URL to an image file.
		656	For example:
		657
		658	<!--#nav style="images" imageprefix="/webwork2_files/images/nav"
		659	imagesuffix=".gif" separator=" "-->
		660
		661	=cut
		662
		663	#sub nav { }
		664
		665	=item options()
		666
		667	Not defined in this package.
		668
		669	Print an auxiliary options form, related to the content displayed in the
		670	C<body>.
		671
		672	=item path($args)
		673
		674	Defined in this package.
		675
		676	Print "breadcrubs" from the root of the virtual hierarchy to the current page.
		677	$args is a reference to a hash containing the following fields:
		678
		679	style => type of separator: text\|image
		680	image => if style=image, URL of image to use as path separator
		681	text => if style=text, text to use as path separator
		682	if style=image, the ALT text of each separator image
		683	textonly => suppress all HTML, return only plain text
		684
		685	The implementation in this package takes information from the WeBWorK::URLPath
		686	associated with the current request.
		687
		688	=cut
		689
		690	sub path {
174	my ($self, $args) = @_[0,-1];	691	my ($self, $args) = @_;
175	# A single if "or"s it's components. Nesting produces "and".	692	my $r = $self->r;
176		693
177	my @args = @$args; # Hahahahaha, get it?!	694	my @path;
178		695
179	if (@args % 2 != 0) {	696	my $urlpath = $r->urlpath;
180	# flip out and kill people, but do not commit seppuku	697	do {
181	print '<!--&if recieved an uneven number of arguments. This shouldn\'t happen, but I\'ll let it slide.-->\n';	698	unshift @path, $urlpath->name, $r->location . $urlpath->path;
182	}	699	} while ($urlpath = $urlpath->parent);
183		700
184	while (@args > 1) {	701	$path[$#path] = ""; # we don't want the last path element to be a link
185	my ($key, $value) = (shift @args, shift @args);	702
186		703	#print "\n<!-- BEGIN " . __PACKAGE__ . "::path -->\n";
187	# a non-existent &if_$key is the same as a false result, but we're ORing, so it's OK	704	print $self->pathMacro($args, @path);
188	my $sub = "if_$key"; # perl doesn't like it when you try to construct a string right in a method invocation	705	#print "<!-- END " . __PACKAGE__ . "::path -->\n";
189	if ($self->can("if_$key") and $self->$sub("$value")) {	706
190	return 1;	707	return "";
191	}	708	}
192	}	709
		710	=item siblings()
		711
		712	Not defined in this package.
		713
		714	Print links to siblings of the current object.
		715
		716	=cut
		717
		718	#sub siblings { }
		719
		720	=item timestamp()
		721
		722	Defined in this package.
		723
		724	Display the current time and date using default format "3:37pm on Jan 7, 2004".
		725	The display format can be adjusted by giving a style in the template.
		726	For example,
		727
		728	<!--#timestamp style="%m/%d/%y at %I:%M%P"-->
		729
		730	will give standard WeBWorK time format. Wording and other formatting
		731	can be done in the template itself.
		732	=cut
		733
		734	sub timestamp {
		735	my ($self, $args) = @_;
		736	my $formatstring = "%l:%M%P on %b %e, %Y";
		737	$formatstring = $args->{style} if(defined($args->{style}));
		738	return(Date::Format::time2str($formatstring, time()));
		739	}
193		740
		741	=item submiterror()
		742
		743	Defined in this package.
		744
		745	Print any error messages resulting from the last form submission.
		746
		747	This method is deprecated -- use message() instead
		748
		749	The implementation in this package prints the value of the field
		750	$self->{submitError}, if it is present.
		751
		752	=cut
		753
		754	sub submiterror {
		755	my ($self) = @_;
		756
		757	print "\n<!-- BEGIN " . __PACKAGE__ . "::submiterror -->\n";
		758	print $self->{submitError} if exists $self->{submitError};
		759	print "<!-- END " . __PACKAGE__ . "::submiterror -->\n";
		760
		761	return "";
		762	}
		763
		764	=item message()
		765
		766	Defined in this package.
		767
		768	Print any messages (error or non-error) resulting from the last form submission.
		769	This could be used to give Sucess and Failure messages after an action is performed by a module.
		770
		771	The implementation in this package prints the value of the field
		772	$self->{status_message}, if it is present.
		773
		774	=cut
		775
		776	sub message {
		777	my ($self) = @_;
		778
		779	print "\n<!-- BEGIN " . __PACKAGE__ . "::message -->\n";
		780	print $self->{status_message} if exists $self->{status_message};
		781	print "<!-- END " . __PACKAGE__ . "::message -->\n";
		782
		783	return "";
		784	}
		785
		786	=item title()
		787
		788	Defined in this package.
		789
		790	Print the title of the current page.
		791
		792	The implementation in this package takes information from the WeBWorK::URLPath
		793	associated with the current request.
		794
		795	=cut
		796
		797	sub title {
		798	my ($self, $args) = @_;
		799	my $r = $self->r;
		800
		801	#print "\n<!-- BEGIN " . __PACKAGE__ . "::title -->\n";
		802	print $r->urlpath->name;
		803	#print "<!-- END " . __PACKAGE__ . "::title -->\n";
		804
		805	return "";
		806	}
		807
		808	=item warnings()
		809
		810	Defined in this package.
		811
		812	Print accumulated warnings.
		813
		814	The implementation in this package checks for a note in the request named
		815	"warnings". If present, its contents are formatted and returned.
		816
		817	=cut
		818
		819	sub warnings {
		820	my ($self) = @_;
		821	my $r = $self->r;
		822
		823	print "\n<!-- BEGIN " . __PACKAGE__ . "::warnings -->\n";
		824	print $self->warningOutput($r->notes("warnings")) if $r->notes("warnings");
		825	print "<!-- END " . __PACKAGE__ . "::warnings -->\n";
		826
		827	return "";
		828	}
		829
		830	=item help()
		831
		832	Display a link to context-sensitive help. If the argument C<name> is defined,
		833	the link will be to the help document for that name. Otherwise the name of the
		834	WeBWorK::URLPath node for the current system location will be used.
		835
		836	=cut
		837
		838	sub help {
		839	my $self = shift;
		840	my $args = shift;
		841	my $name = $args->{name};
		842	$name = lc($self->r->urlpath->name) unless defined($name);
		843	$name =~ s/\s/_/g;
		844	$self->helpMacro($name);
		845	}
		846
		847	=back
		848
		849	=cut
		850
		851	# ------------------------------------------------------------------------------
		852
		853	=head2 Conditional predicates
		854
		855	Conditional predicate methods are invoked when the C<#if> escape sequence is
		856	encountered in the template. If a method named C<if_predicate> is defined in
		857	here or in the instantiated subclass, it is invoked.
		858
		859	The following predicates are currently defined:
		860
		861	=over
		862
		863	=item if_can($function)
		864
		865	If a function named $function is present in the current content generator (or
		866	any superclass), a true value is returned. Otherwise, a false value is returned.
		867
		868	The implementation in this package uses the method UNIVERSAL->can(function) to
		869	arrive at the result.
		870
		871	A subclass could redefine this method to, for example, "hide" a method from the
		872	template:
		873
		874	sub if_can {
		875	my ($self, $arg) = @_;
		876
		877	if ($arg eq "floobar") {
194	return 0;	878	return 0;
		879	} else {
		880	return $self->SUPER::if_can($arg);
		881	}
		882	}
		883
		884	=cut
		885
		886	sub if_can {
		887	my ($self, $arg) = @_;
		888
		889	return $self->can($arg) ? 1 : 0;
195	}	890	}
		891
		892	=item if_loggedin($arg)
		893
		894	If the user is currently logged in, $arg is returned. Otherwise, the inverse of
		895	$arg is returned.
		896
		897	The implementation in this package always returns $arg, since most content
		898	generators are only reachable when the user is authenticated. It is up to
		899	classes that can be reached without logging in to override this method and
		900	provide the correct behavior.
		901
		902	This is suboptimal, and may change in the future.
		903
		904	=cut
		905
		906	sub if_loggedin {
		907	my ($self, $arg) = @_;
		908
		909	return $arg;
		910	}
		911
		912	=item if_submiterror($arg)
		913
		914	If the last form submission generated an error, $arg is returned. Otherwise, the
		915	inverse of $arg is returned.
		916
		917	The implementation in this package checks for the field $self->{submitError} to
		918	determine if an error condition is present.
		919
		920	If a subclass uses some other method to classify submission results, this method could be
		921	redefined to handle that variance:
		922
		923	sub if_submiterror {
		924	my ($self, $arg) = @_;
		925
		926	my $status = $self->{processReturnValue};
		927	if ($status != 0) {
		928	return $arg;
		929	} else {
		930	return !$arg;
		931	}
		932	}
		933
		934	=cut
		935
		936	sub if_submiterror {
		937	my ($self, $arg) = @_;
		938
		939	if (exists $self->{submitError}) {
		940	return $arg;
		941	} else {
		942	return !$arg;
		943	}
		944	}
		945
		946	=item if_message($arg)
		947
		948	If the last form submission generated a message, $arg is returned. Otherwise, the
		949	inverse of $arg is returned.
		950
		951	The implementation in this package checks for the field $self->{status_message} to
		952	determine if a message is present.
		953
		954	If a subclass uses some other method to classify submission results, this method could be
		955	redefined to handle that variance:
		956
		957	sub if_message {
		958	my ($self, $arg) = @_;
		959
		960	my $status = $self->{processReturnValue};
		961	if ($status != 0) {
		962	return $arg;
		963	} else {
		964	return !$arg;
		965	}
		966	}
		967
		968	=cut
		969
		970	sub if_message {
		971	my ($self, $arg) = @_;
		972
		973	if (exists $self->{status_message}) {
		974	return $arg;
		975	} else {
		976	return !$arg;
		977	}
		978	}
		979
		980	=item if_warnings
		981
		982	If warnings have been emitted while handling this request, $arg is returned.
		983	Otherwise, the inverse of $arg is returned.
		984
		985	The implementation in this package checks for a note in the request named
		986	"warnings". This is set by the WARN handler in Apache::WeBWorK when a warning is
		987	handled.
		988
		989	=cut
		990
		991	sub if_warnings {
		992	my ($self, $arg) = @_;
		993	my $r = $self->r;
		994
		995	if ($r->notes("warnings")) {
		996	return $arg;
		997	} else {
		998	!$arg;
		999	}
		1000	}
		1001
		1002	=back
		1003
		1004	=cut
196		1005
197	################################################################################	1006	################################################################################
198	# Macros used by content generators to render common idioms
199	################################################################################
200		1007
201	# pathMacro(HASHREF, LIST) - helper macro for <!--#path--> escape: the hash	1008	=head1 HTML MACROS
		1009
		1010	Various routines are defined in this package for rendering common WeBWorK
		1011	idioms.
		1012
		1013	FIXME: some of these should be moved to WeBWorK::HTML:: modules!
		1014
		1015	# ------------------------------------------------------------------------------
		1016
		1017	=head2 Template escape handler macros
		1018
		1019	These methods are used by implementations of the escape sequence handlers to
		1020	maintain a consistent style.
		1021
		1022	=over
		1023
		1024	=item pathMacro($args, @path)
		1025
		1026	Helper macro for the C<#path> escape sequence: $args is a hash reference
202	# reference contains the "style", "image", and "text" arguments to the escape.	1027	containing the "style", "image", "text", and "textonly" arguments to the escape.
203	# The LIST consists of ordered key-value pairs of the form:	1028	@path consists of ordered key-value pairs of the form:
204	#	1029
205	# "Page Name" => URL	1030	"Page Name" => URL
206	#	1031
207	# If the page should not have a link associated with it, the URL should be left	1032	If the page should not have a link associated with it, the URL should be left
208	# empty. Authentication data is added to the URL so you don't have to. A fully-	1033	empty. Authentication data is added to each URL so you don't have to. A fully-
209	# formed path line is returned, suitable for returning by a function	1034	formed path line is returned, suitable for returning by a function implementing
210	# implementing the #path escape.	1035	the C<#path> escape.
211	#	1036
		1037	FIXME: authentication data probably shouldn't be added here any more, now that
		1038	we have systemLink().
		1039
		1040	=cut
		1041
212	sub pathMacro {	1042	sub pathMacro {
213	my $self = shift;	1043	my ($self, $args, @path) = @_;
214	my %args = %{ shift() };	1044	my %args = %$args;
215	my @path = @_;	1045	$args{style} = "text" if $args{textonly};
		1046
		1047	my $auth = $self->url_authen_args;
216	my $sep;	1048	my $sep;
217	if ($args{style} eq "image") {	1049	if ($args{style} eq "image") {
218	$sep = CGI::img({-src=>$args{image}, -alt=>$args{text}});	1050	$sep = CGI::img({-src=>$args{image}, -alt=>$args{text}});
219	} else {	1051	} else {
220	$sep = $args{text};	1052	$sep = $args{text};
221	}	1053	}
222	my $auth = $self->url_authen_args;	1054
223	my @result;	1055	my @result;
224	while (@path) {	1056	while (@path) {
225	my $name = shift @path;	1057	my $name = shift @path;
226	my $url = shift @path;	1058	my $url = shift @path;
227	push @result, $url	1059	if ($url and not $args{textonly}) {
228	? CGI::a({-href=>"$url?$auth"}, $name)	1060	push @result, CGI::a({-href=>"$url?$auth"}, $name);
229	: $name;	1061	} else {
		1062	push @result, $name;
230	}	1063	}
		1064	}
		1065
231	return join($sep, @result) . "\n";	1066	return join($sep, @result), "\n";
232	}	1067	}
		1068
		1069	=item siblingsMacro(@siblings)
		1070
		1071	Helper macro for the C<#siblings> escape sequence. @siblings consists of ordered
		1072	key-value pairs of the form:
		1073
		1074	"Sibling Name" => URL
		1075
		1076	If the sibling should not have a link associated with it, the URL should be left
		1077	empty. Authentication data is added to each URL so you don't have to. A fully-
		1078	formed siblings block is returned, suitable for returning by a function
		1079	implementing the C<#siblings> escape.
		1080
		1081	FIXME: authentication data probably shouldn't be added here any more, now that
		1082	we have systemLink().
		1083
		1084	=cut
233		1085
234	sub siblingsMacro {	1086	sub siblingsMacro {
235	my $self = shift;
236	my @siblings = @_;	1087	my ($self, @siblings) = @_;
		1088
		1089	my $auth = $self->url_authen_args;
237	my $sep = CGI::br();	1090	my $sep = CGI::br();
238	my $auth = $self->url_authen_args;	1091
239	my @result;	1092	my @result;
240	while (@siblings) {	1093	while (@siblings) {
241	my $name = shift @siblings;	1094	my $name = shift @siblings;
242	my $url = shift @siblings;	1095	my $url = shift @siblings;
243	push @result, $url	1096	push @result, $url
244	? CGI::a({-href=>"$url?$auth"}, $name)	1097	? CGI::a({-href=>"$url?$auth"}, $name)
245	: $name;	1098	: $name;
246	}	1099	}
		1100
247	return join($sep, @result), "\n";	1101	return join($sep, @result) . "\n";
248	}	1102	}
		1103
		1104
		1105
		1106	=item navMacro($args, $tail, @links)
		1107
		1108	Helper macro for the C<#nav> escape sequence: $args is a hash reference
		1109	containing the "style", "imageprefix", "imagesuffix", and "separator" arguments
		1110	to the escape. @siblings consists of ordered tuples of the form:
		1111
		1112	"Link Name", URL, ImageBaseName
		1113
		1114	If the sibling should not have a link associated with it, the URL should be left
		1115	empty. ImageBaseName is placed between the C<imageprefix> and C<imagesuffix>.
		1116	Authentication data is added to each URL so you don't have to. $tail is appended
		1117	to each URL, after the authentication information. A fully-formed nav line is
		1118	returned, suitable for returning by a function implementing the C<#nav> escape.
		1119
		1120	=cut
249		1121
250	sub navMacro {	1122	sub navMacro {
251	my $self = shift;	1123	my ($self, $args, $tail, @links) = @_;
252	my %args = %{ shift() };	1124	my $r = $self->r;
253	my $tail = shift;	1125	my $ce = $r->ce;
254	my @links = @_;	1126	my %args = %$args;
		1127
255	my $auth = $self->url_authen_args;	1128	my $auth = $self->url_authen_args;
256	my $ce = $self->{ce};
257	my $prefix = $ce->{webworkURLs}->{htdocs}."/images";	1129	my $prefix = $ce->{webworkURLs}->{htdocs}."/images";
		1130
258	my @result;	1131	my @result;
259	while (@links) {	1132	while (@links) {
260	my $name = shift @links;	1133	my $name = shift @links;
261	my $url = shift @links;	1134	my $url = shift @links;
262	my $img = shift @links;	1135	my $img = shift @links;
…		…
271	push @result, $url	1144	push @result, $url
272	? CGI::a({-href=>"$url?$auth$tail"}, $html)	1145	? CGI::a({-href=>"$url?$auth$tail"}, $html)
273	: $html;	1146	: $html;
274	}	1147	}
275	}	1148	}
		1149
276	return join($args{separator}, @result) . "\n";	1150	return join($args{separator}, @result) . "\n";
277	}	1151	}
278		1152
279	# hidden_fields(LIST) - return hidden <INPUT> tags for each field mentioned in	1153	=item helpMacro($name)
		1154
		1155	This escape is represented by a question mark which links to an html page in the
		1156	helpFiles directory. Currently the link is made to the file $name.html
		1157
		1158	=cut
		1159
		1160	sub helpMacro {
		1161	my $self = shift;
		1162	my $name = shift;
		1163	my $ce = $self->r->ce;
		1164	my $basePath = $ce->{webworkDirs}->{local_help};
		1165	$name = 'no_help' unless -e "$basePath/$name.html";
		1166	my $path = "$basePath/$name.html";
		1167	my $url = $ce->{webworkURLs}->{local_help}."/$name.html";
		1168	my $imageURL = $ce->{webworkURLs}->{htdocs}."/images/question_mark.png";
		1169	return CGI::a({href => $url,
		1170	target => 'ww_help',
		1171	onclick => "window.open(this.href,this.target,'width=550,height=350,scrollbars=yes,resizable=on')"},
		1172	CGI::img({src=>$imageURL}));
		1173	}
		1174
		1175	=back
		1176
		1177	=cut
		1178
		1179	# ------------------------------------------------------------------------------
		1180
		1181	=head2 Parameter management
		1182
		1183	Methods for formatting request parameters as hidden form fields or query string
		1184	fragments.
		1185
		1186	=over
		1187
		1188	=item hidden_fields(@fields)
		1189
		1190	Return hidden <INPUT> tags for each field mentioned in @fields (or all fields if
280	# LIST (or all fields if list is empty), taking data from the current request.	1191	list is empty), taking data from the current request.
281	#	1192
		1193	=cut
		1194
282	sub hidden_fields($;@) {	1195	sub hidden_fields {
283	my $self = shift;	1196	my ($self, @fields) = @_;
284	my $r = $self->{r};	1197	my $r = $self->r;
285	my @fields = @_;	1198
286	@fields or @fields = $r->param;	1199	@fields = $r->param unless @fields;
287	my $courseEnvironment = $self->{ce};	1200
288	my $html = "";	1201	my $html = "";
289
290	foreach my $param (@fields) {	1202	foreach my $param (@fields) {
291	my $value = $r->param($param);	1203	my @values = $r->param($param);
292	$html .= CGI::input({-type=>"hidden",-name=>"$param",-value=>"$value"});	1204	$html .= CGI::hidden($param, @values);
293	}	1205	}
294	return $html;	1206	return $html;
295	}	1207	}
296		1208
297	# hidden_authen_fields() - use hidden_fields to return hidden <INPUT> tags for	1209	=item hidden_authen_fields()
298	# request fields used in authentication.	1210
299	#	1211	Use hidden_fields to return hidden <INPUT> tags for request fields used in
		1212	authentication.
		1213
		1214	=cut
		1215
300	sub hidden_authen_fields($) {	1216	sub hidden_authen_fields {
301	my $self = shift;	1217	my ($self) = @_;
		1218
302	return $self->hidden_fields("user","effectiveUser","key");	1219	return $self->hidden_fields("user", "effectiveUser", "key");
303	}	1220	}
304		1221
305	# url_args(LIST) - return a URL query string (without the leading `?')	1222	=item url_args(@fields)
306	# containing values for each field mentioned in LIST, or all fields if list is	1223
307	# empty. Data is taken from the current request.	1224	Return a URL query string (without the leading `?') containing values for each
308	#	1225	field mentioned in @fields, or all fields if list is empty. Data is taken from
		1226	the current request.
		1227
		1228	=cut
		1229
309	sub url_args($;@) {	1230	sub url_args {
310	my $self = shift;	1231	my ($self, @fields) = @_;
311	my $r = $self->{r};	1232	my $r = $self->r;
312	my @fields = @_;	1233
313	@fields or @fields = $r->param;	1234	@fields = $r->param unless @fields;
314	my $courseEnvironment = $self->{ce};
315		1235
316	my @pairs;	1236	my @pairs;
317	foreach my $param (@fields) {	1237	foreach my $param (@fields) {
318	my $value = $r->param($param) \|\| "";	1238	my @values = $r->param($param);
		1239	foreach my $value (@values) {
319	push @pairs, uri_escape($param) . "=" . uri_escape($value);	1240	push @pairs, uri_escape($param) . "=" . uri_escape($value);
		1241	}
320	}	1242	}
321		1243
322	return join("&", @pairs);	1244	return join("&", @pairs);
323	}	1245	}
324		1246
325	# url_authen_args() - use url_args to return a URL query string for request	1247	=item url_authen_args()
326	# fields used in authentication.	1248
327	#	1249	Use url_args to return a URL query string for request fields used in
		1250	authentication.
		1251
		1252	=cut
		1253
328	sub url_authen_args($) {	1254	sub url_authen_args {
329	my $self = shift;	1255	my ($self) = @_;
330	my $r = $self->{r};	1256
331	return $self->url_args("user","effectiveUser","key");	1257	return $self->url_args("user", "effectiveUser", "key");
332	}	1258	}
333		1259
334	# print_form_data(BEGIN, MIDDLE, END, OMIT) - return a string containing request	1260	=item print_form_data($begin, $middle, $end, $omit)
335	# fields not matched by OMIT, placing BEGIN before each field name, MIDDLE	1261
		1262	Return a string containing every request field not matched by the quoted reguar
		1263	expression $omit, placing $begin before each field name, $middle between each
336	# between each field and its value, and END after each value. Values are taken	1264	field name and its value, and $end after each value. Values are taken from the
337	# from the current request. OMIT is a quoted reguar expression.	1265	current request.
338	#	1266
		1267	=cut
		1268
339	sub print_form_data {	1269	sub print_form_data {
340	my ($self, $begin, $middle, $end, $qr_omit) = @_;	1270	my ($self, $begin, $middle, $end, $qr_omit) = @_;
		1271	my $r=$self->r;
		1272	my @form_data = $r->param;
		1273
341	my $return_string = "";	1274	my $return_string = "";
342	my $r=$self->{r};
343	my @form_data = $r->param;
344	foreach my $name (@form_data) {	1275	foreach my $name (@form_data) {
345	next if ($qr_omit and $name =~ /$qr_omit/);	1276	next if ($qr_omit and $name =~ /$qr_omit/);
346	my @values = $r->param($name);	1277	my @values = $r->param($name);
347	foreach my $variable (qw(begin name middle value end)) {	1278	foreach my $variable (qw(begin name middle value end)) {
		1279	# FIXME: can this loop be moved out of the enclosing loop?
348	no strict 'refs';	1280	no strict 'refs';
349	${$variable} = "" unless defined ${$variable};	1281	${$variable} = "" unless defined ${$variable};
350	}	1282	}
351	foreach my $value (@values) {	1283	foreach my $value (@values) {
352	$return_string .= "$begin$name$middle$value$end";	1284	$return_string .= "$begin$name$middle$value$end";
353	}	1285	}
354	}	1286	}
		1287
355	return $return_string;	1288	return $return_string;
356	}	1289	}
		1290
		1291	=back
		1292
		1293	=cut
		1294
		1295	# ------------------------------------------------------------------------------
		1296
		1297	=head2 Utilities
		1298
		1299	=over
		1300
		1301	=item systemLink($urlpath, %options)
		1302
		1303	Generate a link to another part of the system. $urlpath is WeBWorK::URLPath
		1304	object from which the base path will be taken. %options can consist of:
		1305
		1306	=over
		1307
		1308	=item params
		1309
		1310	Can be either a reference to an array or a reference to a hash.
		1311
		1312	If it is a reference to a hash, it maps parmaeter names to values. These
		1313	parameters will be included in the generated link. If a value is an arrayref,
		1314	the values of the array referenced will be used. If a value is undefined, the
		1315	value from the current request will be used.
		1316
		1317	If C<params> is an arrayref, it is interpreted as a list of parameter names.
		1318	These parameters will be included in the generated link, using the values from
		1319	the current request.
		1320
		1321	Unless C<authen> is false (see below), the authentication parameters (C<user>,
		1322	C<effectiveUser>, and C<key>) are included with their default values.
		1323
		1324	=item authen
		1325
		1326	If set to a false value, the authentication parameters (C<user>,
		1327	C<effectiveUser>, and C<key>) are included in the the generated link unless
		1328	explicitly listed in C<params>.
		1329
		1330	=back
		1331
		1332	=cut
		1333
		1334	# FIXME: there should probably be an option for prepending "http://hostname:port"
		1335	sub systemLink {
		1336	my ($self, $urlpath, %options) = @_;
		1337	my $r = $self->r;
		1338
		1339	my %params = ();
		1340	if (exists $options{params}) {
		1341	if (ref $options{params} eq "HASH") {
		1342	%params = %{ $options{params} };
		1343	} elsif (ref $options{params} eq "ARRAY") {
		1344	my @names = @{ $options{params} };
		1345	@params{@names} = ();
		1346	} else {
		1347	croak "option 'params' is not a hashref or an arrayref";
		1348	}
		1349	}
		1350
		1351	my $authen = exists $options{authen} ? $options{authen} : 1;
		1352	if ($authen) {
		1353	$params{user} = undef unless exists $params{user};
		1354	$params{effectiveUser} = undef unless exists $params{effectiveUser};
		1355	$params{key} = undef unless exists $params{key};
		1356	}
		1357
		1358	my $url = $r->location . $urlpath->path;
		1359	my $first = 1;
		1360
		1361	foreach my $name (keys %params) {
		1362	my $value = $params{$name};
		1363
		1364	my @values;
		1365	if (defined $value) {
		1366	if (ref $value eq "ARRAY") {
		1367	@values = @$value;
		1368	} else {
		1369	@values = $value;
		1370	}
		1371	} elsif (defined $r->param($name)) {
		1372	@values = $r->param($name);
		1373	}
		1374
		1375	if (@values) {
		1376	if ($first) {
		1377	$url .= "?";
		1378	$first = 0;
		1379	} else {
		1380	$url .= "&";
		1381	}
		1382	$url .= join "&", map { "$name=$_" } @values;
		1383	}
		1384	}
		1385
		1386	return $url;
		1387	}
		1388
		1389	=item nbsp($string)
		1390
		1391	If string consists of only whitespace, the HTML entity C< > is returned.
		1392	Otherwise $string is returned.
		1393
		1394	=cut
		1395
		1396	sub nbsp {
		1397	my ($self, $str) = @_;
		1398	return (defined $str && $str =~/\S/) ? $str : " ";
		1399	}
		1400
		1401	=item sp2nbsp($string)
		1402
		1403	A copy of $string is returned with each space character replaced by the
		1404	C< > entity.
		1405
		1406	=cut
		1407
		1408	sub sp2nbsp {
		1409	my ($str) = @_;
		1410	return unless defined $str;
		1411	$str =~ s/ / /g;
		1412	return $str;
		1413	}
		1414
		1415	=item space2nbsp($string)
		1416
		1417	Replace spaces in the string with html non-breaking spaces.
		1418
		1419	=cut
		1420
		1421	sub space2nbsp {
		1422	my $str = shift;
		1423	$str =~ s/\s/ /g;
		1424	return($str);
		1425	}
		1426
		1427	=item errorOutput($error, $details)
		1428
		1429	=cut
357		1430
358	sub errorOutput($$$) {	1431	sub errorOutput($$$) {
359	my ($self, $error, $details) = @_;	1432	my ($self, $error, $details) = @_;
360	return	1433	return
361	CGI::h3("Software Error"),	1434	CGI::h3("Software Error"),
		1435	CGI::p("[", time2str("%a %b %d %H:%M:%S %Y", time), "] [",$self->r->uri,"] ",),
362	CGI::p(<<EOF),	1436	CGI::p(<<EOF),
363	WeBWorK has encountered a software error while attempting to process this	1437	WeBWorK has encountered a software error while attempting to process this
364	problem. It is likely that there is an error in the problem itself. If you are	1438	problem. It is likely that there is an error in the problem itself. If you are
365	a student, contact your professor to have the error corrected. If you are a	1439	a student, contact your professor to have the error corrected. If you are a
366	professor, please consut the error output below for more informaiton.	1440	professor, please consult the error output below for more information.
367	EOF	1441	EOF
		1442	# FIXME: this message shouldn't refer the the "problem" since it is for general error reporting
368	CGI::h3("Error messages"), CGI::p(CGI::tt($error)),	1443	CGI::h3("Error messages"), CGI::p(CGI::tt($error)),
369	CGI::h3("Error context"), CGI::p(CGI::tt($details));	1444	CGI::h3("Error context"), CGI::p(CGI::tt($details));
370	}	1445	}
371		1446
		1447	=item warningOutput($warnings)
		1448
		1449	=cut
		1450
372	sub warningOutput($$) {	1451	sub warningOutput($$) {
373	my ($self, $warnings) = @_;	1452	my ($self, $warnings) = @_;
374		1453
375	my @warnings = split m/\n+/, $warnings;	1454	my @warnings = split m/\n+/, $warnings;
376		1455
377	return	1456	return
378	CGI::h3("Software Warnings"),	1457	CGI::h3("Software Warnings"),
		1458	CGI::p("[", time2str("%a %b %d %H:%M:%S %Y", time), "] [",$self->r->uri,"] ",),
379	CGI::p(<<EOF),	1459	CGI::p(<<EOF),
380	WeBWorK has encountered warnings while attempting to process this problem. It	1460	WeBWorK has encountered warnings while attempting to process this problem. It
381	is likely that this indicates an error or ambiguity in the problem itself. If	1461	is likely that this indicates an error or ambiguity in the problem itself. If
382	you are a student, contact your professor to have the problem corrected. If you	1462	you are a student, contact your professor to have the problem corrected. If you
383	are a professor, please consut the warning output below for more informaiton.	1463	are a professor, please consult the warning output below for more information.
384	EOF	1464	EOF
		1465	# FIXME: this message shouldn't refer the the "problem" since it is for general warning reporting
385	CGI::h3("Warning messages"),	1466	CGI::h3("Warning messages"),
386	CGI::ul(CGI::li(\@warnings)),	1467	CGI::ul(CGI::li(\@warnings));
387	;
388	}	1468	}
389		1469
390	################################################################################	1470	=item $dateTime = parseDateTime($string, $display_tz)
391	# Generic versions of template escapes
392	################################################################################
393		1471
394	# Reminder: here are the template functions currently defined:	1472	Parses $string as a datetime. If $display_tz is given, $string is assumed to be
395	# FIXME: this list is out of date!!!!!!!!	1473	in that timezone. Otherwise, the timezone defined in the course environment
396	#	1474	variable $siteDefaults{timezone} is used. The result, $dateTime, is an integer
397	# head	1475	UNIX datetime (epoch) in the server's timezone.
398	# path
399	# style = text\|image
400	# image = URL of image
401	# text = text separator
402	# loginstatus
403	# links
404	# siblings
405	# nav
406	# style = text\|image
407	# imageprefix = prefix to image URL
408	# imagesuffix = suffix to image URL
409	# separator = HTML to place in between links
410	# title
411	# body
412		1476
413	sub header {	1477	=cut
414	my $self = shift;
415	my $r = $self->{r};
416	$r->content_type('text/html');
417	$r->send_http_header();
418	}
419		1478
420	sub loginstatus {	1479	sub parseDateTime {
421	my $self = shift;	1480	my ($self, $string, $display_tz) = @_;
422	my $r = $self->{r};
423	my $user = $r->param("user");
424	my $eUser = $r->param("effectiveUser");
425	my $key = $r->param("key");
426	return "" unless $key;
427	my $exitURL = $r->uri() . "?user=$user&key=$key";
428	print CGI::small("User:", "$user");
429	if ($user ne $eUser) {
430	print CGI::br(), CGI::font({-color=>'red'},
431	CGI::small("Acting as:", "$eUser")
432	),
433	CGI::br(), CGI::a({-href=>$exitURL},
434	CGI::small("Stop Acting")
435	);
436	}
437	return "";
438	}
439
440	# FIXME: drunk code. rewrite.
441	# also, this should be structured s.t. subclasses can add items to the links
442	# area, i.e. "stacking"
443	sub links {
444	my $self = shift;
445	my $ce = $self->{ce};	1481	my $ce = $self->r->ce;
446	my $db = $self->{db};	1482	$display_tz \|\|= $ce->{siteDefaults}{timezone};
447	my $userName = $self->{r}->param("user");	1483	return WeBWorK::Utils::parseDateTime($string, $display_tz);
448	my $courseName = $ce->{courseName};	1484	};
449	my $root = $ce->{webworkURLs}->{root};
450	my $permLevel = $db->getPermissionLevel($userName)->permission();
451	my $key = $db->getKey($userName)->key();
452	return "" unless defined $key;
453
454	# URLs to parts of the system
455	my $probSets = "$root/$courseName/?" . $self->url_authen_args();
456	my $prefs = "$root/$courseName/options/?" . $self->url_authen_args();
457	my $instructor = "$root/$courseName/instructor/?" . $self->url_authen_args();
458	my $sets = "$root/$courseName/instructor/sets/?" . $self->url_authen_args();
459	my $users = "$root/$courseName/instructor/users?" . $self->url_authen_args();
460	my $help = "$ce->{webworkURLs}->{docs}?" . $self->url_authen_args();
461	my $logout = "$root/$courseName/logout/?" . $self->url_authen_args();
462
463	return join("",
464	CGI::a({-href=>$probSets}, "Problem Sets"), CGI::br(),
465	CGI::a({-href=>$prefs}, "User Prefs"), CGI::br(),
466	CGI::a({-href=>$help}, "Help"), CGI::br(),
467	CGI::a({-href=>$logout}, "Log Out"), CGI::br(),
468	($permLevel > 0
469	? join("",
470	CGI::hr(),
471	CGI::a({-href=>$instructor}, "Instructor") , CGI::br(),
472	'  ',CGI::a({-href=>$sets}, "Set List") , CGI::br(),
473	'  ',CGI::a({-href=>$users}, "Class List") , CGI::br(),)
474	: ""
475	),
476	);
477	}
478		1485
479	# &if_can will return 1 if the current object->can("do $_[1]")	1486	=item $string = formatDateTime($dateTime, $display_tz)
480	sub if_can ($$) {
481	my ($self, $arg) = (@_);
482
483	if ($self->can("$arg")) {
484	return 1;
485	} else {
486	return 0;
487	}
488	}
489		1487
490	# Every content generator is logged in unless it says otherwise.	1488	Formats the UNIX datetime $dateTime in the standard WeBWorK datetime format.
491	sub if_loggedin($$) {	1489	$dateTime is assumed to be in the server's time zone. If $display_tz is given,
492	my ($self, $arg) = (@_);	1490	the datetime is converted from the server's timezone to the timezone specified.
493		1491	Otherwise, the timezone defined in the course environment variable
494	return $arg;	1492	$siteDefaults{timezone} is used.
495	}
496		1493
497	# Handling of errors in submissions	1494	=cut
498		1495
499	sub if_submiterror($$) {	1496	sub formatDateTime {
500	my ($self, $arg) = @_;	1497	my ($self, $dateTime, $display_tz) = @_;
501	if (exists $self->{submitError}) {
502	return $arg;
503	} else {
504	return !$arg;
505	}
506	}
507
508	sub submiterror {
509	my ($self) = @_;
510	if (exists $self->{submitError}) {
511	return $self->{submitError};
512	} else {
513	return "";
514	}
515	}
516
517	# General warning handling
518
519	sub if_warnings($$) {
520	my ($self, $arg) = @_;
521	return $self->{r}->notes("warnings") ? $arg : !$arg;
522	}
523
524	sub warnings {
525	my ($self) = @_;
526	my $r = $self->{r};	1498	my $ce = $self->r->ce;
527	if ($r->notes("warnings")) {	1499	$display_tz \|\|= $ce->{siteDefaults}{timezone};
528	return $self->warningOutput($r->notes("warnings"));	1500	return WeBWorK::Utils::formatDateTime($dateTime, $display_tz);
529	} else {
530	return "";
531	}
532	}	1501	}
		1502
		1503	=back
		1504
		1505	=head1 AUTHOR
		1506
		1507	Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu and Sam Hathaway,
		1508	sh002i (at) math.rochester.edu.
		1509
		1510	=cut
533		1511
534	1;	1512	1;
535
536	__END__
537
538	=head1 AUTHOR
539
540	Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu
541	and Sam Hathaway, sh002i (at) math.rochester.edu.
542
543	=cut

 Legend:



Removed from v.1360
 


changed lines


 
Added in v.2906
 Legend:



Removed from v.1360
 


changed lines


 
Added in v.2906
-Removed from v.1360
+Added in v.2906

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9