1: # The LearningOnline Network with CAPA
2: # .helper XML handler to implement the LON-CAPA helper
3: #
4: # $Id: lonhelper.pm,v 1.3 2003/03/27 20:58:16 bowersj2 Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: # (Page Handler
29: #
30: # (.helper handler
31: #
32:
33: =pod
34:
35: =head1 lonhelper - HTML Helper framework for LON-CAPA
36:
37: Helpers, often known as "wizards", are well-established UI widgets that users
38: feel comfortable with. It can take a complicated multidimensional problem the
39: user has and turn it into a series of bite-sized one-dimensional questions.
40:
41: For developers, helpers provide an easy way to bundle little bits of functionality
42: for the user, without having to write the tedious state-maintenence code.
43:
44: Helpers are defined as XML documents, placed in the /home/httpd/html/adm/helpers
45: directory and having the .helper file extension. For examples, see that directory.
46:
47: All classes are in the Apache::lonhelper namespace.
48:
49: =head2 lonxml
50:
51: The helper uses the lonxml XML parsing support. The following capabilities
52: are directly imported from lonxml:
53:
54: =over 4
55:
56: =item * <startouttext> and <endouttext>: These tags may be used, as in problems,
57: to directly output text to the user.
58:
59: =back
60:
61: =head2 lonhelper XML file format
62:
63: A helper consists of a top-level <helper> tag which contains a series of states.
64: Each state contains one or more state elements, which are what the user sees, like
65: messages, resource selections, or date queries.
66:
67: The helper tag is required to have one attribute, "title", which is the name
68: of the helper itself, such as "Parameter helper".
69:
70: =head2 State tags
71:
72: State tags are required to have an attribute "name", which is the symbolic
73: name of the state and will not be directly seen by the user. The wizard is
74: required to have one state named "START", which is the state the wizard
75: will start with. by convention, this state should clearly describe what
76: the helper will do for the user, and may also include the first information
77: entry the user needs to do for the helper.
78:
79: State tags are also required to have an attribute "title", which is the
80: human name of the state, and will be displayed as the header on top of
81: the screen for the user.
82:
83: =head2 Example Helper Skeleton
84:
85: An example of the tags so far:
86:
87: <helper title="Example Helper">
88: <state name="START" title="Demonstrating the Example Helper">
89: <!-- notice this is the START state the wizard requires -->
90: </state>
91: <state name="GET_NAME" title="Enter Student Name">
92: </state>
93: </helper>
94:
95: Of course this does nothing. In order for the wizard to do something, it is
96: necessary to put actual elements into the wizard. Documentation for each
97: of these elements follows.
98:
99: =cut
100:
101: package Apache::lonhelper;
102: use Apache::Constants qw(:common);
103: use Apache::File;
104: use Apache::lonxml;
105:
106: BEGIN {
107: &Apache::lonxml::register('Apache::lonhelper',
108: ('helper', 'state', 'message'));
109: }
110:
111: # Since all wizards are only three levels deep (wizard tag, state tag,
112: # substate type), it's easier and more readble to explicitly track
113: # those three things directly, rather then futz with the tag stack
114: # every time.
115: my $helper;
116: my $state;
117: my $substate;
118:
119: sub handler {
120: my $r = shift;
121: $ENV{'request.uri'} = $r->uri();
122: my $filename = '/home/httpd/html' . $r->uri();
123: my $fh = Apache::File->new($filename);
124: my $file;
125: read $fh, $file, 100000000;
126:
127: Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING});
128:
129: # Send header, don't cache this page
130: if ($r->header_only) {
131: if ($ENV{'browser.mathml'}) {
132: $r->content_type('text/xml');
133: } else {
134: $r->content_type('text/html');
135: }
136: $r->send_http_header;
137: return OK;
138: }
139: if ($ENV{'browser.mathml'}) {
140: $r->content_type('text/xml');
141: } else {
142: $r->content_type('text/html');
143: }
144: $r->send_http_header;
145: $r->rflush();
146:
147: # Discard result, we just want the objects that get created by the
148: # xml parsing
149: &Apache::lonxml::xmlparse($r, 'helper', $file);
150:
151: $r->print($helper->display());
152: return OK;
153: }
154:
155: sub start_helper {
156: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
157:
158: if ($target ne 'helper') {
159: return '';
160: }
161:
162: $helper = Apache::lonhelper::helper->new($token->[2]{'title'});
163: return 'helper made';
164: }
165:
166: sub end_helper {
167: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
168:
169: if ($target ne 'helper') {
170: return '';
171: }
172:
173: return 'Helper ended.';
174: }
175:
176: sub start_state {
177: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
178:
179: if ($target ne 'helper') {
180: return '';
181: }
182:
183: $state = Apache::lonhelper::state->new($token->[2]{'name'},
184: $token->[2]{'title'});
185: return '';
186: }
187:
188: # don't need this, so ignore it
189: sub end_state {
190: return '';
191: }
192:
193: sub start_message {
194: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
195:
196: if ($target ne 'helper') {
197: return '';
198: }
199:
200: return &Apache::lonxml::get_all_text("/message", $parser);
201: }
202:
203: sub end_message {
204: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
205:
206: if ($target ne 'helper') {
207: return '';
208: }
209:
210: return '';
211: }
212:
213: 1;
214:
215: package Apache::lonhelper::helper;
216:
217: use Digest::MD5 qw(md5_hex);
218: use HTML::Entities;
219: use Apache::loncommon;
220: use Apache::File;
221:
222: sub new {
223: my $proto = shift;
224: my $class = ref($proto) || $proto;
225: my $self = {};
226:
227: $self->{TITLE} = shift;
228:
229: # If there is a state from the previous form, use that. If there is no
230: # state, use the start state parameter.
231: if (defined $ENV{"form.CURRENT_STATE"})
232: {
233: $self->{STATE} = $ENV{"form.CURRENT_STATE"};
234: }
235: else
236: {
237: $self->{STATE} = "START";
238: }
239:
240: $self->{TOKEN} = $ENV{'form.TOKEN'};
241: # If a token was passed, we load that in. Otherwise, we need to create a
242: # new storage file
243: # Tried to use standard Tie'd hashes, but you can't seem to take a
244: # reference to a tied hash and write to it. I'd call that a wart.
245: if ($self->{TOKEN}) {
246: # Validate the token before trusting it
247: if ($self->{TOKEN} !~ /^[a-f0-9]{32}$/) {
248: # Not legit. Return nothing and let all hell break loose.
249: # User shouldn't be doing that!
250: return undef;
251: }
252:
253: # Get the hash.
254: $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN}); # Note the token is not the literal file
255:
256: my $file = Apache::File->new($self->{FILENAME});
257: my $contents = <$file>;
258: &Apache::loncommon::get_unprocessed_cgi($contents);
259: $file->close();
260: } else {
261: # Only valid if we're just starting.
262: if ($self->{STATE} ne 'START') {
263: return undef;
264: }
265: # Must create the storage
266: $self->{TOKEN} = md5_hex($ENV{'user.name'} . $ENV{'user.domain'} .
267: time() . rand());
268: $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN});
269: }
270:
271: # OK, we now have our persistent storage.
272:
273: if (defined $ENV{"form.RETURN_PAGE"})
274: {
275: $self->{RETURN_PAGE} = $ENV{"form.RETURN_PAGE"};
276: }
277: else
278: {
279: $self->{RETURN_PAGE} = $ENV{REFERER};
280: }
281:
282: $self->{STATES} = {};
283: $self->{DONE} = 0;
284:
285: bless($self, $class);
286: return $self;
287: }
288:
289: # Private function; returns a string to construct the hidden fields
290: # necessary to have the helper track state.
291: sub _saveVars {
292: my $self = shift;
293: my $result = "";
294: $result .= '<input type="hidden" name="CURRENT_STATE" value="' .
295: HTML::Entities::encode($self->{STATE}) . "\" />\n";
296: $result .= '<input type="hidden" name="TOKEN" value="' .
297: $self->{TOKEN} . "\" />\n";
298: $result .= '<input type="hidden" name="RETURN_PAGE" value="' .
299: HTML::Entities::encode($self->{RETURN_PAGE}) . "\" />\n";
300:
301: return $result;
302: }
303:
304: # Private function: Create the querystring-like representation of the stored
305: # data to write to disk.
306: sub _varsInFile {
307: my $self = shift;
308: my @vars = ();
309: for my $key (keys %{$self->{VARS}}) {
310: push @vars, &Apache::lonnet::escape($key) . '=' .
311: &Apache::lonnet::escape($self->{VARS}->{$key});
312: }
313: return join ('&', @vars);
314: }
315:
316: sub changeState {
317: my $self = shift;
318: $self->{STATE} = shift;
319: }
320:
321: sub registerState {
322: my $self = shift;
323: my $state = shift;
324:
325: my $stateName = $state->name();
326: $self->{STATES}{$stateName} = $state;
327: }
328:
329: # Done in four phases
330: # 1: Do the post processing for the previous state.
331: # 2: Do the preprocessing for the current state.
332: # 3: Check to see if state changed, if so, postprocess current and move to next.
333: # Repeat until state stays stable.
334: # 4: Render the current state to the screen as an HTML page.
335: sub display {
336: my $self = shift;
337:
338: my $result = "";
339:
340: # Phase 1: Post processing for state of previous screen (which is actually
341: # the "current state" in terms of the helper variables), if it wasn't the
342: # beginning state.
343: if ($self->{STATE} ne "START" || $ENV{"form.SUBMIT"} eq "Next ->") {
344: my $prevState = $self->{STATES}{$self->{STATE}};
345: $prevState->postprocess();
346: }
347:
348: # Note, to handle errors in a state's input that a user must correct,
349: # do not transition in the postprocess, and force the user to correct
350: # the error.
351:
352: # Phase 2: Preprocess current state
353: my $startState = $self->{STATE};
354: my $state = $self->{STATES}{$startState};
355:
356: # Error checking; it is intended that the developer will have
357: # checked all paths and the user can't see this!
358: if (!defined($state)) {
359: $result .="Error! The state ". $startState ." is not defined.";
360: return $result;
361: }
362: $state->preprocess();
363:
364: # Phase 3: While the current state is different from the previous state,
365: # keep processing.
366: while ( $startState ne $self->{STATE} )
367: {
368: $startState = $self->{STATE};
369: $state = $self->{STATES}{$startState};
370: $state->preprocess();
371: }
372:
373: # Phase 4: Display.
374: my $stateTitle = $state->title();
375: my $bodytag = &Apache::loncommon::bodytag("$self->{TITLE}",'','');
376:
377: $result .= <<HEADER;
378: <html>
379: <head>
380: <title>LON-CAPA Helper: $self->{TITLE}</title>
381: </head>
382: $bodytag
383: HEADER
384: if (!$state->overrideForm()) { $result.="<form name='wizform' method='GET'>"; }
385: $result .= <<HEADER;
386: <table border="0"><tr><td>
387: <h2><i>$stateTitle</i></h2>
388: HEADER
389:
390: if (!$state->overrideForm()) {
391: $result .= $self->_saveVars();
392: }
393: $result .= $state->render() . "<p> </p>";
394:
395: if (!$state->overrideForm()) {
396: $result .= '<center>';
397: if ($self->{STATE} ne $self->{START_STATE}) {
398: #$result .= '<input name="SUBMIT" type="submit" value="<- Previous" /> ';
399: }
400: if ($self->{DONE}) {
401: my $returnPage = $self->{RETURN_PAGE};
402: $result .= "<a href=\"$returnPage\">End Helper</a>";
403: }
404: else {
405: $result .= '<input name="back" type="button" ';
406: $result .= 'value="<- Previous" onclick="history.go(-1)" /> ';
407: $result .= '<input name="SUBMIT" type="submit" value="Next ->" />';
408: }
409: $result .= "</center>\n";
410: }
411:
412: $result .= <<FOOTER;
413: </td>
414: </tr>
415: </table>
416: </form>
417: </body>
418: </html>
419: FOOTER
420:
421: # Handle writing out the vars to the file
422: my $file = Apache::File->new('>'.$self->{FILENAME});
423: print $file $self->_varsInFile();
424:
425: return $result;
426: }
427:
428: 1;
429:
430: package Apache::lonhelper::state;
431:
432: # States bundle things together and are responsible for compositing the
433: # various elements together
434:
435: sub new {
436: my $proto = shift;
437: my $class = ref($proto) || $proto;
438: my $self = {};
439:
440: $self->{NAME} = shift;
441: $self->{TITLE} = shift;
442: $self->{ELEMENTS} = [];
443:
444: bless($self, $class);
445:
446: $helper->registerState($self);
447:
448: return $self;
449: }
450:
451: sub name {
452: my $self = shift;
453: return $self->{NAME};
454: }
455:
456: sub title {
457: my $self = shift;
458: return $self->{TITLE};
459: }
460:
461: sub process_multiple_choices {
462: my $self = shift;
463: my $formname = shift;
464: my $var = shift;
465:
466: my $formvalue = $ENV{'form.' . $formname};
467: if ($formvalue) {
468: # Must extract values from $wizard->{DATA} directly, as there
469: # may be more then one.
470: my @values;
471: for my $formparam (split (/&/, $wizard->{DATA})) {
472: my ($name, $value) = split(/=/, $formparam);
473: if ($name ne $formname) {
474: next;
475: }
476: $value =~ tr/+/ /;
477: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
478: push @values, $value;
479: }
480: $helper->setVar($var, join('|||', @values));
481: }
482:
483: return;
484: }
485:
486: sub preprocess {
487: return 1;
488: }
489:
490: sub postprocess {
491: return 1;
492: }
493:
494: sub overrideForm {
495: return 1;
496: }
497:
498: sub addElement {
499: my $self = shift;
500: my $element = shift;
501:
502: push @{$self->{ELEMENTS}}, $element;
503: }
504:
505: sub render {
506: my $self = shift;
507: my @results = ();
508:
509: for my $element (@{$self->{ELEMENTS}}) {
510: push @results, $element->render();
511: }
512: push @results, $self->title();
513: return join("\n", @results);
514: }
515:
516: __END__
517:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>