Annotation of loncom/interface/lonhelper.pm, revision 1.3
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.3 ! bowersj2 108: ('helper', 'state', 'message'));
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.2 bowersj2 118:
119: sub handler {
1.3 ! bowersj2 120: my $r = shift;
1.2 bowersj2 121: $ENV{'request.uri'} = $r->uri();
122: my $filename = '/home/httpd/html' . $r->uri();
123: my $fh = Apache::File->new($filename);
124: my $file;
1.3 ! bowersj2 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();
1.2 bowersj2 146:
1.3 ! bowersj2 147: # Discard result, we just want the objects that get created by the
! 148: # xml parsing
! 149: &Apache::lonxml::xmlparse($r, 'helper', $file);
1.2 bowersj2 150:
1.3 ! bowersj2 151: $r->print($helper->display());
1.2 bowersj2 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:
1.3 ! bowersj2 162: $helper = Apache::lonhelper::helper->new($token->[2]{'title'});
! 163: return 'helper made';
1.2 bowersj2 164: }
165:
166: sub end_helper {
167: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
168:
1.3 ! bowersj2 169: if ($target ne 'helper') {
! 170: return '';
! 171: }
! 172:
1.2 bowersj2 173: return 'Helper ended.';
174: }
1.1 bowersj2 175:
1.3 ! bowersj2 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:
1.1 bowersj2 213: 1;
214:
1.3 ! bowersj2 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:
1.1 bowersj2 516: __END__
1.3 ! bowersj2 517:
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