[LON-CAPA-cvs] cvs: loncom /interface lonhelper.pm

bowersj2 lon-capa-cvs@mail.lon-capa.org
Thu, 08 May 2003 19:52:44 -0000


This is a MIME encoded message

--bowersj21052423564
Content-Type: text/plain

bowersj2		Thu May  8 15:52:44 2003 EDT

  Modified files:              
    /loncom/interface	lonhelper.pm 
  Log:
  * Fixed heisenbug that caused wierd stuff to happen if the handler
    tried to access file-scoped variables. See lengthy comment at the
    beginning of the commit message for a discussion; feel free to discuss
    it with me if it still doesn't make sense. (I think this may have had 
    something to do with the global variable troubles in the past.)
  
  * Added "finalcode" and "defaultvalue" tags, intended for use in the
    course initialization helper. <choices> now respects <defaultvalue>.
  
  * If there are fewer then five choices in a multi-choice <choice>, don't
    display the "Select All" and "Unselect All" buttons, as they are 
    visually clumsy.
  
  
  
  
--bowersj21052423564
Content-Type: text/plain
Content-Disposition: attachment; filename="bowersj2-20030508155244.txt"

Index: loncom/interface/lonhelper.pm
diff -u loncom/interface/lonhelper.pm:1.24 loncom/interface/lonhelper.pm:1.25
--- loncom/interface/lonhelper.pm:1.24	Thu May  8 15:17:31 2003
+++ loncom/interface/lonhelper.pm	Thu May  8 15:52:43 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # .helper XML handler to implement the LON-CAPA helper
 #
-# $Id: lonhelper.pm,v 1.24 2003/05/08 19:17:31 sakharuk Exp $
+# $Id: lonhelper.pm,v 1.25 2003/05/08 19:52:43 bowersj2 Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -193,10 +193,38 @@
 # end of the element tag is located.
 my $paramHash; 
 
+# Note from Jeremy 5-8-2003: It is *vital* that the real handler be called
+# as a subroutine from the handler, or very mysterious things might happen.
+# I don't know exactly why, but it seems that the scope where the Apache
+# server enters the perl handler is treated differently from the rest of
+# the handler. This also seems to manifest itself in the debugger as entering
+# the perl handler in seemingly random places (sometimes it starts in the
+# compiling phase, sometimes in the handler execution phase where it runs
+# the code and stepping into the "1;" the module ends with goes into the handler,
+# sometimes starting directly with the handler); I think the cause is related.
+# In the debugger, this means that breakpoints are ignored until you step into
+# a function and get out of what must be a "faked up scope" in the Apache->
+# mod_perl connection. In this code, it was manifesting itself in the existence
+# of two seperate file-scoped $helper variables, one set to the value of the
+# helper in the helper constructor, and one referenced by the handler on the
+# "$helper->process()" line. The second was therefore never set, and was still
+# undefined when I tried to call process on it.
+# By pushing the "real handler" down into the "real scope", everybody except the 
+# actual handler function directly below this comment gets the same $helper and
+# everybody is happy.
+# The upshot of all of this is that for safety when a handler is  using 
+# file-scoped variables in LON-CAPA, the handler should be pushed down one 
+# call level, as I do here, to ensure that the top-level handler function does
+# not get a different file scope from the rest of the code.
+sub handler {
+    my $r = shift;
+    return real_handler($r);
+}
+
 # For debugging purposes, one can send a second parameter into this
 # function, the 'uri' of the helper you wish to have rendered, and
 # call this from other handlers.
-sub handler {
+sub real_handler {
     my $r = shift;
     my $uri = shift;
     if (!defined($uri)) { $uri = $r->uri(); }
@@ -315,6 +343,8 @@
 
     $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
     # state, use the start state parameter.
     if (defined $ENV{"form.CURRENT_STATE"})
@@ -326,8 +356,6 @@
 	$self->{STATE} = "START";
     }
 
-    Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING});
-
     $self->{TOKEN} = $ENV{'form.TOKEN'};
     # If a token was passed, we load that in. Otherwise, we need to create a 
     # new storage file
@@ -690,11 +718,38 @@
 
 =back
 
+B<finalcode tag>
+
+Each element can contain a "finalcode" tag that, when the special FINAL
+helper state is used, will be executed, surrounded by "sub { my $helper = shift;"
+and "}". It is expected to return a string describing what it did, which 
+may be an empty string. See course initialization helper for an example. This is
+generally intended for helpers like the course initialization helper, which consist
+of several panels, each of which is performing some sort of bite-sized functionality.
+
+B<defaultvalue tag>
+
+Each element that accepts user input can contain a "defaultvalue" tag that,
+when surrounded by "sub { my $helper = shift; my $state = shift; " and "}",
+will form a subroutine that when called will provide a default value for
+the element. How this value is interpreted by the element is specific to
+the element itself, and possibly the settings the element has (such as 
+multichoice vs. single choice for <choices> tags). 
+
+This is also intended for things like the course initialization wizard, where the
+user is setting various parameters. By correctly grabbing current settings 
+and including them into the helper, it allows the user to come back to the
+helper later and re-execute it, without needing to worry about overwriting
+some setting accidentally.
+
+Again, see the course initialization helper for examples.
+
 =cut
 
 BEGIN {
     &Apache::lonhelper::register('Apache::lonhelper::element',
-                                 ('nextstate'));
+                                 ('nextstate', 'finalcode',
+                                  'defaultvalue'));
 }
 
 # Because we use the param hash, this is often a sufficent
@@ -729,6 +784,36 @@
 
 sub end_nextstate { return ''; }
 
+sub start_finalcode {
+    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
+
+    if ($target ne 'helper') {
+        return '';
+    }
+    
+    $paramHash->{FINAL_CODE} = &Apache::lonxml::get_all_text('/finalcode',
+                                                             $parser);
+    return '';
+}
+
+sub end_finalcode { return ''; }
+
+sub start_defaultvalue {
+    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
+
+    if ($target ne 'helper') {
+        return '';
+    }
+    
+    $paramHash->{DEFAULT_VALUE} = &Apache::lonxml::get_all_text('/defaultvalue',
+                                                             $parser);
+    $paramHash->{DEFAULT_VALUE} = 'sub { my $helper = shift; my $state = shift;' .
+        $paramHash->{DEFAULT_VALUE} . '}';
+    return '';
+}
+
+sub end_defaultvalue { return ''; }
+
 sub preprocess {
     return 1;
 }
@@ -924,6 +1009,18 @@
 "push" onto the choice list, rather then wiping it out. (You can even 
 remove choices programmatically, but that would probably be bad form.)
 
+B<defaultvalue support>
+
+Choices supports default values both in multichoice and single choice mode.
+In single choice mode, have the defaultvalue tag's function return the 
+computer value of the box you want checked. If the function returns a value
+that does not correspond to any of the choices, the default behavior of selecting
+the first choice will be preserved.
+
+For multichoice, return a string with the computer values you want checked,
+delimited by triple pipes. Note this matches how the result of the <choices>
+tag is stored in the {VARS} hash.
+
 =cut
 
 no strict;
@@ -1007,6 +1104,11 @@
     }
 </script>
 SCRIPT
+    }
+
+    # Only print "select all" and "unselect all" if there are five or
+    # more choices; fewer then that and it looks silly.
+    if ($self->{'multichoice'} && scalar(@{$self->{CHOICES}}) > 4) {
         $buttons = <<BUTTONS;
 <br />
 <input type="button" onclick="checkall(true, '$var')" value="Select All" />
@@ -1023,18 +1125,52 @@
     
     $result .= "<table>\n\n";
 
+    my %checkedChoices;
+    my $checkedChoicesFunc;
+
+    if (defined($self->{DEFAULT_VALUE})) {
+        $checkedChoicesFunc = eval ($self->{DEFAULT_VALUE});
+        die 'Error in default value code for variable ' . 
+            {'variable'} . ', Perl said:' . $@ if $@;
+    } else {
+        $checkedChoicesFunc = sub { return ''; };
+    }
+
+    # Process which choices should be checked.
+    if ($self->{'multichoice'}) {
+        for my $selectedChoice (split(/\|\|\|/, (&$checkedChoicesFunc($helper, $self)))) {
+            $checkedChoices{$selectedChoice} = 1;
+        }
+    } else {
+        # single choice
+        my $selectedChoice = &$checkedChoicesFunc($helper, $self);
+        
+        my $foundChoice = 0;
+        
+        # check that the choice is in the list of choices.
+        for my $choice (@{$self->{CHOICES}}) {
+            if ($choice->[1] eq $selectedChoice) {
+                $checkedChoices{$choice->[1]} = 1;
+                $foundChoice = 1;
+            }
+        }
+        
+        # If we couldn't find the choice, pick the first one 
+        if (!$foundChoice) {
+            $checkedChoices{$self->{CHOICES}->[0]->[1]} = 1;
+        }
+    }
+
     my $type = "radio";
     if ($self->{'multichoice'}) { $type = 'checkbox'; }
-    my $checked = 0;
     foreach my $choice (@{$self->{CHOICES}}) {
         $result .= "<tr>\n<td width='20'>&nbsp;</td>\n";
         $result .= "<td valign='top'><input type='$type' name='$var.forminput'"
             . "' value='" . 
             HTML::Entities::encode($choice->[1]) 
             . "'";
-        if (!$self->{'multichoice'} && !$checked) {
+        if ($checkedChoices{$choice->[1]}) {
             $result .= " checked ";
-            $checked = 1;
         }
         my $choiceLabel = $choice->[0];
         if ($choice->[4]) {  # if we need to evaluate this choice
@@ -1057,7 +1193,7 @@
     my $self = shift;
     my $chosenValue = $ENV{'form.' . $self->{'variable'} . '.forminput'};
 
-    if (!$chosenValue) {
+    if (!defined($chosenValue)) {
         $self->{ERROR_MSG} = "You must choose one or more choices to" .
             " continue.";
         return 0;

--bowersj21052423564--