Slight changes to make output code more flexible

webtools/PLIF/PLIF/DataSource/DebugStrings.pm

@@ -0,0 +1,99 @@
+# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
+#
+# This file is MPL/GPL dual-licensed under the following terms:
+# 
+# The contents of this file are subject to the Mozilla Public License
+# Version 1.1 (the "License"); you may not use this file except in
+# compliance with the License. You may obtain a copy of the License at
+# http://www.mozilla.org/MPL/
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and
+# limitations under the License.
+#
+# The Original Code is PLIF 1.0.
+# The Initial Developer of the Original Code is Ian Hickson.
+#
+# Alternatively, the contents of this file may be used under the terms
+# of the GNU General Public License Version 2 or later (the "GPL"), in
+# which case the provisions of the GPL are applicable instead of those
+# above. If you wish to allow use of your version of this file only
+# under the terms of the GPL and not to allow others to use your
+# version of this file under the MPL, indicate your decision by
+# deleting the provisions above and replace them with the notice and
+# other provisions required by the GPL. If you do not delete the
+# provisions above, a recipient may use your version of this file
+# under either the MPL or the GPL.
+
+package PLIF::DataSource::DebugStrings;
+use strict;
+use vars qw(@ISA);
+use PLIF::DataSource;
+@ISA = qw(PLIF::DataSource);
+1;
+
+sub provides {
+    my $class = shift;
+    my($service) = @_;
+    return ($service eq 'dataSource.strings.default' or $class->SUPER::provides($service));
+}
+
+sub getDefaultString {
+    my $self = shift;
+    my($app, $protocol, $string) = @_;
+    # this is protocol agnostic stuff :-)
+    if ($string eq 'debug.dumpVars') {
+        return <<eof;
+<!--
+ !
+ !  This example will dump every single string passed into it. For
+ !  example, if you pass it a hash with one item 'data' containing two
+ !  items 'a' and 'b' with 'a' containing 'hello' and 'b' containing
+ !  an array of two values 'wonderful' and 'world', you would get as
+ !  output the following:
+ !
+ !     coses: last condition = 0
+ !     coses: white space = 1
+ !     data.a = hello
+ !     data.b.1 = wonderful
+ !     data.b.2 = world
+ !
+ !  This example uses almost all the features of COSES, and so is
+ !  quite a useful example to study. (It doesn't use <else/> or all
+ !  the values of <set>'s attributes.) It's also a great help when
+ !  debugging! You can use it at any point in a COSES document merely
+ !  by nesting it, so you can, for example, study what is happening
+ !  with a <set> statement. If you declare this example as having the
+ !  name 'debug.dumpVars' then to embed it you would do:
+ !
+ !     <embed string="debug.dumpVars"/>
+ !
+ !  This example is covered by the same license terms as COSES itself.
+ !  Author: Ian Hickson
+ !
+ !-->
+<text xml:space="default"> <!-- trim whitespace -->
+  <with variable="prefix">  
+    <if lvalue="((prefix))" condition="is" rvalue="scalar">
+      <text value="  (prefix)"/> = <text value="((prefix))"/><br/>
+    </if>
+    <if lvalue="((prefix))" condition="is not" rvalue="scalar">
+      <set variable="index" value="((prefix))" source="keys" order="case insensitive lexical">
+        <set variable="prefix" value="(prefix).(index)">
+          <embed string="debug.dumpVars"/>
+        </set>
+      </set>
+    </if>
+  </with>
+  <without variable="prefix">
+    <set variable="prefix" value="()" source="keys" order="lexical">
+      <embed string="debug.dumpVars"/>
+    </set>
+  </without>
+</text>
+eof
+    } else {
+        return;
+    }
+}

webtools/PLIF/PLIF/Output/Generic.pm

@@ -99,6 +99,7 @@ sub init {
     my($app, $session, $protocol) = @_;
     $self->propertySet('actualSession', $session);
     $self->propertySet('actualProtocol', $protocol);
+    $self->propertySet('outputter', $self->app->getServiceInstance('output.generic.'.$self->actualProtocol));
 }
 
 sub output {
@@ -112,6 +113,19 @@ sub output {
         $expander = $self->app->getService('string.expander');
         $self->assert($expander, 1, 'Could not find a string expander.');
     }
-    $self->app->getService('output.generic.'.$self->actualProtocol)->output($self->app, $session, 
-         $expander->expand($self->app, $session, $self->actualProtocol, $string, $data));
+    $self->outputter->output($self->app, $session, $expander->expand($self->app, $session, $self->actualProtocol, $string, $data));
+}
+
+# If we don't implement the output handler directly, let's see if some
+# specific output dispatcher service for this protocol does.
+# Note: We pass ourselves as the 'output object for this protocol'
+# even though this is actually the generic output handler, because
+# there _is_ no 'output object for this protocol' since if there was
+# the generic output module wouldn't get called!
+sub methodMissing {
+    my $self = shift;
+    my($method, @arguments) = @_;
+    if (not $self->app->dispatchMethod('dispatcher.output.'.$self->actualProtocol, 'output', $method, $self, @arguments)) {
+        $self->SUPER::methodMissing(@_); # this does the same, but for 'dispatcher.output.generic' handlers
+    }
 }

webtools/PLIF/PLIF/Program.pm

@@ -109,10 +109,20 @@ sub output {
         $default = 1;
         $protocol = $self->selectOutputProtocol();
     }
+    # There are two output models in PLIF. The first is the protocol-
+    # specific-code model, the second is the string-expander
+    # model. The string expander model is still protocol specific to
+    # some extent, but it gives greater flexibility for exactly what
+    # is output... so long as it can be represented by a single string
+    # that is then passed to protocol-specific code. 
+    # First, see if a full protocol-specific-code handler exists:
     my $output = $self->getServiceInstance("output.$protocol", $session);
     if (not $output) {
+        # ...and, since we failed to find one, fall back on the
+        # generic string expander model:
         $output = $self->getServiceInstance("output.generic", $session, $protocol);
         if (not $output) {
+            # oops, no string expander model either :-/
             $self->error(0, 'Could not find an applicable output class');
         }
     }