1: # The LearningOnline Network with CAPA
2: # .helper XML handler to implement the LON-CAPA helper
3: #
4: # $Id: lonhelper.pm,v 1.4 2003/03/28 20:25:19 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'));
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: # To collect parameters, the contents of the subtags are collected
119: # into this paramHash, then passed to the element object when the
120: # end of the element tag is located.
121: my $paramHash;
122:
123: sub handler {
124: my $r = shift;
125: $ENV{'request.uri'} = $r->uri();
126: my $filename = '/home/httpd/html' . $r->uri();
127: my $fh = Apache::File->new($filename);
128: my $file;
129: read $fh, $file, 100000000;
130:
131: Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING});
132:
133: # Send header, don't cache this page
134: if ($r->header_only) {
135: if ($ENV{'browser.mathml'}) {
136: $r->content_type('text/xml');
137: } else {
138: $r->content_type('text/html');
139: }
140: $r->send_http_header;
141: return OK;
142: }
143: if ($ENV{'browser.mathml'}) {
144: $r->content_type('text/xml');
145: } else {
146: $r->content_type('text/html');
147: }
148: $r->send_http_header;
149: $r->rflush();
150:
151: # Discard result, we just want the objects that get created by the
152: # xml parsing
153: &Apache::lonxml::xmlparse($r, 'helper', $file);
154:
155: $r->print($helper->display());
156: return OK;
157: }
158:
159: sub start_helper {
160: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
161:
162: if ($target ne 'helper') {
163: return '';
164: }
165:
166: $helper = Apache::lonhelper::helper->new($token->[2]{'title'});
167: return '';
168: }
169:
170: sub end_helper {
171: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
172:
173: if ($target ne 'helper') {
174: return '';
175: }
176:
177: return '';
178: }
179:
180: sub start_state {
181: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
182:
183: if ($target ne 'helper') {
184: return '';
185: }
186:
187: $state = Apache::lonhelper::state->new($token->[2]{'name'},
188: $token->[2]{'title'});
189: return '';
190: }
191:
192: # don't need this, so ignore it
193: sub end_state {
194: return '';
195: }
196:
197: 1;
198:
199: package Apache::lonhelper::helper;
200:
201: use Digest::MD5 qw(md5_hex);
202: use HTML::Entities;
203: use Apache::loncommon;
204: use Apache::File;
205:
206: sub new {
207: my $proto = shift;
208: my $class = ref($proto) || $proto;
209: my $self = {};
210:
211: $self->{TITLE} = shift;
212:
213: # If there is a state from the previous form, use that. If there is no
214: # state, use the start state parameter.
215: if (defined $ENV{"form.CURRENT_STATE"})
216: {
217: $self->{STATE} = $ENV{"form.CURRENT_STATE"};
218: }
219: else
220: {
221: $self->{STATE} = "START";
222: }
223:
224: $self->{TOKEN} = $ENV{'form.TOKEN'};
225: # If a token was passed, we load that in. Otherwise, we need to create a
226: # new storage file
227: # Tried to use standard Tie'd hashes, but you can't seem to take a
228: # reference to a tied hash and write to it. I'd call that a wart.
229: if ($self->{TOKEN}) {
230: # Validate the token before trusting it
231: if ($self->{TOKEN} !~ /^[a-f0-9]{32}$/) {
232: # Not legit. Return nothing and let all hell break loose.
233: # User shouldn't be doing that!
234: return undef;
235: }
236:
237: # Get the hash.
238: $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN}); # Note the token is not the literal file
239:
240: my $file = Apache::File->new($self->{FILENAME});
241: my $contents = <$file>;
242: &Apache::loncommon::get_unprocessed_cgi($contents);
243: $file->close();
244: } else {
245: # Only valid if we're just starting.
246: if ($self->{STATE} ne 'START') {
247: return undef;
248: }
249: # Must create the storage
250: $self->{TOKEN} = md5_hex($ENV{'user.name'} . $ENV{'user.domain'} .
251: time() . rand());
252: $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN});
253: }
254:
255: # OK, we now have our persistent storage.
256:
257: if (defined $ENV{"form.RETURN_PAGE"})
258: {
259: $self->{RETURN_PAGE} = $ENV{"form.RETURN_PAGE"};
260: }
261: else
262: {
263: $self->{RETURN_PAGE} = $ENV{REFERER};
264: }
265:
266: $self->{STATES} = {};
267: $self->{DONE} = 0;
268:
269: bless($self, $class);
270: return $self;
271: }
272:
273: # Private function; returns a string to construct the hidden fields
274: # necessary to have the helper track state.
275: sub _saveVars {
276: my $self = shift;
277: my $result = "";
278: $result .= '<input type="hidden" name="CURRENT_STATE" value="' .
279: HTML::Entities::encode($self->{STATE}) . "\" />\n";
280: $result .= '<input type="hidden" name="TOKEN" value="' .
281: $self->{TOKEN} . "\" />\n";
282: $result .= '<input type="hidden" name="RETURN_PAGE" value="' .
283: HTML::Entities::encode($self->{RETURN_PAGE}) . "\" />\n";
284:
285: return $result;
286: }
287:
288: # Private function: Create the querystring-like representation of the stored
289: # data to write to disk.
290: sub _varsInFile {
291: my $self = shift;
292: my @vars = ();
293: for my $key (keys %{$self->{VARS}}) {
294: push @vars, &Apache::lonnet::escape($key) . '=' .
295: &Apache::lonnet::escape($self->{VARS}->{$key});
296: }
297: return join ('&', @vars);
298: }
299:
300: sub changeState {
301: my $self = shift;
302: $self->{STATE} = shift;
303: }
304:
305: sub registerState {
306: my $self = shift;
307: my $state = shift;
308:
309: my $stateName = $state->name();
310: $self->{STATES}{$stateName} = $state;
311: }
312:
313: # Done in four phases
314: # 1: Do the post processing for the previous state.
315: # 2: Do the preprocessing for the current state.
316: # 3: Check to see if state changed, if so, postprocess current and move to next.
317: # Repeat until state stays stable.
318: # 4: Render the current state to the screen as an HTML page.
319: sub display {
320: my $self = shift;
321:
322: my $result = "";
323:
324: # Phase 1: Post processing for state of previous screen (which is actually
325: # the "current state" in terms of the helper variables), if it wasn't the
326: # beginning state.
327: if ($self->{STATE} ne "START" || $ENV{"form.SUBMIT"} eq "Next ->") {
328: my $prevState = $self->{STATES}{$self->{STATE}};
329: $prevState->postprocess();
330: }
331:
332: # Note, to handle errors in a state's input that a user must correct,
333: # do not transition in the postprocess, and force the user to correct
334: # the error.
335:
336: # Phase 2: Preprocess current state
337: my $startState = $self->{STATE};
338: my $state = $self->{STATES}{$startState};
339:
340: # Error checking; it is intended that the developer will have
341: # checked all paths and the user can't see this!
342: if (!defined($state)) {
343: $result .="Error! The state ". $startState ." is not defined.";
344: return $result;
345: }
346: $state->preprocess();
347:
348: # Phase 3: While the current state is different from the previous state,
349: # keep processing.
350: while ( $startState ne $self->{STATE} )
351: {
352: $startState = $self->{STATE};
353: $state = $self->{STATES}{$startState};
354: $state->preprocess();
355: }
356:
357: # Phase 4: Display.
358: my $stateTitle = $state->title();
359: my $bodytag = &Apache::loncommon::bodytag("$self->{TITLE}",'','');
360:
361: $result .= <<HEADER;
362: <html>
363: <head>
364: <title>LON-CAPA Helper: $self->{TITLE}</title>
365: </head>
366: $bodytag
367: HEADER
368: if (!$state->overrideForm()) { $result.="<form name='wizform' method='GET'>"; }
369: $result .= <<HEADER;
370: <table border="0"><tr><td>
371: <h2><i>$stateTitle</i></h2>
372: HEADER
373:
374: if (!$state->overrideForm()) {
375: $result .= $self->_saveVars();
376: }
377: $result .= $state->render() . "<p> </p>";
378:
379: if (!$state->overrideForm()) {
380: $result .= '<center>';
381: if ($self->{STATE} ne $self->{START_STATE}) {
382: #$result .= '<input name="SUBMIT" type="submit" value="<- Previous" /> ';
383: }
384: if ($self->{DONE}) {
385: my $returnPage = $self->{RETURN_PAGE};
386: $result .= "<a href=\"$returnPage\">End Helper</a>";
387: }
388: else {
389: $result .= '<input name="back" type="button" ';
390: $result .= 'value="<- Previous" onclick="history.go(-1)" /> ';
391: $result .= '<input name="SUBMIT" type="submit" value="Next ->" />';
392: }
393: $result .= "</center>\n";
394: }
395:
396: $result .= <<FOOTER;
397: </td>
398: </tr>
399: </table>
400: </form>
401: </body>
402: </html>
403: FOOTER
404:
405: # Handle writing out the vars to the file
406: my $file = Apache::File->new('>'.$self->{FILENAME});
407: print $file $self->_varsInFile();
408:
409: return $result;
410: }
411:
412: 1;
413:
414: package Apache::lonhelper::state;
415:
416: # States bundle things together and are responsible for compositing the
417: # various elements together. It is not generally necessary for users to
418: # use the state object directly, so it is not perldoc'ed.
419:
420: # Basically, all the states do is pass calls to the elements and aggregate
421: # the results.
422:
423: sub new {
424: my $proto = shift;
425: my $class = ref($proto) || $proto;
426: my $self = {};
427:
428: $self->{NAME} = shift;
429: $self->{TITLE} = shift;
430: $self->{ELEMENTS} = [];
431:
432: bless($self, $class);
433:
434: $helper->registerState($self);
435:
436: return $self;
437: }
438:
439: sub name {
440: my $self = shift;
441: return $self->{NAME};
442: }
443:
444: sub title {
445: my $self = shift;
446: return $self->{TITLE};
447: }
448:
449: sub preprocess {
450: my $self = shift;
451: for my $element (@{$self->{ELEMENTS}}) {
452: $element->preprocess();
453: }
454: }
455:
456: sub postprocess {
457: my $self = shift;
458:
459: for my $element (@{$self->{ELEMENTS}}) {
460: $element->postprocess();
461: }
462: }
463:
464: sub overrideForm {
465: return 0;
466: }
467:
468: sub addElement {
469: my $self = shift;
470: my $element = shift;
471:
472: push @{$self->{ELEMENTS}}, $element;
473: }
474:
475: sub render {
476: my $self = shift;
477: my @results = ();
478:
479: for my $element (@{$self->{ELEMENTS}}) {
480: push @results, $element->render();
481: }
482: return join("\n", @results);
483: }
484:
485: 1;
486:
487: package Apache::lonhelper::element;
488: # Support code for elements
489:
490: =pod
491:
492: =head2 Element Base Class
493:
494: The Apache::lonhelper::element base class provides support methods for
495: the elements to use, such as a multiple value processer.
496:
497: B<Methods>:
498:
499: =over 4
500:
501: =item * process_multiple_choices(formName, varName): Process the form
502: element named "formName" and place the selected items into the helper
503: variable named varName. This is for things like checkboxes or
504: multiple-selection listboxes where the user can select more then
505: one entry. The selected entries are delimited by triple pipes in
506: the helper variables, like this: CHOICE_1|||CHOICE_2|||CHOICE_3
507:
508: =back
509:
510: =cut
511:
512: # Because we use the param hash, this is often a sufficent
513: # constructor
514: sub new {
515: my $proto = shift;
516: my $class = ref($proto) || $proto;
517: my $self = $paramHash;
518: bless($self, $class);
519:
520: $self->{PARAMS} = $paramHash;
521: $self->{STATE} = $state;
522: $state->addElement($self);
523:
524: # Ensure param hash is not reused
525: $paramHash = {};
526:
527: return $self;
528: }
529:
530: sub preprocess {
531: return 1;
532: }
533:
534: sub postprocess {
535: return 1;
536: }
537:
538: sub render {
539: return '';
540: }
541:
542: sub process_multiple_choices {
543: my $self = shift;
544: my $formname = shift;
545: my $var = shift;
546:
547: my $formvalue = $ENV{'form.' . $formname};
548: if ($formvalue) {
549: # Must extract values from $wizard->{DATA} directly, as there
550: # may be more then one.
551: my @values;
552: for my $formparam (split (/&/, $wizard->{DATA})) {
553: my ($name, $value) = split(/=/, $formparam);
554: if ($name ne $formname) {
555: next;
556: }
557: $value =~ tr/+/ /;
558: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
559: push @values, $value;
560: }
561: $helper->setVar($var, join('|||', @values));
562: }
563:
564: return;
565: }
566:
567: 1;
568:
569: package Apache::lonhelper::message;
570:
571: =pod
572:
573: =head2 Element: message
574:
575: Message elements display the contents of their <message_text> tags, and
576: transition directly to the state in the <next_state> tag. Example:
577:
578: <message>
579: <next_state>GET_NAME</next_state>
580: <message_text>This is the <b>message</b> the user will see,
581: <i>HTML allowed</i>.</message_text>
582: </message>
583:
584: This will display the HTML message and transition to the <next_state> if
585: given. The HTML will be directly inserted into the wizard, so if you don't
586: want text to run together, you'll need to manually wrap the <message_text>
587: in <p> tags, or whatever is appropriate for your HTML.
588:
589: This is also a good template for creating your own new states, as it has
590: very little code beyond the state template.
591:
592: =cut
593:
594: no strict;
595: @ISA = ("Apache::lonhelper::element");
596: use strict;
597:
598: BEGIN {
599: &Apache::lonxml::register('Apache::lonhelper::message',
600: ('message', 'next_state', 'message_text'));
601: }
602:
603: # Don't need to override the "new" from element
604:
605: # CONSTRUCTION: Construct the message element from the XML
606: sub start_message {
607: return '';
608: }
609:
610: sub end_message {
611: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
612:
613: if ($target ne 'helper') {
614: return '';
615: }
616: Apache::lonhelper::message->new();
617: return '';
618: }
619:
620: sub start_next_state {
621: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
622:
623: if ($target ne 'helper') {
624: return '';
625: }
626:
627: $paramHash->{NEXT_STATE} = &Apache::lonxml::get_all_text('/next_state',
628: $parser);
629: return '';
630: }
631:
632: sub end_next_state { return ''; }
633:
634: sub start_message_text {
635: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
636:
637: if ($target ne 'helper') {
638: return '';
639: }
640:
641: $paramHash->{MESSAGE_TEXT} = &Apache::lonxml::get_all_text('/message_text',
642: $parser);
643: }
644:
645: sub end_message_text { return 1; }
646:
647: sub render {
648: my $self = shift;
649:
650: return $self->{MESSAGE_TEXT};
651: }
652: # If a NEXT_STATE was given, switch to it
653: sub postprocess {
654: my $self = shift;
655: if (defined($self->{NEXT_STATE})) {
656: $helper->changeState($self->{NEXT_STATE});
657: }
658: }
659: 1;
660:
661: __END__
662:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonhelper.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface