[system] / trunk / webwork-modperl / lib / WeBWorK / ContentGenerator.pm Repository:
ViewVC logotype

Diff of /trunk/webwork-modperl/lib/WeBWorK/ContentGenerator.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 389 Revision 390
1package WeBWorK::ContentGenerator; 1package WeBWorK::ContentGenerator;
2 2
3use CGI qw(-compile :html :form); 3use CGI qw(-compile :html :form);
4use Apache::Constants qw(:common); 4use Apache::Constants qw(:common);
5 5
6# Send 'die' message to the browser window
7use CGI::Carp qw(fatalsToBrowser);
8
9
6# This is a superclass for Apache::WeBWorK's content generators. 10# This is a superclass for Apache::WeBWorK's content generators.
7# You are /definitely/ encouraged to read this file, since there are 11# You are /definitely/ encouraged to read this file, since there are
8# "abstract" functions here which show aproximately what form you would 12# "abstract" functions here which show aproximately what form you would
9# want over-ridden sub-classes to follow. go() is a particularly pertinent 13# want over-ridden sub-classes to follow.
10# example.
11 14
12# new(Apache::Request, WeBWorK::CourseEnvironment) 15# new(Apache::Request, WeBWorK::CourseEnvironment)
13sub new($$$) { 16sub new($$$) {
14 my $invocant = shift; 17 my $invocant = shift;
15 my $class = ref($invocant) || $invocant; 18 my $class = ref($invocant) || $invocant;
… …
49 my $self = shift; 52 my $self = shift;
50 my $r = $self->{r}; 53 my $r = $self->{r};
51 my $courseEnvironment = $self->{courseEnvironment}; 54 my $courseEnvironment = $self->{courseEnvironment};
52 my $html = ""; 55 my $html = "";
53 56
54 foreach $param ("user","key") { 57 foreach $param ("user","effectiveUser","key") {
55 my $value = $r->param($param); 58 my $value = $r->param($param);
56 $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"}); 59 $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"});
57 } 60 }
58 return $html; 61 return $html;
59} 62}
63
64### Functions that subclasses /should/ override under most circumstances
65
66sub title {
67 return "Superclass";
68}
69
70sub body {
71 print "Generated content";
72 "";
73}
74
75### Functions that subclasses /may/ want to override, if they've got something
76### special to say
60 77
61sub pre_header_initialize {} 78sub pre_header_initialize {}
62 79
63sub header { 80sub header {
64 my $self = shift; 81 my $self = shift;
… …
67 $r->send_http_header(); 84 $r->send_http_header();
68} 85}
69 86
70sub initialize {} 87sub initialize {}
71 88
72sub title { 89### Content-generating functions that should probably not be overridden
73 return "Superclass"; 90### by most subclasses
74}
75
76sub body {
77 print "Generated content";
78 "";
79}
80 91
81sub logo { 92sub logo {
82 my $self = shift; 93 my $self = shift;
83 return $self->{courseEnvironment}->{urls}->{logo}; 94 return $self->{courseEnvironment}->{urls}->{logo};
84} 95}
… …
86sub htdocs_base { 97sub htdocs_base {
87 my $self = shift; 98 my $self = shift;
88 return $self->{courseEnvironment}->{urls}->{base}; 99 return $self->{courseEnvironment}->{urls}->{base};
89} 100}
90 101
102sub test_args {
103 my %args = %{$_[-1]};
104
105 print "<pre>";
106 print "$_ => $args{$_}\n" foreach (keys %args);
107 print "</pre>";
108 "";
109}
110
111# Used by &go to parse the argument fields of the template escapes
112sub cook_args($) {
113 my ($raw_args) = @_;
114 my $args = {};
115 #my $quotable_string = qr/(?:".*?(?<![^\\](?:\\\\)*\\)"|\W*)/;
116 #my $quotable_string = qr/(?:".*?(?<!\\)"|\W*)/;
117 #my $test_string = '"hel \" lo" hello';
118
119 #warn $test_string =~ m/($quotable_string)/ ? $1 : "false";
120
121 while ($raw_args =~ m/\G\s*(\w*)="(.*?)"/g) {
122 #while ($raw_args =~ m/\G\s*($quotable_string)=($quotable_string)/g) {
123 $args->{$1} = $2;
124 }
125
126 return $args;
127}
128
129# Perform substitution in a template file and print it. This should be called
130# for all content generators that are creating HTML output, and is called by
131# default by the &go method.
132sub template {
133 my ($self, $templateFile) = @_;
134 my $r = $self->{r};
135 my $courseEnvironment = $self->{courseEnvironment};
136
137 open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile";
138 my @template = <TEMPLATE>;
139 close TEMPLATE;
140
141 foreach my $line (@template) {
142 # This is incremental regex processing.
143 # the /c is so that pos($line) doesn't die when the regex fails.
144 while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) {
145 my ($before, $function, $raw_args) = ($1, $2, $3);
146 # $args here will be a hashref
147 my $args = cook_args $raw_args if $raw_args =~ /\S/;
148 print $before;
149 print $self->$function(@_, $args) if $self->can($function);
150 }
151 print substr $line, pos($line);
152 }
153}
154
155# Do whatever needs to be done in order to get a page to the client. You
156# probably don't want to override this unless you're not making a web page
157# with the template.
91sub go { 158sub go {
92 my $self = shift; 159 my $self = shift;
93 my $r = $self->{r}; 160 my $r = $self->{r};
94 my $courseEnvironment = $self->{courseEnvironment}; 161 my $courseEnvironment = $self->{courseEnvironment};
95 162
96 $self->pre_header_initialize(@_); 163 $self->pre_header_initialize(@_);
97 $self->header(@_); return OK if $r->header_only; 164 $self->header(@_); return OK if $r->header_only;
98 $self->initialize(@_); 165 $self->initialize(@_);
99 166
100 my $templateFile = $courseEnvironment->{templates}->{system}; 167 $self->template($courseEnvironment->{templates}->{system});
101
102 open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile";
103 my @template = <TEMPLATE>;
104 close TEMPLATE;
105
106 foreach my $line (@template) {
107 # This is incremental regex processing.
108 # the /c is so that pos($line) doesn't die when the regex fails.
109 while ($line =~ m/\G(.*?)<!--#(.*?)\s*-->/gc) {
110 print "$1";
111 print $self->$2(@_) if $self->can($2);
112 } 168
113 # I thought I could use pos($line) here, but /noooooo/
114 print substr $line, pos($line);
115 }
116
117 return OK; 169 return OK;
118} 170}
119 171
1201; 1721;
Legend:
Removed from v.389  
changed lines
  Added in v.390
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9