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

Diff for /loncom/interface/lonhelper.pm between versions 1.26 and 1.28

version 1.26, 2003/05/08 20:10:49 version 1.28, 2003/05/14 18:58:21
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>
Line 681  sub addElement { Line 684  sub addElement {
     push @{$self->{ELEMENTS}}, $element;      push @{$self->{ELEMENTS}}, $element;
 }  }
   
   use Data::Dumper;
 sub render {  sub render {
     my $self = shift;      my $self = shift;
     my @results = ();      my @results = ();
Line 688  sub render { Line 692  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 705  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 820  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 1204  sub postprocess { Line 1172  sub postprocess {
         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 1692  BUTTONS Line 1659  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 1854  sub postprocess { Line 1816  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 2142  sub postprocess { Line 2100  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 2362  sub end_eval { Line 2316  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 2409  sub render { Line 2458  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 2475  sub render { Line 2536  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 2493  sub render { Line 2557  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.26  
changed lines
  Added in v.1.28

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