[system] / trunk / webwork2 / lib / WeBWorK / ContentGenerator.pm Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 397 - (view) (download) (as text)

1 : malsyned 313 package WeBWorK::ContentGenerator;
2 : malsyned 305
3 : malsyned 323 use CGI qw(-compile :html :form);
4 :     use Apache::Constants qw(:common);
5 :    
6 : malsyned 390 # Send 'die' message to the browser window
7 :     use CGI::Carp qw(fatalsToBrowser);
8 :    
9 :    
10 : malsyned 313 # This is a superclass for Apache::WeBWorK's content generators.
11 :     # You are /definitely/ encouraged to read this file, since there are
12 :     # "abstract" functions here which show aproximately what form you would
13 : malsyned 390 # want over-ridden sub-classes to follow.
14 : malsyned 313
15 : malsyned 305 # new(Apache::Request, WeBWorK::CourseEnvironment)
16 :     sub new($$$) {
17 : malsyned 323 my $invocant = shift;
18 :     my $class = ref($invocant) || $invocant;
19 : malsyned 305 my $self = {};
20 :     ($self->{r}, $self->{courseEnvironment}) = @_;
21 :     bless $self, $class;
22 :     return $self;
23 :     }
24 :    
25 : malsyned 323
26 : malsyned 313 # This is a quick and dirty function to print out all (or almost all) of the
27 :     # fields in a form in a specified format. As you can see from the print
28 :     # statement, it just prints out $begining$name$middle$value$end for every
29 :     # field who's name doesn't match $qr_omit, a quoted regex.
30 :     # In it's current incarnation, it should be called from subclasses only,
31 :     # by saying $self->print_form_data. Of course, you could construct a
32 :     # hashref with ->{r} being an Apache::Request, I suppose.
33 : malsyned 305
34 : malsyned 313 sub print_form_data {
35 :     my ($self, $begin, $middle, $end, $qr_omit) = @_;
36 : malsyned 353 my $return_string = "";
37 : malsyned 313
38 :     $r=$self->{r};
39 :     my @form_data = $r->param;
40 :     foreach my $name (@form_data) {
41 :     next if ($qr_omit and $name =~ /$qr_omit/);
42 :     my @values = $r->param($name);
43 :     foreach my $value (@values) {
44 : malsyned 353 $return_string .= "$begin$name$middle$value$end";
45 : malsyned 313 }
46 :     }
47 : malsyned 353
48 :     return $return_string;
49 : malsyned 313 }
50 :    
51 : malsyned 323 sub hidden_authen_fields {
52 :     my $self = shift;
53 :     my $r = $self->{r};
54 :     my $courseEnvironment = $self->{courseEnvironment};
55 :     my $html = "";
56 :    
57 : malsyned 390 foreach $param ("user","effectiveUser","key") {
58 : malsyned 323 my $value = $r->param($param);
59 :     $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"});
60 :     }
61 :     return $html;
62 :     }
63 :    
64 : malsyned 390 ### Functions that subclasses /should/ override under most circumstances
65 :    
66 :     sub title {
67 :     return "Superclass";
68 :     }
69 :    
70 :     sub 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
77 :    
78 : malsyned 349 sub pre_header_initialize {}
79 : malsyned 313
80 : malsyned 349 sub header {
81 : malsyned 305 my $self = shift;
82 : malsyned 349 my $r=$self->{r};
83 :     $r->content_type('text/html');
84 :     $r->send_http_header();
85 :     }
86 :    
87 :     sub initialize {}
88 :    
89 : malsyned 390 ### Content-generating functions that should probably not be overridden
90 :     ### by most subclasses
91 : malsyned 349
92 : malsyned 353 sub logo {
93 :     my $self = shift;
94 :     return $self->{courseEnvironment}->{urls}->{logo};
95 :     }
96 :    
97 :     sub htdocs_base {
98 :     my $self = shift;
99 :     return $self->{courseEnvironment}->{urls}->{base};
100 :     }
101 :    
102 : malsyned 390 sub 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
112 :     sub 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.
132 :     sub template {
133 : malsyned 397 my ($self, $templateFile) = (shift, shift);
134 : malsyned 323 my $r = $self->{r};
135 :     my $courseEnvironment = $self->{courseEnvironment};
136 : malsyned 305
137 : malsyned 349 open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile";
138 :     my @template = <TEMPLATE>;
139 :     close TEMPLATE;
140 :    
141 :     foreach my $line (@template) {
142 : malsyned 353 # This is incremental regex processing.
143 :     # the /c is so that pos($line) doesn't die when the regex fails.
144 : malsyned 390 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 : malsyned 349 }
151 : malsyned 353 print substr $line, pos($line);
152 : malsyned 349 }
153 : malsyned 390 }
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.
158 :     sub go {
159 :     my $self = shift;
160 :     my $r = $self->{r};
161 :     my $courseEnvironment = $self->{courseEnvironment};
162 :    
163 :     $self->pre_header_initialize(@_);
164 :     $self->header(@_); return OK if $r->header_only;
165 :     $self->initialize(@_);
166 : malsyned 349
167 : malsyned 397 $self->template($courseEnvironment->{templates}->{system}, @_);
168 :    
169 : malsyned 349 return OK;
170 : malsyned 313 }
171 :    
172 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9