[BACK]Return to lonhelper.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonhelper.pm between versions 1.5 and 1.9

version 1.5, 2003/04/10 18:02:09 version 1.9, 2003/04/11 19:01:46
Line 30 Line 30
 # (.helper handler  # (.helper handler
 #  #
   
 # FIXME: Change register calls to register with the helper.  
 # Then have the helper reg and unreg the tags.  
 # This removes my concerns about breaking other code.  
   
 =pod  =pod
   
 =head1 lonhelper - HTML Helper framework for LON-CAPA  =head1 lonhelper - HTML Helper framework for LON-CAPA
Line 62  of the helper itself, such as "Parameter Line 58  of the helper itself, such as "Parameter
 =head2 State tags  =head2 State tags
   
 State tags are required to have an attribute "name", which is the symbolic  State tags are required to have an attribute "name", which is the symbolic
 name of the state and will not be directly seen by the user. The wizard is  name of the state and will not be directly seen by the user. The helper is
 required to have one state named "START", which is the state the wizard  required to have one state named "START", which is the state the helper
 will start with. By convention, this state should clearly describe what  will start with. By convention, this state should clearly describe what
 the helper will do for the user, and may also include the first information  the helper will do for the user, and may also include the first information
 entry the user needs to do for the helper.  entry the user needs to do for the helper.
Line 95  use Apache::Constants qw(:common); Line 91  use Apache::Constants qw(:common);
 use Apache::File;  use Apache::File;
 use Apache::lonxml;  use Apache::lonxml;
   
   # Register all the tags with the helper, so the helper can 
   # push and pop them
   
   my @helperTags;
   
   sub register {
       my ($namespace, @tags) = @_;
   
       for my $tag (@tags) {
           push @helperTags, [$namespace, $tag];
       }
   }
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register('Apache::lonhelper',       Apache::lonxml::register('Apache::lonhelper', 
                               ('helper', 'state'));                               ('helper'));
         register('Apache::lonhelper', ('state'));
 }  }
   
 # Since all wizards are only three levels deep (wizard tag, state tag,   # Since all helpers are only three levels deep (helper tag, state tag, 
 # substate type), it's easier and more readble to explicitly track   # substate type), it's easier and more readble to explicitly track 
 # those three things directly, rather then futz with the tag stack   # those three things directly, rather then futz with the tag stack 
 # every time.  # every time.
Line 145  sub handler { Line 155  sub handler {
     &Apache::lonxml::xmlparse($r, 'helper', $file);      &Apache::lonxml::xmlparse($r, 'helper', $file);
   
     $r->print($helper->display());      $r->print($helper->display());
     return OK;     return OK;
 }  }
   
 sub start_helper {  sub start_helper {
Line 154  sub start_helper { Line 164  sub start_helper {
     if ($target ne 'helper') {      if ($target ne 'helper') {
         return '';          return '';
     }      }
   
       for my $tagList (@helperTags) {
           Apache::lonxml::register($tagList->[0], $tagList->[1]);
       }
           
     $helper = Apache::lonhelper::helper->new($token->[2]{'title'});      $helper = Apache::lonhelper::helper->new($token->[2]{'title'});
     return '';      return '';
Line 165  sub end_helper { Line 179  sub end_helper {
     if ($target ne 'helper') {      if ($target ne 'helper') {
         return '';          return '';
     }      }
       
       for my $tagList (@helperTags) {
           Apache::lonxml::deregister($tagList->[0], $tagList->[1]);
       }
   
     return '';      return '';
 }  }
   
Line 265  sub new { Line 283  sub new {
     $self->{STATES} = {};      $self->{STATES} = {};
     $self->{DONE} = 0;      $self->{DONE} = 0;
   
       # Used by various helpers for various things; see lonparm.helper
       # for an example.
       $self->{DATA} = {};
   
     bless($self, $class);      bless($self, $class);
     return $self;      return $self;
 }  }
Line 472  sub preprocess { Line 494  sub preprocess {
     }      }
 }  }
   
   # FIXME: Document that all postprocesses must return a true value or
   # the state transition will be overridden
 sub postprocess {  sub postprocess {
     my $self = shift;      my $self = shift;
       
       # Save the state so we can roll it back if we need to.
       my $originalState = $helper->{STATE};
       my $everythingSuccessful = 1;
   
     for my $element (@{$self->{ELEMENTS}}) {      for my $element (@{$self->{ELEMENTS}}) {
         $element->postprocess();          my $result = $element->postprocess();
           if (!$result) { $everythingSuccessful = 0; }
       }
   
       # If not all the postprocesses were successful, override
       # any state transitions that may have occurred. It is the
       # responsibility of the states to make sure they have 
       # error handling in that case.
       if (!$everythingSuccessful) {
           $helper->{STATE} = $originalState;
     }      }
 }  }
   
Line 531  the helper variables, like this: Line 568  the helper variables, like this:
 =cut  =cut
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register('Apache::lonhelper::element',      &Apache::lonhelper::register('Apache::lonhelper::element',
                               ('nextstate'));                                   ('nextstate'));
 }  }
   
 # Because we use the param hash, this is often a sufficent  # Because we use the param hash, this is often a sufficent
Line 622  transition directly to the state in the Line 659  transition directly to the state in the
    </message>     </message>
   
 This will display the HTML message and transition to the <nextstate> if  This will display the HTML message and transition to the <nextstate> if
 given. The HTML will be directly inserted into the wizard, so if you don't  given. The HTML will be directly inserted into the helper, so if you don't
 want text to run together, you'll need to manually wrap the <message_text>  want text to run together, you'll need to manually wrap the <message_text>
 in <p> tags, or whatever is appropriate for your HTML.  in <p> tags, or whatever is appropriate for your HTML.
   
Line 642  no strict; Line 679  no strict;
 use strict;  use strict;
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register('Apache::lonhelper::message',      &Apache::lonhelper::register('Apache::lonhelper::message',
                               ('message', 'message_text'));                                ('message', 'message_text'));
 }  }
   
Line 690  sub postprocess { Line 727  sub postprocess {
     if (defined($self->{NEXTSTATE})) {      if (defined($self->{NEXTSTATE})) {
         $helper->changeState($self->{NEXTSTATE});          $helper->changeState($self->{NEXTSTATE});
     }      }
   
       return 1;
 }  }
 1;  1;
   
Line 755  You can mix and match methods of creatin Line 794  You can mix and match methods of creatin
 "push" onto the choice list, rather then wiping it out. (You can even   "push" onto the choice list, rather then wiping it out. (You can even 
 remove choices programmatically, but that would probably be bad form.)  remove choices programmatically, but that would probably be bad form.)
   
 FIXME: Document and implement <exec> and <condition> in the element package.  
   
 =cut  =cut
   
 no strict;  no strict;
Line 764  no strict; Line 801  no strict;
 use strict;  use strict;
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register('Apache::lonhelper::choices',      &Apache::lonhelper::register('Apache::lonhelper::choices',
                               ('choice', 'choices'));                                ('choice', 'choices'));
 }  }
   
Line 826  sub render { Line 863  sub render {
     my $result = '';      my $result = '';
   
     if ($self->{'multichoice'}) {      if ($self->{'multichoice'}) {
         $result = <<SCRIPT;          $result .= <<SCRIPT;
 <script>  <script>
     function checkall(value) {      function checkall(value) {
  for (i=0; i<document.forms.wizform.elements.length; i++) {   for (i=0; i<document.forms.wizform.elements.length; i++) {
Line 839  SCRIPT Line 876  SCRIPT
 <br />  <br />
 <input type="button" onclick="checkall(true)" value="Select All" />  <input type="button" onclick="checkall(true)" value="Select All" />
 <input type="button" onclick="checkall(false)" value="Unselect All" />  <input type="button" onclick="checkall(false)" value="Unselect All" />
 <br />  <br />&nbsp;
 BUTTONS  BUTTONS
     }      }
   
     if (defined $self->{ERROR_MSG}) {      if (defined $self->{ERROR_MSG}) {
         $result .= '<font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';          $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br />';
     }      }
   
     $result .= $buttons;      $result .= $buttons;
       
     $result .= "<table>\n\n";      $result .= "<table>\n\n";
   
     my $type = "radio";      my $type = "radio";
Line 878  sub postprocess { Line 915  sub postprocess {
     my $self = shift;      my $self = shift;
     my $chosenValue = $ENV{'form.' . $self->{'variable'} . '.forminput'};      my $chosenValue = $ENV{'form.' . $self->{'variable'} . '.forminput'};
   
       if (!$chosenValue) {
           $self->{ERROR_MSG} = "You must choose one or more choices to" .
               " continue.";
           return 0;
       }
   
       if ($self->{'multichoice'}) {
           $self->process_multiple_choices($self->{'variable'}.'.forminput',
                                           $self->{'variable'});
       }
   
     if (defined($self->{NEXTSTATE})) {      if (defined($self->{NEXTSTATE})) {
         $helper->changeState($self->{NEXTSTATE});          $helper->changeState($self->{NEXTSTATE});
     }      }
Line 889  sub postprocess { Line 937  sub postprocess {
             }              }
         }          }
     }      }
       return 1;
 }  }
 1;  1;
   
Line 931  use strict; Line 980  use strict;
 use Time::localtime;  use Time::localtime;
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register('Apache::lonhelper::date',      &Apache::lonhelper::register('Apache::lonhelper::date',
                               ('date'));                                ('date'));
 }  }
   
Line 1089  sub postprocess { Line 1138  sub postprocess {
         $checkDate->year + 1900 != $year) {          $checkDate->year + 1900 != $year) {
         $self->{ERROR_MSG} = "Can't use " . $months[$month] . " $day, $year as a "          $self->{ERROR_MSG} = "Can't use " . $months[$month] . " $day, $year as a "
             . "date because it doesn't exist. Please enter a valid date.";              . "date because it doesn't exist. Please enter a valid date.";
         return;          return 0;
     }      }
   
     $helper->{VARS}->{$var} = $chosenDate;      $helper->{VARS}->{$var} = $chosenDate;
Line 1097  sub postprocess { Line 1146  sub postprocess {
     if (defined($self->{NEXTSTATE})) {      if (defined($self->{NEXTSTATE})) {
         $helper->changeState($self->{NEXTSTATE});          $helper->changeState($self->{NEXTSTATE});
     }      }
   
       return 1;
 }  }
 1;  1;
   
Line 1151  no strict; Line 1202  no strict;
 use strict;  use strict;
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register('Apache::lonhelper::resource',      &Apache::lonhelper::register('Apache::lonhelper::resource',
                               ('resource', 'filterfunc',                                 ('resource', 'filterfunc', 
                                'choicefunc', 'valuefunc'));                                 'choicefunc', 'valuefunc'));
 }  }
Line 1304  sub postprocess { Line 1355  sub postprocess {
     if (defined($self->{NEXTSTATE})) {      if (defined($self->{NEXTSTATE})) {
         $helper->changeState($self->{NEXTSTATE});          $helper->changeState($self->{NEXTSTATE});
     }      }
   
       return 1;
 }  }
   
 1;  1;
Line 1330  use strict; Line 1383  use strict;
   
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register('Apache::lonhelper::student',      &Apache::lonhelper::register('Apache::lonhelper::student',
                               ('student'));                                ('student'));
 }  }
   
Line 1434  BUTTONS Line 1487  BUTTONS
     return $result;      return $result;
 }  }
   
   sub postprocess {
       my $self = shift;
   
       my $result = $ENV{'form.' . $self->{'variable'} . '.forminput'};
       if (!$result) {
           $self->{ERROR_MSG} = 'You must choose at least one student '.
               'to continue.';
           return 0;
       }
   
       if ($self->{'multichoice'}) {
           $self->process_multiple_choices($self->{'variable'}.'.forminput',
                                           $self->{'variable'});
       }
       if (defined($self->{NEXTSTATE})) {
           $helper->changeState($self->{NEXTSTATE});
       }
   
       return 1;
   }
   
 1;  1;
   
 package Apache::lonhelper::files;  package Apache::lonhelper::files;
Line 1473  no strict; Line 1547  no strict;
 use strict;  use strict;
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register('Apache::lonhelper::files',      &Apache::lonhelper::register('Apache::lonhelper::files',
                               ('files', 'filechoice', 'filefilter'));                                   ('files', 'filechoice', 'filefilter'));
 }  }
   
 sub new {  sub new {
Line 1579  BUTTONS Line 1653  BUTTONS
   
     $result .= $buttons;      $result .= $buttons;
   
       if (defined $self->{ERROR_MSG}) {
           $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />';
       }
   
     $result .= '<table border="0" cellpadding="1" cellspacing="1">';      $result .= '<table border="0" cellpadding="1" cellspacing="1">';
   
     # Keeps track if there are no choices, prints appropriate error      # Keeps track if there are no choices, prints appropriate error
Line 1621  BUTTONS Line 1699  BUTTONS
   
 sub postprocess {  sub postprocess {
     my $self = shift;      my $self = shift;
       my $result = $ENV{'form.' . $self->{'variable'} . '.forminput'};
       if (!$result) {
           $self->{ERROR_MSG} = 'You must choose at least one file '.
               'to continue.';
           return 0;
       }
   
     if ($self->{'multichoice'}) {      if ($self->{'multichoice'}) {
         $self->process_multiple_choices($self->{'variable'}.'.forminput',          $self->process_multiple_choices($self->{'variable'}.'.forminput',
                                         $self->{'variable'});                                          $self->{'variable'});
Line 1628  sub postprocess { Line 1713  sub postprocess {
     if (defined($self->{NEXTSTATE})) {      if (defined($self->{NEXTSTATE})) {
         $helper->changeState($self->{NEXTSTATE});          $helper->changeState($self->{NEXTSTATE});
     }      }
   
       return 1;
 }  }
   
 1;  1;
   
   package Apache::lonhelper::general;
   
   =pod
   
   =head2 General-purpose tag: <exec>
   
   The contents of the exec tag are executed as Perl code, not inside a 
   safe space, so the full range of $ENV and such is available. The code
   will be executed as a subroutine wrapped with the following code:
   
   "sub { my $helper = shift; my $state = shift;" and
   
   "}"
   
   The return value is ignored.
   
   $helper is the helper object. Feel free to add methods to the helper
   object to support whatever manipulation you may need to do (for instance,
   overriding the form location if the state is the final state; see 
   lonparm.helper for an example).
   
   $state is the $paramHash that has currently been generated and may
   be manipulated by the code in exec. Note that the $state is not yet
   an actual state B<object>, it is just a hash, so do not expect to
   be able to call methods on it.
   
   =cut
   
   BEGIN {
       &Apache::lonhelper::register('Apache::lonhelper::general',
                                    'exec', 'condition', 'clause');
   }
   
   sub start_exec {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
   
       if ($target ne 'helper') {
           return '';
       }
       
       my $code = &Apache::lonxml::get_all_text('/exec', $parser);
       
       $code = eval ('sub { my $helper = shift; my $state = shift; ' .
           $code . "}");
       &$code($helper, $paramHash);
   }
   
   sub end_exec { return ''; }
   
   =pod
   
   =head2 General-purpose tag: <condition>
   
   The <condition> tag allows you to mask out parts of the helper code
   depending on some programatically determined condition. The condition
   tag contains a tag <clause> which contains perl code that when wrapped
   with "sub { my $helper = shift; my $state = shift; " and "}", returns
   a true value if the XML in the condition should be evaluated as a normal
   part of the helper, or false if it should be completely discarded.
   
   The <clause> tag must be the first sub-tag of the <condition> tag or
   it will not work as expected.
   
   =cut
   
   # The condition tag just functions as a marker, it doesn't have
   # to "do" anything. Technically it doesn't even have to be registered
   # with the lonxml code, but I leave this here to be explicit about it.
   sub start_condition { return ''; }
   sub end_condition { return ''; }
   
   sub start_clause {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
   
       if ($target ne 'helper') {
           return '';
       }
       
       my $clause = Apache::lonxml::get_all_text('/clause', $parser);
       $clause = eval('sub { my $helper = shift; my $state = shift; '
           . $clause . '}');
       if (!&$clause($helper, $paramHash)) {
           # Discard all text until the /condition.
           &Apache::lonxml::get_all_text('/condition', $parser);
       }
   }
   
   sub end_clause { return ''; }
   
   1;
   
 __END__  __END__
   
Removed from v.1.5  
changed lines
  Added in v.1.9

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>