Parent Directory
| 
Revision Log
Added use strict and use warnings, then cleaned up much of the mess that revealed. --Dennis
1 package WeBWorK::ContentGenerator; 2 3 use strict; 4 use warnings; 5 use CGI qw(-compile :html :form); 6 use Apache::Constants qw(:common); 7 8 # Send 'die' message to the browser window 9 #use CGI::Carp qw(fatalsToBrowser); 10 11 12 # This is a superclass for Apache::WeBWorK's content generators. 13 # You are /definitely/ encouraged to read this file, since there are 14 # "abstract" functions here which show aproximately what form you would 15 # want over-ridden sub-classes to follow. 16 17 # new(Apache::Request, WeBWorK::CourseEnvironment) 18 sub new($$$) { 19 my $invocant = shift; 20 my $class = ref($invocant) || $invocant; 21 my $self = {}; 22 ($self->{r}, $self->{courseEnvironment}) = @_; 23 bless $self, $class; 24 return $self; 25 } 26 27 28 # This is a quick and dirty function to print out all (or almost all) of the 29 # fields in a form in a specified format. As you can see from the print 30 # statement, it just prints out $begining$name$middle$value$end for every 31 # field who's name doesn't match $qr_omit, a quoted regex. 32 # In it's current incarnation, it should be called from subclasses only, 33 # by saying $self->print_form_data. Of course, you could construct a 34 # hashref with ->{r} being an Apache::Request, I suppose. 35 36 sub print_form_data { 37 my ($self, $begin, $middle, $end, $qr_omit) = @_; 38 my $return_string = ""; 39 40 my $r=$self->{r}; 41 my @form_data = $r->param; 42 foreach my $name (@form_data) { 43 next if ($qr_omit and $name =~ /$qr_omit/); 44 my @values = $r->param($name); 45 46 47 foreach my $variable (qw(begin name middle value end)) { 48 no strict 'refs'; 49 ${$variable} = "" unless defined ${$variable}; 50 } 51 52 foreach my $value (@values) { 53 $return_string .= "$begin$name$middle$value$end"; 54 } 55 } 56 57 return $return_string; 58 } 59 60 sub hidden_authen_fields { 61 my $self = shift; 62 my $r = $self->{r}; 63 my $courseEnvironment = $self->{courseEnvironment}; 64 my $html = ""; 65 66 foreach my $param ("user","effectiveUser","key") { 67 my $value = $r->param($param); 68 $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"}); 69 } 70 return $html; 71 } 72 73 #sub hidden_authen_fields($) { 74 # my $self = shift; 75 # return $self->hidden_fields("user","effectiveUser","key"); 76 #} 77 78 sub hidden_fields($;@) { 79 my $self = shift; 80 my $r = $self->{r}; 81 my @fields = @_; 82 @fields or @fields = $r->param; 83 my $courseEnvironment = $self->{courseEnvironment}; 84 my $html = ""; 85 86 foreach my $param (@fields) { 87 my $value = $r->param($param); 88 $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"}); 89 } 90 return $html; 91 } 92 93 ### Functions that subclasses /should/ override under most circumstances 94 95 sub title { 96 return "Superclass"; 97 } 98 99 sub body { 100 print "Generated content"; 101 ""; 102 } 103 104 ### Functions that subclasses /may/ want to override, if they've got something 105 ### special to say 106 107 sub pre_header_initialize {} 108 109 sub header { 110 my $self = shift; 111 my $r=$self->{r}; 112 $r->content_type('text/html'); 113 $r->send_http_header(); 114 } 115 116 sub initialize {} 117 118 ### Content-generating functions that should probably not be overridden 119 ### by most subclasses 120 121 sub logo { 122 my $self = shift; 123 return $self->{courseEnvironment}->{webworkURLs}->{logo}; 124 } 125 126 sub htdocs_base { 127 my $self = shift; 128 return $self->{courseEnvironment}->{webworkURLs}->{base}; 129 } 130 131 sub test_args { 132 my %args = %{$_[-1]}; 133 134 print "<pre>"; 135 print "$_ => $args{$_}\n" foreach (keys %args); 136 print "</pre>"; 137 ""; 138 } 139 140 # Used by &go to parse the argument fields of the template escapes 141 sub cook_args($) { 142 # There are a bunch of commented-out lines that I am using to remind myself 143 # That I want to write a better regex sometime. 144 my ($raw_args) = @_; 145 my $args = {}; 146 #my $quotable_string = qr/(?:".*?(?<*\\)"|\W*)/; 147 #my $quotable_string = qr/(?:".*?(?<!\\)"|\W*)/; 148 #my $test_string = '"hel \" lo" hello'; 149 150 #warn $test_string =~ m/($quotable_string)/ ? $1 : "false"; 151 152 while ($raw_args =~ m/\G\s*(\w*)="(.*?)"/g) { 153 #while ($raw_args =~ m/\G\s*($quotable_string)=($quotable_string)/g) { 154 $args->{$1} = $2; 155 } 156 157 return $args; 158 } 159 160 # Perform substitution in a template file and print it. This should be called 161 # for all content generators that are creating HTML output, and is called by 162 # default by the &go method. 163 sub template { 164 my ($self, $templateFile) = (shift, shift); 165 my $r = $self->{r}; 166 my $courseEnvironment = $self->{courseEnvironment}; 167 168 open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; 169 my @template = <TEMPLATE>; 170 close TEMPLATE; 171 172 foreach my $line (@template) { 173 # This is incremental regex processing. 174 # the /c is so that pos($line) doesn't die when the regex fails. 175 while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) { 176 my ($before, $function, $raw_args) = ($1, $2, $3); 177 # $args here will be a hashref 178 my $args = $raw_args =~ /\S/ ? cook_args $raw_args : {}; 179 print $before; 180 181 print $self->$function(@_, $args) if $self->can($function); 182 } 183 184 print substr $line, (defined(pos($line)) ? pos($line) : 0); 185 } 186 } 187 188 # Do whatever needs to be done in order to get a page to the client. You 189 # probably don't want to override this unless you're not making a web page 190 # with the template. 191 sub go { 192 my $self = shift; 193 my $r = $self->{r}; 194 my $courseEnvironment = $self->{courseEnvironment}; 195 196 $self->pre_header_initialize(@_); 197 $self->header(@_); return OK if $r->header_only; 198 $self->initialize(@_); 199 200 $self->template($courseEnvironment->{templates}->{system}, @_); 201 202 return OK; 203 } 204 205 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |