Annotation of loncom/interface/lonhelper.pm, revision 1.4
1.1 bowersj2 1: # The LearningOnline Network with CAPA
2: # .helper XML handler to implement the LON-CAPA helper
3: #
1.3 bowersj2 4: # $Id: lonhelper.pm,v 1.2 2003/03/21 21:34:56 bowersj2 Exp $
1.1 bowersj2 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:
1.3 bowersj2 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:
1.1 bowersj2 101: package Apache::lonhelper;
1.2 bowersj2 102: use Apache::Constants qw(:common);
103: use Apache::File;
1.3 bowersj2 104: use Apache::lonxml;
1.2 bowersj2 105:
106: BEGIN {
107: &Apache::lonxml::register('Apache::lonhelper',
1.4 ! bowersj2 108: ('helper', 'state'));
1.2 bowersj2 109: }
110:
1.3 bowersj2 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;
1.4 ! bowersj2 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;
1.2 bowersj2 122:
123: sub handler {
1.3 bowersj2 124: my $r = shift;
1.2 bowersj2 125: $ENV{'request.uri'} = $r->uri();
126: my $filename = '/home/httpd/html' . $r->uri();
127: my $fh = Apache::File->new($filename);
128: my $file;
1.3 bowersj2 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();
1.2 bowersj2 150:
1.3 bowersj2 151: # Discard result, we just want the objects that get created by the
152: # xml parsing
153: &Apache::lonxml::xmlparse($r, 'helper', $file);
1.2 bowersj2 154:
1.3 bowersj2 155: $r->print($helper->display());
1.2 bowersj2 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:
1.3 bowersj2 166: $helper = Apache::lonhelper::helper->new($token->[2]{'title'});
1.4 ! bowersj2 167: return '';
1.2 bowersj2 168: }
169:
170: sub end_helper {
171: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
172:
1.3 bowersj2 173: if ($target ne 'helper') {
174: return '';
175: }
176:
1.4 ! bowersj2 177: return '';
1.2 bowersj2 178: }
1.1 bowersj2 179:
1.3 bowersj2 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:
1.1 bowersj2 197: 1;
198:
1.3 bowersj2 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
1.4 ! bowersj2 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.
1.3 bowersj2 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:
1.4 ! bowersj2 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:
1.3 bowersj2 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:
1.4 ! bowersj2 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'));
1.3 bowersj2 601: }
602:
1.4 ! bowersj2 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 '';
1.3 bowersj2 608: }
609:
1.4 ! bowersj2 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 '';
1.3 bowersj2 618: }
619:
1.4 ! bowersj2 620: sub start_next_state {
! 621: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
! 622:
! 623: if ($target ne 'helper') {
! 624: return '';
! 625: }
1.3 bowersj2 626:
1.4 ! bowersj2 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);
1.3 bowersj2 643: }
1.4 ! bowersj2 644:
! 645: sub end_message_text { return 1; }
1.3 bowersj2 646:
647: sub render {
648: my $self = shift;
649:
1.4 ! bowersj2 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});
1.3 bowersj2 657: }
658: }
1.4 ! bowersj2 659: 1;
1.3 bowersj2 660:
1.1 bowersj2 661: __END__
1.3 bowersj2 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