Parent Directory
| 
Revision Log
Revision 441 - (view) (download) (as text)
| 1 : | malsyned | 313 | package WeBWorK::ContentGenerator; |
| 2 : | malsyned | 305 | |
| 3 : | malsyned | 441 | use strict; |
| 4 : | use warnings; | ||
| 5 : | malsyned | 323 | use CGI qw(-compile :html :form); |
| 6 : | use Apache::Constants qw(:common); | ||
| 7 : | |||
| 8 : | malsyned | 390 | # Send 'die' message to the browser window |
| 9 : | malsyned | 403 | #use CGI::Carp qw(fatalsToBrowser); |
| 10 : | malsyned | 390 | |
| 11 : | |||
| 12 : | malsyned | 313 | # 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 : | malsyned | 390 | # want over-ridden sub-classes to follow. |
| 16 : | malsyned | 313 | |
| 17 : | malsyned | 305 | # new(Apache::Request, WeBWorK::CourseEnvironment) |
| 18 : | sub new($$$) { | ||
| 19 : | malsyned | 323 | my $invocant = shift; |
| 20 : | my $class = ref($invocant) || $invocant; | ||
| 21 : | malsyned | 305 | my $self = {}; |
| 22 : | ($self->{r}, $self->{courseEnvironment}) = @_; | ||
| 23 : | bless $self, $class; | ||
| 24 : | return $self; | ||
| 25 : | } | ||
| 26 : | |||
| 27 : | malsyned | 323 | |
| 28 : | malsyned | 313 | # 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 : | malsyned | 305 | |
| 36 : | malsyned | 313 | sub print_form_data { |
| 37 : | my ($self, $begin, $middle, $end, $qr_omit) = @_; | ||
| 38 : | malsyned | 353 | my $return_string = ""; |
| 39 : | malsyned | 313 | |
| 40 : | malsyned | 441 | my $r=$self->{r}; |
| 41 : | malsyned | 313 | 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 : | malsyned | 441 | |
| 46 : | |||
| 47 : | foreach my $variable (qw(begin name middle value end)) { | ||
| 48 : | no strict 'refs'; | ||
| 49 : | ${$variable} = "" unless defined ${$variable}; | ||
| 50 : | } | ||
| 51 : | |||
| 52 : | malsyned | 313 | foreach my $value (@values) { |
| 53 : | malsyned | 353 | $return_string .= "$begin$name$middle$value$end"; |
| 54 : | malsyned | 313 | } |
| 55 : | } | ||
| 56 : | malsyned | 353 | |
| 57 : | return $return_string; | ||
| 58 : | malsyned | 313 | } |
| 59 : | |||
| 60 : | malsyned | 323 | sub hidden_authen_fields { |
| 61 : | my $self = shift; | ||
| 62 : | my $r = $self->{r}; | ||
| 63 : | my $courseEnvironment = $self->{courseEnvironment}; | ||
| 64 : | my $html = ""; | ||
| 65 : | |||
| 66 : | malsyned | 441 | foreach my $param ("user","effectiveUser","key") { |
| 67 : | malsyned | 323 | my $value = $r->param($param); |
| 68 : | $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"}); | ||
| 69 : | } | ||
| 70 : | return $html; | ||
| 71 : | } | ||
| 72 : | |||
| 73 : | sh002i | 425 | #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 : | malsyned | 441 | foreach my $param (@fields) { |
| 87 : | sh002i | 425 | my $value = $r->param($param); |
| 88 : | $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"}); | ||
| 89 : | } | ||
| 90 : | return $html; | ||
| 91 : | } | ||
| 92 : | |||
| 93 : | malsyned | 390 | ### 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 : | malsyned | 349 | sub pre_header_initialize {} |
| 108 : | malsyned | 313 | |
| 109 : | malsyned | 349 | sub header { |
| 110 : | malsyned | 305 | my $self = shift; |
| 111 : | malsyned | 349 | my $r=$self->{r}; |
| 112 : | $r->content_type('text/html'); | ||
| 113 : | $r->send_http_header(); | ||
| 114 : | } | ||
| 115 : | |||
| 116 : | sub initialize {} | ||
| 117 : | |||
| 118 : | malsyned | 390 | ### Content-generating functions that should probably not be overridden |
| 119 : | ### by most subclasses | ||
| 120 : | malsyned | 349 | |
| 121 : | malsyned | 353 | sub logo { |
| 122 : | my $self = shift; | ||
| 123 : | malsyned | 441 | return $self->{courseEnvironment}->{webworkURLs}->{logo}; |
| 124 : | malsyned | 353 | } |
| 125 : | |||
| 126 : | sub htdocs_base { | ||
| 127 : | my $self = shift; | ||
| 128 : | malsyned | 441 | return $self->{courseEnvironment}->{webworkURLs}->{base}; |
| 129 : | malsyned | 353 | } |
| 130 : | |||
| 131 : | malsyned | 390 | 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 : | malsyned | 420 | # 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 : | malsyned | 390 | 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 : | malsyned | 397 | my ($self, $templateFile) = (shift, shift); |
| 165 : | malsyned | 323 | my $r = $self->{r}; |
| 166 : | my $courseEnvironment = $self->{courseEnvironment}; | ||
| 167 : | malsyned | 305 | |
| 168 : | malsyned | 349 | open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile"; |
| 169 : | my @template = <TEMPLATE>; | ||
| 170 : | close TEMPLATE; | ||
| 171 : | |||
| 172 : | foreach my $line (@template) { | ||
| 173 : | malsyned | 353 | # This is incremental regex processing. |
| 174 : | # the /c is so that pos($line) doesn't die when the regex fails. | ||
| 175 : | malsyned | 390 | while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) { |
| 176 : | my ($before, $function, $raw_args) = ($1, $2, $3); | ||
| 177 : | # $args here will be a hashref | ||
| 178 : | malsyned | 441 | my $args = $raw_args =~ /\S/ ? cook_args $raw_args : {}; |
| 179 : | malsyned | 390 | print $before; |
| 180 : | malsyned | 441 | |
| 181 : | malsyned | 390 | print $self->$function(@_, $args) if $self->can($function); |
| 182 : | malsyned | 349 | } |
| 183 : | malsyned | 441 | |
| 184 : | print substr $line, (defined(pos($line)) ? pos($line) : 0); | ||
| 185 : | malsyned | 349 | } |
| 186 : | malsyned | 390 | } |
| 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 : | malsyned | 349 | |
| 200 : | malsyned | 397 | $self->template($courseEnvironment->{templates}->{system}, @_); |
| 201 : | |||
| 202 : | malsyned | 349 | return OK; |
| 203 : | malsyned | 313 | } |
| 204 : | |||
| 205 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |