Ready for 7.10.29 development.

lib/WebGUI/Asset/Template/HTMLTemplate.pm

@@ -0,0 +1,76 @@
+package WebGUI::Asset::Template::HTMLTemplate;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+use base 'WebGUI::Asset::Template::Parser';
+use WebGUI::Exception;
+use HTML::Template;
+
+
+#-------------------------------------------------------------------
+
+=head2 getName ( )
+
+Returns the human readable name of this parser.
+
+=cut
+
+sub getName {
+	my $self = shift;
+	return "HTML::Template";
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 process ( template, vars )
+
+Evaluate a template replacing template commands for HTML.
+
+=head3 template
+
+A scalar variable containing the template.
+
+=head3 vars
+
+A hash reference containing template variables and loops. 
+
+=cut
+
+sub process {
+    my $self = shift;
+    my $template = shift;
+    my $vars = $self->addSessionVars(shift);
+    $self->downgrade($vars);
+    my $t;
+    eval {
+        $t = HTML::Template->new(
+            scalarref=>\$template,
+            global_vars=>1,
+            loop_context_vars=>1,
+            die_on_bad_params=>0,
+            no_includes=>1,
+            strict=>0
+        );
+    };
+    if ($@) {
+        WebGUI::Error::Template->throw( error => $@ );
+    }
+    $t->param(%{$vars});
+    return $t->output;
+}
+
+1;

lib/WebGUI/Asset/Template/HTMLTemplateExpr.pm

@@ -0,0 +1,101 @@
+package WebGUI::Asset::Template::HTMLTemplateExpr;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+use base 'WebGUI::Asset::Template::Parser';
+use HTML::Template::Expr;
+use WebGUI::Exception;
+
+
+#-------------------------------------------------------------------
+
+=head2 _rewriteVars 
+
+=cut
+
+sub _rewriteVars { # replace dots with underscrores in keys (except in keys that aren't usable as variables (URLs etc.))
+        my $vars = shift;
+	my $newVars = {};
+        foreach my $key (keys %$vars){
+                my $newKey = $key;
+                $newKey =~ s/\./_/g if $newKey !~ /\//;
+		if ( ref $vars->{$key} eq 'ARRAY') {
+			foreach my $entry (@{$vars->{$key}}) {
+				push(@{$newVars->{$newKey}}, _rewriteVars($entry));
+			}
+                } elsif(ref $vars->{$key} eq 'HASH') {
+                        $newVars->{$newKey} = _rewriteVars($vars->{$key});
+                } else {
+                        $newVars->{$newKey} = $vars->{$key};
+                }
+        }
+        return $newVars;
+}
+
+#-------------------------------------------------------------------
+
+=head2 getName ( )
+
+Returns the human readable name of this parser.
+
+=cut
+
+sub getName {
+        my $self = shift;
+        return "HTML::Template::Expr";
+}
+
+#-------------------------------------------------------------------
+
+=head2 process ( template, vars )
+
+Evaluate a template replacing template commands for HTML. 
+
+=head3 template
+
+A scalar variable containing the template.
+
+=head3 vars
+
+A hash reference containing template variables and loops. 
+
+=cut
+
+# TODO: Have this throw an error so we can catch it and print more information
+# about the template that has the error. Finding an "ERROR: Error in template" 
+# in the error log is not very helpful...
+sub process {
+    my $class = shift;
+    my $template = shift;
+    my $vars = $class->addSessionVars(shift);
+    $class->downgrade($vars);
+    my $t;
+    eval {
+        $t = HTML::Template::Expr->new(scalarref=>\$template,
+        global_vars=>1,
+        loop_context_vars=>1,
+        die_on_bad_params=>0,
+        no_includes=>1,
+        strict=>0);
+    };
+    if ($@) {
+        WebGUI::Error::Template->throw( error => $@ );
+    }
+    $t->param(%{_rewriteVars($vars)});
+    return $t->output;
+}
+
+1;

lib/WebGUI/Asset/Template/Parser.pm

@@ -0,0 +1,158 @@
+package WebGUI::Asset::Template::Parser;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+use WebGUI::International;
+use Scalar::Util qw(blessed);
+
+
+#-------------------------------------------------------------------
+
+=head2 addSessionVars ( vars ) 
+
+Appends session variables to the variable list.
+
+=head3 vars
+
+A reference to the template variable hash.
+
+=cut
+
+sub addSessionVars {
+	my $self = shift;
+	my $vars = shift;
+	# These are the only session template variables used in the core as 
+	# of 6.8.5.  Further use of session template vars is deprecated.
+	$vars->{"session.user.username"} = $self->session->user->username;
+	$vars->{"session.user.firstDayOfWeek"} = $self->session->user->profileField("firstDayOfWeek");
+	$vars->{"session.config.extrasurl"} = $self->session->url->extras();
+	$vars->{"session.var.adminOn"} = $self->session->var->isAdminOn;
+	$vars->{"session.setting.companyName"} = $self->session->setting->get("companyName");
+	$vars->{"session.setting.anonymousRegistration"} = $self->session->setting->get("anonymousRegistration");
+	my $forms = $self->session->form->paramsHashRef();
+	foreach my $field (keys %$forms) {
+		if ($forms->{$field}) {
+			$vars->{"session.form.".$field} = 
+				(ref($forms->{$field}) eq 'ARRAY')
+					?$forms->{$field}[$forms->{$field}[-1]]
+					:$forms->{$field};
+		}
+	}
+        my $scratch = $self->session->scratch->{_data};
+        foreach my $field (keys %$scratch) {
+                if ($scratch->{$field}) {
+                        $vars->{"session.scratch.".$field} = $scratch->{$field};
+                }
+        }
+	$vars->{"webgui.version"} = $WebGUI::VERSION;
+	$vars->{"webgui.status"} = $WebGUI::STATUS;
+	return $vars;
+}
+
+#-------------------------------------------------------------------
+
+=head2 downgrade ( vars )
+
+Removes or converts things HTML::Template-like engines can't handle.  Coderefs
+are removed, blessed objects are removed, and hashes are recursively flattened
+by appending keys separated by dots (e.g. { foo => { bar => 'baz' } } becomes
+{ 'foo.bar' => 'baz' }.  Also, array elements that aren't hashes are converted
+to hashes via { value => $bareValue }.
+
+=cut
+
+sub downgrade {
+    my ($self, $vars) = @_;
+    for my $k (keys %$vars) {
+        my $v = $vars->{$k};
+        if (blessed($v) || ref $v eq 'CODE') {
+            delete $vars->{$k};
+        }
+        elsif (ref $v eq 'ARRAY') {
+            for my $i (0..$#$v) {
+                if (ref $v->[$i] eq 'HASH') {
+                    $self->downgrade($v->[$i]);
+                }
+                else {
+                    my %hash = ( value => $v->[$i] );
+                    $self->downgrade(\%hash);
+                    $v->[$i] = \%hash;
+                }
+            }
+        }
+        elsif (ref $v eq 'HASH') {
+            delete $vars->{$k};
+            my %flatter;
+            for my $subkey (keys %$v) {
+                $flatter{"$k.$subkey"}  = $v->{$subkey};
+            }
+            $self->downgrade(\%flatter);
+            @{$vars}{keys %flatter} = values %flatter;
+        }
+    }
+}
+
+#-------------------------------------------------------------------
+
+=head2 new ( session )
+
+Constructor.
+
+=head3 session
+
+A reference to the current session.
+
+=cut
+
+sub new {
+	my $class = shift;
+	my $session = shift;
+	bless {_session=>$session}, $class; 
+}
+
+#-------------------------------------------------------------------
+
+=head2 process ( template, vars )
+
+Evaluate a template replacing template commands for HTML.  This method is required to be overridden.
+
+=head3 template
+
+A scalar variable containing the template.
+
+=head3 vars
+
+A hash reference containing template variables and loops. 
+
+=cut
+
+sub process { }
+
+#-------------------------------------------------------------------
+
+=head2 session ( )
+
+A reference to the current session.
+
+=cut
+
+sub session {
+	my $self = shift;
+	return $self->{_session};
+}
+
+
+1;

lib/WebGUI/Asset/Template/TemplateToolkit.pm

@@ -0,0 +1,100 @@
+package WebGUI::Asset::Template::TemplateToolkit;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+use base 'WebGUI::Asset::Template::Parser';
+use Template;
+
+#-------------------------------------------------------------------
+sub _rewriteVars { # replace dots with underscrores in keys (except in keys that aren't usable as variables (URLs etc.))
+        my $vars = shift;
+	my $newVars = {};
+        foreach my $key (keys %$vars){
+                my $newKey = $key;
+                $newKey =~ s/\./_/g if $newKey !~ /\//;
+		if ( ref $vars->{$key} eq 'ARRAY') {
+			foreach my $entry (@{$vars->{$key}}) {
+				push(@{$newVars->{$newKey}}, _rewriteVars($entry));
+			}
+                } elsif(ref $vars->{$key} eq 'HASH') {
+                        $newVars->{$newKey} = _rewriteVars($vars->{$key});
+                } else {
+                        $newVars->{$newKey} = $vars->{$key};
+                }
+        }
+        return $newVars;
+}
+
+#-------------------------------------------------------------------
+
+=head2 getName ( )
+
+Returns the human readable name of this parser.
+
+=cut
+
+sub getName {
+        my $self = shift;
+        return "Template Toolkit";
+}
+
+#-------------------------------------------------------------------
+
+=head2 process ( template, vars )
+
+Evaluate a template replacing template commands for HTML. 
+
+=head3 template
+
+A scalar variable containing the template.
+
+=head3 vars
+
+A hash reference containing template variables and loops.
+
+=cut
+
+# TODO: Have this throw an error so we can catch it and print more information
+# about the template that has the error. Finding an "ERROR: Error in template" 
+# in the error log is not very helpful...
+sub process {
+    my $self = shift;
+    my $template = shift;
+    my $vars = $self->addSessionVars(shift);
+    my ($t,$output);
+    eval {
+        $t = Template->new({
+            INTERPOLATE  => 1,               # expand "$var" in plain text
+            POST_CHOMP   => 1,               # cleanup whitespace 
+            EVAL_PERL    => 0,               # evaluate Perl code blocks
+        });
+        $vars = _rewriteVars($vars);
+        # store the session so plugins can access it.
+        # underscore prefix prevents direct access from templates
+        $vars->{_session} = $self->session;
+        unless ($t->process( \$template, $vars,\$output)) {
+            my $e = $t->error;
+            $self->session->log->error($e);
+            die $e;
+        }
+    };
+    if ($@) {
+        WebGUI::Error::Template->throw( error => $@ );
+    }
+    return $output;
+}
+
+1;

lib/WebGUI/Asset/Template/_parser.skeleton

@@ -0,0 +1,66 @@
+package WebGUI::Asset::Template::SomeTemplateType;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+use base 'WebGUI::Asset::Template::Parser';
+use WebGUI::Exception;
+
+
+#-------------------------------------------------------------------
+
+=head2 getName ( )
+
+Returns the human readable name of this parser.
+
+=cut
+
+sub getName {
+        my $self = shift;
+        return "My New Parser";
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 process ( template, vars )
+
+Evaluate a template replacing template commands for HTML. 
+
+=head3 template
+
+A scalar variable containing the template.
+
+=head3 vars
+
+A hash reference containing template variables and loops. 
+
+=cut
+
+sub process {
+	my $self = shift;
+	my $template = shift;
+	my $vars = $self->addSessionVars(shift);
+    eval {
+
+    }
+    if ($@) {
+        WebGUI::Error::Template->throw( error => $@ );
+    }
+}
+
+
+1;
+#vim:ft=perl