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

Diff for /loncom/interface/lonhelper.pm between versions 1.25 and 1.30

version 1.25, 2003/05/08 19:52:43 version 1.30, 2003/05/15 16:14:52
Line 234  sub real_handler { Line 234  sub real_handler {
     my $file;      my $file;
     read $fh, $file, 100000000;      read $fh, $file, 100000000;
   
   
     # Send header, don't cache this page      # Send header, don't cache this page
     if ($r->header_only) {      if ($r->header_only) {
         if ($ENV{'browser.mathml'}) {          if ($ENV{'browser.mathml'}) {
Line 343  sub new { Line 344  sub new {
   
     $self->{TITLE} = shift;      $self->{TITLE} = shift;
           
     Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING});  
   
     # If there is a state from the previous form, use that. If there is no      # If there is a state from the previous form, use that. If there is no
     # state, use the start state parameter.      # state, use the start state parameter.
     if (defined $ENV{"form.CURRENT_STATE"})      if (defined $ENV{"form.CURRENT_STATE"})
Line 460  sub declareVar { Line 459  sub declareVar {
   
     my $envname = 'form.' . $var . '.forminput';      my $envname = 'form.' . $var . '.forminput';
     if (defined($ENV{$envname})) {      if (defined($ENV{$envname})) {
         $self->{VARS}->{$var} = $ENV{$envname};          if (ref($ENV{$envname})) {
               $self->{VARS}->{$var} = join('|||', @{$ENV{$envname}});
           } else {
               $self->{VARS}->{$var} = $ENV{$envname};
           }
     }      }
 }  }
   
Line 544  sub display { Line 547  sub display {
     </head>      </head>
     $bodytag      $bodytag
 HEADER  HEADER
     if (!$state->overrideForm()) { $result.="<form name='helpform' method='GET'>"; }      if (!$state->overrideForm()) { $result.="<form name='helpform' method='POST'>"; }
     $result .= <<HEADER;      $result .= <<HEADER;
         <table border="0"><tr><td>          <table border="0"><tr><td>
         <h2><i>$stateTitle</i></h2>          <h2><i>$stateTitle</i></h2>
 HEADER  HEADER
   
       $result .= "<table><tr><td rowspan='2' valign='top'>";
   
     if (!$state->overrideForm()) {      if (!$state->overrideForm()) {
         $result .= $self->_saveVars();          $result .= $self->_saveVars();
     }      }
     $result .= $state->render() . "<p>&nbsp;</p>";      $result .= $state->render();
   
       $result .= "</td><td valign='top'>";
   
       # Warning: Copy and pasted from below, because it's too much trouble to 
       # turn this into a subroutine
       if (!$state->overrideForm()) {
           $result .= '<center>';
           if ($self->{STATE} ne $self->{START_STATE}) {
               #$result .= '<input name="SUBMIT" type="submit" value="&lt;- Previous" />&nbsp;&nbsp;';
           }
           if ($self->{DONE}) {
               my $returnPage = $self->{RETURN_PAGE};
               $result .= "<a href=\"$returnPage\">End Helper</a>";
           }
           else {
               $result .= '<nobr><input name="back" type="button" ';
               $result .= 'value="&lt;- Previous" onclick="history.go(-1)" /> ';
               $result .= '<input name="SUBMIT" type="submit" value="Next -&gt;" /></nobr>&nbsp;';
           }
           $result .= "</center>\n";
       }
   
       $result .= "</td></tr><tr><td valign='bottom'>";
   
       # Warning: Copy and pasted from above, because it's too much trouble to 
       # turn this into a subroutine
     if (!$state->overrideForm()) {      if (!$state->overrideForm()) {
         $result .= '<center>';          $result .= '<center>';
         if ($self->{STATE} ne $self->{START_STATE}) {          if ($self->{STATE} ne $self->{START_STATE}) {
Line 565  HEADER Line 595  HEADER
             $result .= "<a href=\"$returnPage\">End Helper</a>";              $result .= "<a href=\"$returnPage\">End Helper</a>";
         }          }
         else {          else {
             $result .= '<input name="back" type="button" ';              $result .= '<nobr><input name="back" type="button" ';
             $result .= 'value="&lt;- Previous" onclick="history.go(-1)" /> ';              $result .= 'value="&lt;- Previous" onclick="history.go(-1)" /> ';
             $result .= '<input name="SUBMIT" type="submit" value="Next -&gt;" />';              $result .= '<input name="SUBMIT" type="submit" value="Next -&gt;" /></nobr>';
         }          }
         $result .= "</center>\n";          $result .= "</center>\n";
     }      }
Line 576  HEADER Line 606  HEADER
     #    $result .= "|$key| -> " . $self->{VARS}->{$key} . "<br />";      #    $result .= "|$key| -> " . $self->{VARS}->{$key} . "<br />";
     #}      #}
   
       $result .= "</td></tr></table>";
   
     $result .= <<FOOTER;      $result .= <<FOOTER;
               </td>                </td>
             </tr>              </tr>
Line 688  sub render { Line 720  sub render {
     for my $element (@{$self->{ELEMENTS}}) {      for my $element (@{$self->{ELEMENTS}}) {
         push @results, $element->render();          push @results, $element->render();
     }      }
   
     return join("\n", @results);      return join("\n", @results);
 }  }
   
Line 700  package Apache::lonhelper::element; Line 733  package Apache::lonhelper::element;
   
 =head2 Element Base Class  =head2 Element Base Class
   
 The Apache::lonhelper::element base class provides support methods for  The Apache::lonhelper::element base class provides support for elements
 the elements to use, such as a multiple value processer.  and defines some generally useful tags for use in elements.
   
 B<Methods>:  
   
 =over 4  
   
 =item * process_multiple_choices(formName, varName): Process the form   
 element named "formName" and place the selected items into the helper   
 variable named varName. This is for things like checkboxes or   
 multiple-selection listboxes where the user can select more then   
 one entry. The selected entries are delimited by triple pipes in   
 the helper variables, like this:    
   
  CHOICE_1|||CHOICE_2|||CHOICE_3  
   
 =back  
   
 B<finalcode tag>  B<finalcode tag>
   
Line 830  sub overrideForm { Line 848  sub overrideForm {
     return 0;      return 0;
 }  }
   
 sub process_multiple_choices {  
     my $self = shift;  
     my $formname = shift;  
     my $var = shift;  
   
     # Must extract values from data directly, as there  
     # may be more then one.  
     my @values;  
     for my $formparam (split (/&/, $ENV{QUERY_STRING})) {  
         my ($name, $value) = split(/=/, $formparam);  
         if ($name ne $formname) {  
             next;  
         }  
         $value =~ tr/+/ /;  
         $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;  
         push @values, $value;  
     }  
     $helper->{VARS}->{$var} = join('|||', @values);  
       
     return;  
 }  
   
 1;  1;
   
 package Apache::lonhelper::message;  package Apache::lonhelper::message;
Line 960  the result is stored in. Line 956  the result is stored in.
 <choices> takes an attribute "multichoice" which, if set to a true  <choices> takes an attribute "multichoice" which, if set to a true
 value, will allow the user to select multiple choices.  value, will allow the user to select multiple choices.
   
   <choices> takes an attribute "allowempty" which, if set to a true 
   value, will allow the user to select none of the choices without raising
   an error message.
   
 B<SUB-TAGS>  B<SUB-TAGS>
   
 <choices> can have the following subtags:  <choices> can have the following subtags:
Line 1049  sub start_choices { Line 1049  sub start_choices {
     $paramHash->{'variable'} = $token->[2]{'variable'} if (!defined($paramHash->{'variable'}));      $paramHash->{'variable'} = $token->[2]{'variable'} if (!defined($paramHash->{'variable'}));
     $helper->declareVar($paramHash->{'variable'});      $helper->declareVar($paramHash->{'variable'});
     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};      $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
       $paramHash->{'allowempty'} = $token->[2]{'allowempty'};
     $paramHash->{CHOICES} = [];      $paramHash->{CHOICES} = [];
     return '';      return '';
 }  }
Line 1193  sub postprocess { Line 1194  sub postprocess {
     my $self = shift;      my $self = shift;
     my $chosenValue = $ENV{'form.' . $self->{'variable'} . '.forminput'};      my $chosenValue = $ENV{'form.' . $self->{'variable'} . '.forminput'};
   
     if (!defined($chosenValue)) {      if (!defined($chosenValue) && !$self->{'allowempty'}) {
         $self->{ERROR_MSG} = "You must choose one or more choices to" .          $self->{ERROR_MSG} = "You must choose one or more choices to" .
             " continue.";              " continue.";
         return 0;          return 0;
     }      }
   
     if ($self->{'multichoice'}) {      if (ref($chosenValue)) {
         $self->process_multiple_choices($self->{'variable'}.'.forminput',          $helper->{VARS}->{$self->{'variable'}} = join('|||', @$chosenValue);
                                         $self->{'variable'});  
     }      }
   
     if (defined($self->{NEXTSTATE})) {      if (defined($self->{NEXTSTATE})) {
Line 1447  variable stores the results. It also tak Line 1447  variable stores the results. It also tak
 which controls whether the user can select more then one resource. The   which controls whether the user can select more then one resource. The 
 "toponly" attribute controls whether the resource display shows just the  "toponly" attribute controls whether the resource display shows just the
 resources in that sequence, or recurses into all sub-sequences, defaulting  resources in that sequence, or recurses into all sub-sequences, defaulting
 to false.  to false. The "suppressEmptySequences" attribute reflects the 
   suppressEmptySequences argument to the render routine, which will cause
   folders that have all of their contained resources filtered out to also
   be filtered out.
   
 B<SUB-TAGS>  B<SUB-TAGS>
   
Line 1508  sub start_resource { Line 1511  sub start_resource {
     $paramHash->{'variable'} = $token->[2]{'variable'};      $paramHash->{'variable'} = $token->[2]{'variable'};
     $helper->declareVar($paramHash->{'variable'});      $helper->declareVar($paramHash->{'variable'});
     $paramHash->{'multichoice'} = $token->[2]{'multichoice'};      $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
       $paramHash->{'suppressEmptySequences'} = $token->[2]{'suppressEmptySequences'};
     $paramHash->{'toponly'} = $token->[2]{'toponly'};      $paramHash->{'toponly'} = $token->[2]{'toponly'};
     return '';      return '';
 }  }
Line 1676  BUTTONS Line 1680  BUTTONS
                                        'showParts' => 0,                                         'showParts' => 0,
                                        'filterFunc' => $filterFunc,                                         'filterFunc' => $filterFunc,
                                        'resource_no_folder_link' => 1,                                         'resource_no_folder_link' => 1,
                                          'suppressEmptySequences' => $self->{'suppressEmptySequences'},
                                        'iterator_map' => $mapUrl }                                         'iterator_map' => $mapUrl }
                                        );                                         );
   
Line 1687  BUTTONS Line 1692  BUTTONS
 sub postprocess {  sub postprocess {
     my $self = shift;      my $self = shift;
   
     if ($self->{'multichoice'}) {  
         $self->process_multiple_choices($self->{'variable'}.'.forminput',  
                                         $self->{'variable'});  
     }  
   
     if ($self->{'multichoice'} && !$helper->{VARS}->{$self->{'variable'}}) {      if ($self->{'multichoice'} && !$helper->{VARS}->{$self->{'variable'}}) {
         $self->{ERROR_MSG} = 'You must choose at least one resource to continue.';          $self->{ERROR_MSG} = 'You must choose at least one resource to continue.';
         return 0;          return 0;
Line 1849  sub postprocess { Line 1849  sub postprocess {
         return 0;          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 2137  sub postprocess { Line 2133  sub postprocess {
         return 0;          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 2357  sub end_eval { Line 2349  sub end_eval {
   
 1;  1;
   
   package Apache::lonhelper::final;
   
   =pod
   
   =head2 Element: final
   
   <final> is a special element that works with helpers that use the <finalcode>
   tag. It goes through all the states and elements, executing the <finalcode>
   snippets and collecting the results. Finally, it takes the user out of the
   helper, going to a provided page.
   
   =cut
   
   no strict;
   @ISA = ("Apache::lonhelper::element");
   use strict;
   
   BEGIN {
       &Apache::lonhelper::register('Apache::lonhelper::final',
                                    ('final', 'exitpage'));
   }
   
   sub new {
       my $ref = Apache::lonhelper::element->new();
       bless($ref);
   }
   
   sub start_final { return ''; }
   
   sub end_final {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
   
       if ($target ne 'helper') {
           return '';
       }
   
       Apache::lonhelper::final->new();
      
       return '';
   }
   
   sub start_exitpage {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
   
       if ($target ne 'helper') {
           return '';
       }
   
       $paramHash->{EXIT_PAGE} = &Apache::lonxml::get_all_text('/exitpage',
                                                               $parser);
   
       return '';
   }
   
   sub end_exitpage { return ''; }
   
   sub render {
       my $self = shift;
   
       my @results;
   
       # Collect all the results
       for my $stateName (keys %{$helper->{STATES}}) {
           my $state = $helper->{STATES}->{$stateName};
           
           for my $element (@{$state->{ELEMENTS}}) {
               if (defined($element->{FINAL_CODE})) {
                   # Compile the code.
                   my $code = 'sub { my $helper = shift; ' . $element->{FINAL_CODE} .
                       '}';
                   $code = eval($code);
                   die 'Error while executing final code for element with var ' .
                       $element->{'variable'} . ', Perl said: ' . $@ if $@;
   
                   my $result = &$code($helper);
                   if ($result) {
                       push @results, $result;
                   }
               }
           }
       }
   
       if (scalar(@results) == 0) {
           return '';
       }
   
       my $result = "<ul>\n";
       for my $re (@results) {
           $result .= '    <li>' . $re . "</li>\n";
       }
       return $result . '</ul>';
   }
   
   1;
   
 package Apache::lonhelper::parmwizfinal;  package Apache::lonhelper::parmwizfinal;
   
 # This is the final state for the parmwizard. It is not generally useful,  # This is the final state for the parmwizard. It is not generally useful,
Line 2404  sub render { Line 2491  sub render {
                         'due_date' => "0_duedate",                          'due_date' => "0_duedate",
                         'answer_date' => "0_answerdate");                          'answer_date' => "0_answerdate");
           
     my $result = "<form name='helpform' method='get' action='/adm/parmset'>\n";  
     $result .= '<p>Confirm that this information is correct, then click &quot;Finish Wizard&quot; to complete setting the parameter.<ul>';  
     my $affectedResourceId = "";      my $affectedResourceId = "";
     my $parm_name = $parmTypeHash{$vars->{ACTION_TYPE}};      my $parm_name = $parmTypeHash{$vars->{ACTION_TYPE}};
     my $level = "";      my $level = "";
           my $resourceString;
     # Print the type of manipulation:      my $symb;
     $result .= '<li>Setting the <b>' . $dateTypeHash{$vars->{ACTION_TYPE}}      my $paramlevel;
                . "</b></li>\n";  
     if ($vars->{ACTION_TYPE} eq 'due_date' ||   
         $vars->{ACTION_TYPE} eq 'answer_date') {  
         # for due dates, we default to "date end" type entries  
         $result .= "<input type='hidden' name='recent_date_end' " .  
             "value='" . $vars->{PARM_DATE} . "' />\n";  
         $result .= "<input type='hidden' name='pres_value' " .   
             "value='" . $vars->{PARM_DATE} . "' />\n";  
         $result .= "<input type='hidden' name='pres_type' " .  
             "value='date_end' />\n";  
     } elsif ($vars->{ACTION_TYPE} eq 'open_date') {  
         $result .= "<input type='hidden' name='recent_date_start' ".  
             "value='" . $vars->{PARM_DATE} . "' />\n";  
         $result .= "<input type='hidden' name='pres_value' " .  
             "value='" . $vars->{PARM_DATE} . "' />\n";  
         $result .= "<input type='hidden' name='pres_type' " .  
             "value='date_start' />\n";  
     }   
       
     # Print the granularity, depending on the action      # Print the granularity, depending on the action
     if ($vars->{GRANULARITY} eq 'whole_course') {      if ($vars->{GRANULARITY} eq 'whole_course') {
         $result .= '<li>for <b>all resources in the course</b></li>';          $resourceString .= '<li>for <b>all resources in the course</b></li>';
         $level = 9; # general course, see lonparmset.pm perldoc          $level = 9; # general course, see lonparmset.pm perldoc
         $affectedResourceId = "0.0";          $affectedResourceId = "0.0";
           $symb = 'a';
           $paramlevel = 'general';
     } elsif ($vars->{GRANULARITY} eq 'map') {      } elsif ($vars->{GRANULARITY} eq 'map') {
         my $navmap = Apache::lonnavmaps::navmap->new(          my $navmap = Apache::lonnavmaps::navmap->new(
                            $ENV{"request.course.fn"}.".db",                             $ENV{"request.course.fn"}.".db",
                            $ENV{"request.course.fn"}."_parms.db", 0, 0);                             $ENV{"request.course.fn"}."_parms.db", 0, 0);
         my $res = $navmap->getById($vars->{RESOURCE_ID});          my $res = $navmap->getById($vars->{RESOURCE_ID});
         my $title = $res->compTitle();          my $title = $res->compTitle();
           $symb = $res->symb();
         $navmap->untieHashes();          $navmap->untieHashes();
         $result .= "<li>for the map named <b>$title</b></li>";          $resourceString .= "<li>for the map named <b>$title</b></li>";
         $level = 8;          $level = 8;
         $affectedResourceId = $vars->{RESOURCE_ID};          $affectedResourceId = $vars->{RESOURCE_ID};
           $paramlevel = 'map';
     } else {      } else {
         my $navmap = Apache::lonnavmaps::navmap->new(          my $navmap = Apache::lonnavmaps::navmap->new(
                            $ENV{"request.course.fn"}.".db",                             $ENV{"request.course.fn"}.".db",
                            $ENV{"request.course.fn"}."_parms.db", 0, 0);                             $ENV{"request.course.fn"}."_parms.db", 0, 0);
         my $res = $navmap->getById($vars->{RESOURCE_ID});          my $res = $navmap->getById($vars->{RESOURCE_ID});
           $symb = $res->symb();
         my $title = $res->compTitle();          my $title = $res->compTitle();
         $navmap->untieHashes();          $navmap->untieHashes();
         $result .= "<li>for the resource named <b>$title</b></li>";          $resourceString .= "<li>for the resource named <b>$title</b></li>";
         $level = 7;          $level = 7;
         $affectedResourceId = $vars->{RESOURCE_ID};          $affectedResourceId = $vars->{RESOURCE_ID};
           $paramlevel = 'full';
     }      }
   
       my $result = "<form name='helpform' method='get' action='/adm/parmset#$affectedResourceId&$parm_name&$level'>\n";
       $result .= '<p>Confirm that this information is correct, then click &quot;Finish Wizard&quot; to complete setting the parameter.<ul>';
       
       # Print the type of manipulation:
       $result .= '<li>Setting the <b>' . $dateTypeHash{$vars->{ACTION_TYPE}}
                  . "</b></li>\n";
       if ($vars->{ACTION_TYPE} eq 'due_date' || 
           $vars->{ACTION_TYPE} eq 'answer_date') {
           # for due dates, we default to "date end" type entries
           $result .= "<input type='hidden' name='recent_date_end' " .
               "value='" . $vars->{PARM_DATE} . "' />\n";
           $result .= "<input type='hidden' name='pres_value' " . 
               "value='" . $vars->{PARM_DATE} . "' />\n";
           $result .= "<input type='hidden' name='pres_type' " .
               "value='date_end' />\n";
       } elsif ($vars->{ACTION_TYPE} eq 'open_date') {
           $result .= "<input type='hidden' name='recent_date_start' ".
               "value='" . $vars->{PARM_DATE} . "' />\n";
           $result .= "<input type='hidden' name='pres_value' " .
               "value='" . $vars->{PARM_DATE} . "' />\n";
           $result .= "<input type='hidden' name='pres_type' " .
               "value='date_start' />\n";
       } 
   
       $result .= $resourceString;
       
     # Print targets      # Print targets
     if ($vars->{TARGETS} eq 'course') {      if ($vars->{TARGETS} eq 'course') {
         $result .= '<li>for <b>all students in course</b></li>';          $result .= '<li>for <b>all students in course</b></li>';
Line 2470  sub render { Line 2569  sub render {
     } else {      } else {
         # FIXME: This is probably wasteful! Store the name!          # FIXME: This is probably wasteful! Store the name!
         my $classlist = Apache::loncoursedata::get_classlist();          my $classlist = Apache::loncoursedata::get_classlist();
         my $name = $classlist->{$vars->{USER_NAME}}->[6];          my $username = $vars->{USER_NAME};
           # Chop off everything after the last colon (section)
           $username = substr($username, 0, rindex($username, ':'));
           my $name = $classlist->{$username}->[6];
         $result .= "<li>for <b>$name</b></li>";          $result .= "<li>for <b>$name</b></li>";
         $level -= 6;          $level -= 6;
         my ($uname, $udom) = split /:/, $vars->{USER_NAME};          my ($uname, $udom) = split /:/, $vars->{USER_NAME};
Line 2488  sub render { Line 2590  sub render {
     # print pres_marker      # print pres_marker
     $result .= "\n<input type='hidden' name='pres_marker'" .      $result .= "\n<input type='hidden' name='pres_marker'" .
         " value='$affectedResourceId&$parm_name&$level' />\n";          " value='$affectedResourceId&$parm_name&$level' />\n";
       
       # Make the table appear
       $result .= "\n<input type='hidden' value='true' name='prevvisit' />";
       $result .= "\n<input type='hidden' value='all' name='pschp' />";
       $result .= "\n<input type='hidden' value='$symb' name='pssymb' />";
       $result .= "\n<input type='hidden' value='$paramlevel' name='parmlev' />";
   
     $result .= "<br /><br /><center><input type='submit' value='Finish Helper' /></center></form>\n";      $result .= "<br /><br /><center><input type='submit' value='Finish Helper' /></center></form>\n";
   
Removed from v.1.25  
changed lines
  Added in v.1.30

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