--- trunk/webwork2/lib/WeBWorK/ContentGenerator.pm	2003/02/28 20:29:56	757
+++ trunk/webwork2/lib/WeBWorK/ContentGenerator.pm	2003/07/14 18:44:27	1383
@@ -16,30 +16,33 @@
 use Apache::Constants qw(:common);
 use CGI qw();
 use URI::Escape;
-use WeBWorK::DB::Auth;
+use WeBWorK::Authz;
+use WeBWorK::DB;
 use WeBWorK::Utils qw(readFile);
-use Carp qw(cluck);
 
 ################################################################################
 # This is a very unruly file, so I'm going to use very large comments to divide
 # it into logical sections.
 ################################################################################
 
-# new(Apache::Request, WeBWorK::CourseEnvironment) -  create a new instance of a
+# new(Apache::Request, WeBWorK::CourseEnvironment) - create a new instance of a
 # content generator. Usually only called by the dispatcher, although one might
 # be able to use it for things like "sub-requests". Uh... uh... I have to think
 # about that one. The dispatcher uses this idiom:
 # 
-# 
 # 	WeBWorK::ContentGenerator::WHATEVER->new($r, $ce)->go(@whatever);
 # 
 # and throws away the result ;)
 #
-sub new($$$) {
-	my $invocant = shift;
+sub new($$$$) {
+	my ($invocant, $r, $ce, $db) = @_;
 	my $class = ref($invocant) || $invocant;
-	my $self = {};
-	($self->{r}, $self->{courseEnvironment}) = @_;
+	my $self = {
+		r  => $r,
+		ce => $ce,
+		db => $db,
+		authz => WeBWorK::Authz->new($r, $ce, $db)
+	};
 	bless $self, $class;
 	return $self;
 }
@@ -64,16 +67,17 @@
 # 
 sub go {
 	my $self = shift;
+	
 	my $r = $self->{r};
-	my $courseEnvironment = $self->{courseEnvironment};
-
+	my $courseEnvironment = $self->{ce};
+	
 	$self->pre_header_initialize(@_) if $self->can("pre_header_initialize");
 	$self->header(@_);
 	return OK if $r->header_only;
 	
 	$self->initialize(@_) if $self->can("initialize");
 	$self->template($courseEnvironment->{templates}->{system}, @_);
-
+	
 	return OK;
 }
 
@@ -89,7 +93,7 @@
 sub template {
 	my ($self, $templateFile) = (shift, shift);
 	my $r = $self->{r};
-	my $courseEnvironment = $self->{courseEnvironment};
+	my $courseEnvironment = $self->{ce};
 	my @ifstack = (1); # Start off in printing mode
 		# say $ifstack[-1] to get the result of the last <#!--if-->
 	
@@ -124,7 +128,12 @@
 				pop @ifstack;
 			} elsif ($ifstack[-1]) {
 				if ($self->can($function)) {
-					print $self->$function(@_, {@args});
+					my @result = $self->$function(@_, {@args});
+					if (@result) {
+						print @result;
+					} else {
+						warn "Template escape $function returned an empty list.";
+					}
 				}
 			}
 		}
@@ -138,7 +147,7 @@
 # cook_args(STRING) - parses a string of the form ARG1="FOO" ARG2="BAR". Returns
 # a list which pairs into key/values and fits nicely in {}s.
 # 
-sub cook_args($) {
+sub cook_args($) { # ... also used by bin/wwdb, so watch out
 	my ($raw_args) = @_;
 	my @args = ();
 	
@@ -219,7 +228,7 @@
 			? CGI::a({-href=>"$url?$auth"}, $name)
 			: $name;
 	}
-	return join($sep, @result), "\n";
+	return join($sep, @result) . "\n";
 }
 
 sub siblingsMacro {
@@ -244,19 +253,27 @@
 	my $tail = shift;
 	my @links = @_;
 	my $auth = $self->url_authen_args;
+	my $ce = $self->{ce};
+	my $prefix = $ce->{webworkURLs}->{htdocs}."/images";
 	my @result;
 	while (@links) {
 		my $name = shift @links;
 		my $url = shift @links;
 		my $img = shift @links;
-		my $html = ($img && $args{style} eq "images") ? CGI::img({src=>($args{imageprefix}.$img.$args{imagesuffix}), border=>""}): $name;
+		my $html = 
+			($img && $args{style} eq "images") 
+			? CGI::img(
+				{src=>($prefix."/".$img.$args{imagesuffix}), 
+				border=>"",
+				alt=>"$name"})
+			: $name;
 		unless($img && !$url) {
 			push @result, $url
 				? CGI::a({-href=>"$url?$auth$tail"}, $html)
 				: $html;
 		}
 	}
-	return join($args{separator}, @result), "\n";
+	return join($args{separator}, @result) . "\n";
 }
 
 # hidden_fields(LIST) - return hidden <INPUT> tags for each field mentioned in
@@ -267,7 +284,7 @@
 	my $r = $self->{r};
 	my @fields = @_;
 	@fields or @fields = $r->param;
-	my $courseEnvironment = $self->{courseEnvironment};
+	my $courseEnvironment = $self->{ce};
 	my $html = "";
 	
 	foreach my $param (@fields) {
@@ -294,7 +311,7 @@
 	my $r = $self->{r};
 	my @fields = @_;
 	@fields or @fields = $r->param;
-	my $courseEnvironment = $self->{courseEnvironment};
+	my $courseEnvironment = $self->{ce};
 	
 	my @pairs;
 	foreach my $param (@fields) {
@@ -341,30 +358,32 @@
 sub errorOutput($$$) {
 	my ($self, $error, $details) = @_;
 	return
-		CGI::h2("Software Error"),
+		CGI::h3("Software Error"),
 		CGI::p(<<EOF),
-WeBWorK has encountered a software error while attempting to process this problem.
-It is likely that there is an error in the problem itself.
-If you are a student, contact your professor to have the error corrected.
-If you are a professor, please consut the error output below for more informaiton.
+WeBWorK has encountered a software error while attempting to process this
+problem. It is likely that there is an error in the problem itself. If you are
+a student, contact your professor to have the error corrected. If you are a
+professor, please consut the error output below for more informaiton.
 EOF
-		CGI::h3("Error messages"), CGI::blockquote(CGI::pre($error)),
-		CGI::h3("Error context"), CGI::blockquote(CGI::pre($details));
+		CGI::h3("Error messages"), CGI::p(CGI::tt($error)),
+		CGI::h3("Error context"), CGI::p(CGI::tt($details));
 }
 
 sub warningOutput($$) {
 	my ($self, $warnings) = @_;
 	
+	my @warnings = split m/\n+/, $warnings;
+	
 	return
-		CGI::h2("Software Warnings"),
+		CGI::h3("Software Warnings"),
 		CGI::p(<<EOF),
-WeBWorK has encountered warnings while attempting to process this problem.
-It is likely that this indicates an error or ambiguity in the problem itself.
-If you are a student, contact your professor to have the problem corrected.
-If you are a professor, please consut the error output below for more informaiton.
+WeBWorK has encountered warnings while attempting to process this problem. It
+is likely that this indicates an error or ambiguity in the problem itself. If
+you are a student, contact your professor to have the problem corrected. If you
+are a professor, please consut the warning output below for more informaiton.
 EOF
 		CGI::h3("Warning messages"),
-		CGI::blockquote(CGI::pre($warnings)),
+		CGI::ul(CGI::li(\@warnings)),
 	;
 }
 
@@ -373,6 +392,7 @@
 ################################################################################
 
 # Reminder: here are the template functions currently defined:
+# FIXME: this list is out of date!!!!!!!!
 # 
 # head
 # path
@@ -405,10 +425,10 @@
 	my $key = $r->param("key");
 	return "" unless $key;
 	my $exitURL = $r->uri() . "?user=$user&key=$key";
-	print CGI::small("Logged in as:", CGI::br(), "$user");
+	print CGI::small("User:", "$user");
 	if ($user ne $eUser) {
 		print CGI::br(), CGI::font({-color=>'red'},
-				CGI::small("Acting as:", CGI::br(), "$eUser")
+				CGI::small("Acting as:", "$eUser")
 			),
 			CGI::br(), CGI::a({-href=>$exitURL},
 				CGI::small("Stop Acting")
@@ -417,37 +437,67 @@
 	return "";
 }
 
-# *** drunk code. rewrite.
+# FIXME: drunk code. rewrite.
 # also, this should be structured s.t. subclasses can add items to the links
 # area, i.e. "stacking"
 sub links {
 	my $self = shift;
-	my $ce = $self->{courseEnvironment};
+	my @components = @_;
+	my $ce = $self->{ce};
+	my $db = $self->{db};
 	my $userName = $self->{r}->param("user");
 	my $courseName = $ce->{courseName};
 	my $root = $ce->{webworkURLs}->{root};
-	my $permLevel = WeBWorK::DB::Auth->new($ce)->getPermissions($userName);
-	my $key = WeBWorK::DB::Auth->new($ce)->getKey($userName);
+	my $permLevel = $db->getPermissionLevel($userName)->permission();
+	my $key = $db->getKey($userName)->key();
 	return "" unless defined $key;
 	
 	# URLs to parts of the system
-	my $probSets = "$root/$courseName/?"         . $self->url_authen_args();
-	my $prefs    = "$root/$courseName/options/?" . $self->url_authen_args();
-	my $prof     = "$root/$courseName/prof/?"    . $self->url_authen_args();
-	my $help     = "$ce->{webworkURLs}->{docs}?" . $self->url_authen_args();
-	my $logout   = "$root/$courseName/logout/?"  . $self->url_authen_args();
-	
-	return
-		CGI::a({-href=>$probSets}, "Problem Sets"), CGI::br(),
-		CGI::a({-href=>$prefs}, "User Options"), CGI::br(),
-		($permLevel > 0
-			? CGI::a({-href=>$prof}, "Professor") . CGI::br()
-			: ""),
+	my $probSets   = "$root/$courseName/?"            . $self->url_authen_args();
+	my $prefs      = "$root/$courseName/options/?"    . $self->url_authen_args();
+	my $help       = "$ce->{webworkURLs}->{docs}?"    . $self->url_authen_args();
+	my $logout     = "$root/$courseName/logout/?"     . $self->url_authen_args();
+	
+	return join("",
+		CGI::a({-href=>$probSets}, "Problem&nbsp;Sets"), CGI::br(),
+		CGI::a({-href=>$prefs}, "User&nbsp;Prefs"), CGI::br(),
 		CGI::a({-href=>$help}, "Help"), CGI::br(),
 		CGI::a({-href=>$logout}, "Log Out"), CGI::br(),
-	;
-}
+		($permLevel > 0
+			? $self->instructor_links(@components) : ""
+		),
+	);
+}
+sub instructor_links {
+	my $self       = shift;
+	my @components = @_; 
+	my $args       = pop(@components);  # get hash of option arguments
+	my $courseName = $self->{ce}->{courseName};
+	my $root       = $self->{ce}->{webworkURLs}->{root};
+
+	my $instructor = "$root/$courseName/instructor/?" . $self->url_authen_args();
+	my $sets       = "$root/$courseName/instructor/sets/?" . $self->url_authen_args();
+	my $users      = "$root/$courseName/instructor/users/?" . $self->url_authen_args();
+	my $email      = "$root/$courseName/instructor/send_mail/?" . $self->url_authen_args();
+	my ($set, $prob) = @components;
+	#  Add direct links to sets e.g.  3:4 for set3 problem 4
+	my $setURL     = (defined($set)) ? "$root/$courseName/instructor/sets/$set/?" .
+	                   $self->url_authen_args()   : '';
+	my $probURL    = (defined($set) && defined($prob)) ? "$root/$courseName/instructor/pgProblemEditor/$set/$prob?" .
+	                   $self->url_authen_args()   : '';
+	my $setProb    = ($setURL) ? CGI::a({-href=>$setURL},$set ) : '';
+	
+	$setProb      .= ':'.CGI::a({-href=>$probURL},$prob)  if $setProb && $probURL;     
+	join("",
+				 CGI::hr(),
+				 CGI::a({-href=>$instructor}, "Instructor") , CGI::br(),
+			  	 '&nbsp;&nbsp;',CGI::a({-href=>$sets}, "Set&nbsp;List") ," ", $setProb, CGI::br(),
+			  	 '&nbsp;&nbsp;',CGI::a({-href=>$users}, "Class&nbsp;List") , CGI::br(),
+			  	 '&nbsp;&nbsp;',CGI::a({-href=>$email}, "Send&nbsp;Email") , CGI::br(),
+			  	 
+	)
 
+}
 # &if_can will return 1 if the current object->can("do $_[1]")
 sub if_can ($$) {
 	my ($self, $arg) = (@_);
@@ -466,6 +516,43 @@
 	return $arg;
 }
 
+# Handling of errors in submissions
+
+sub if_submiterror($$) {
+	my ($self, $arg) = @_;
+	if (exists $self->{submitError}) {
+		return $arg;
+	} else {
+		return !$arg;
+	}
+}
+
+sub submiterror {
+	my ($self) = @_;
+	if (exists $self->{submitError}) {
+		return $self->{submitError};
+	} else {
+		return "";
+	}
+}
+
+# General warning handling
+
+sub if_warnings($$) {
+	my ($self, $arg) = @_;
+	return $self->{r}->notes("warnings") ? $arg : !$arg;
+}
+
+sub warnings {
+	my ($self) = @_;
+	my $r = $self->{r};
+	if ($r->notes("warnings")) {
+		return $self->warningOutput($r->notes("warnings"));
+	} else {
+		return "";
+	}
+}
+
 1;
 
 __END__