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

[bowersj2]

bowersj2		Tue Apr 15 15:10:01 2003 EDT

  Modified files:              
    /loncom/interface	lonhelper.pm 
  Log:
  * "die" now explicitly used when subroutine compilations fail so the
    web server error log has an indication what the problem is, instead of
    silently failing.
  * Added section choosing routine. May not completely work yet.
  * Added eval tag, which allows the user to programmatically specify a
    message to print, which turned out to be necessary.
  
  
Index: loncom/interface/lonhelper.pm
diff -u loncom/interface/lonhelper.pm:1.10 loncom/interface/lonhelper.pm:1.11
--- loncom/interface/lonhelper.pm:1.10	Fri Apr 11 15:07:48 2003
+++ loncom/interface/lonhelper.pm	Tue Apr 15 15:10:00 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # .helper XML handler to implement the LON-CAPA helper
 #
-# $Id: lonhelper.pm,v 1.10 2003/04/11 19:07:48 bowersj2 Exp $
+# $Id: lonhelper.pm,v 1.11 2003/04/15 19:10:00 bowersj2 Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1611,6 +1611,9 @@
     my $var = $self->{'variable'};
     
     my $subdirFunc = eval('sub {' . $self->{'filechoice'} . '}');
+    die 'Error in resource filter code for variable ' . 
+        {'variable'} . ', Perl said:' . $@ if $@;
+
     my $subdir = &$subdirFunc();
 
     my $filterFunc = $self->{FILTER_FUNC};
@@ -1718,6 +1721,73 @@
 
 1;
 
+package Apache::lonhelper::section;
+
+=pod
+
+=head2 Element: section
+
+<section> allows the user to choose one or more sections from the current
+course.
+
+It takes the standard attributes "variable", "multichoice", and
+"nextstate", meaning what they do for most other elements.
+
+=cut
+
+no strict;
+@ISA = ("Apache::lonhelper::choices");
+use strict;
+
+BEGIN {
+    &Apache::lonhelper::register('Apache::lonhelper::section',
+                                 ('section'));
+}
+
+sub new {
+    my $ref = Apache::lonhelper::choices->new();
+    bless($ref);
+}
+
+sub start_section {
+    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
+
+    $paramHash->{CHOICES} = [];
+
+    if ($target ne 'helper') {
+        return '';
+    }
+    $paramHash->{'variable'} = $token->[2]{'variable'};
+    $helper->declareVar($paramHash->{'variable'});
+    $paramHash->{'multichoice'} = $token->[2]{'multichoice'};
+    if (defined($token->[2]{'nextstate'})) {
+        $paramHash->{'nextstate'} = $token->[2]{'nextstate'};
+    }
+
+    # Populate the CHOICES element
+    my %choices;
+
+    my $section = Apache::loncoursedata::CL_SECTION();
+    my $classlist = Apache::loncoursedata::get_classlist();
+    foreach (keys %$classlist) {
+        my $sectionName = $classlist->{$_}->[$section];
+        if (!$sectionName) {
+            $choices{"No section assigned"} = "";
+        } else {
+            $choices{$sectionName} = $sectionName;
+        }
+    }
+    
+    for my $sectionName (sort(keys(%choices))) {
+        push @{$paramHash->{CHOICES}}, [$sectionName, $sectionName];
+    }
+
+}    
+
+sub end_section { return ''; }
+
+1;
+
 package Apache::lonhelper::general;
 
 =pod
@@ -1748,7 +1818,8 @@
 
 BEGIN {
     &Apache::lonhelper::register('Apache::lonhelper::general',
-                                 'exec', 'condition', 'clause');
+                                 'exec', 'condition', 'clause',
+                                 'eval');
 }
 
 sub start_exec {
@@ -1762,6 +1833,7 @@
     
     $code = eval ('sub { my $helper = shift; my $state = shift; ' .
         $code . "}");
+    die 'Error in <exec>, Perl said: '. $@ if $@;
     &$code($helper, $paramHash);
 }
 
@@ -1799,6 +1871,7 @@
     my $clause = Apache::lonxml::get_all_text('/clause', $parser);
     $clause = eval('sub { my $helper = shift; my $state = shift; '
         . $clause . '}');
+    die 'Error in clause of condition, Perl said: ' . $@ if $@;
     if (!&$clause($helper, $paramHash)) {
         # Discard all text until the /condition.
         &Apache::lonxml::get_all_text('/condition', $parser);
@@ -1806,6 +1879,47 @@
 }
 
 sub end_clause { return ''; }
+
+=pod
+
+=head2 General-purpose tag: <eval>
+
+The <eval> tag will be evaluated as a subroutine call passed in the
+current helper object and state hash as described in <condition> above,
+but is expected to return a string to be printed directly to the
+screen. This is useful for dynamically generating messages. 
+
+=cut
+
+# This is basically a type of message.
+# Programmatically setting $paramHash->{NEXTSTATE} would work, though
+# it's probably bad form.
+
+sub start_eval {
+    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
+
+    if ($target ne 'helper') {
+        return '';
+    }
+    
+    my $program = Apache::lonxml::get_all_text('/eval', $parser);
+    $program = eval('sub { my $helper = shift; my $state = shift; '
+        . $program . '}');
+    die 'Error in eval code, Perl said: ' . $@ if $@;
+    $paramHash->{MESSAGE_TEXT} = &$program($helper, $paramHash);
+}
+
+sub end_eval { 
+    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
+
+    if ($target ne 'helper') {
+        return '';
+    }
+
+    Apache::lonhelper::message->new();
+}
+
+
 
 1;