SL::Presenter -- die neue Präsentationsschicht
authorMoritz Bunkus <m.bunkus@linet-services.de>
Mon, 28 Jan 2013 15:18:07 +0000 (16:18 +0100)
committerMoritz Bunkus <m.bunkus@linet-services.de>
Fri, 1 Feb 2013 12:35:27 +0000 (13:35 +0100)
SL/Controller/Base.pm
SL/Presenter.pm [new file with mode: 0644]
SL/Presenter/EscapedText.pm [new file with mode: 0644]
SL/Template/Plugin/L.pm
SL/Template/Plugin/P.pm [new file with mode: 0644]

index 64ac328..d6bfd42 100644 (file)
@@ -9,6 +9,7 @@ use IO::File;
 use List::Util qw(first);
 use SL::Request qw(flatten);
 use SL::MoreCommon qw(uri_encode);
+use SL::Presenter;
 
 use Rose::Object::MakeMethods::Generic
 (
@@ -62,18 +63,6 @@ sub render {
   $options->{type}       = lc($options->{type} || 'html');
   $options->{no_layout}  = 1 if $options->{type} eq 'js';
 
-  my $source;
-  if ($options->{inline}) {
-    $source = \$template;
-
-  } elsif($options->{raw}) {
-    $source =  $template;
-
-  } else {
-    $source = "templates/webpages/${template}." . $options->{type};
-    croak "Template file ${source} not found" unless -f $source;
-  }
-
   if (!$options->{partial} && !$options->{inline} && !$::form->{header}) {
     if ($options->{no_layout}) {
       $::form->{header} = 1;
@@ -88,24 +77,15 @@ sub render {
     }
   }
 
-  my %params = ( %locals,
-                 AUTH          => $::auth,
-                 FLASH         => $::form->{FLASH},
-                 FORM          => $::form,
-                 INSTANCE_CONF => $::instance_conf,
-                 LOCALE        => $::locale,
-                 LXCONFIG      => \%::lx_office_conf,
-                 LXDEBUG       => $::lxdebug,
-                 MYCONFIG      => \%::myconfig,
-                 SELF          => $self,
-               );
-
   my $output;
-  if (!$options->{raw}) {
-    my $parser = $self->_template_obj;
-    $parser->process($source, \%params, \$output) || croak $parser->error;
+  if ($options->{raw}) {
+    $output = $$template;
   } else {
-    $output = $$source;
+    $output = $self->presenter->render(
+      $template, $options,
+      %locals,
+      SELF => $self,
+    );
   }
 
   print $output unless $options->{inline} || $options->{no_output};
@@ -129,6 +109,10 @@ sub send_file {
   $file->close;
 }
 
+sub presenter {
+  return SL::Presenter->get;
+}
+
 sub controller_name {
   my $class = ref($_[0]) || $_[0];
   $class    =~ s/^SL::Controller:://;
@@ -233,24 +217,6 @@ sub _dispatch {
   }
 }
 
-sub _template_obj {
-  my ($self) = @_;
-
-  $self->{__basepriv_template_obj} ||=
-    Template->new({ INTERPOLATE  => 0,
-                    EVAL_PERL    => 0,
-                    ABSOLUTE     => 1,
-                    CACHE_SIZE   => 0,
-                    PLUGIN_BASE  => 'SL::Template::Plugin',
-                    INCLUDE_PATH => '.:templates/webpages',
-                    COMPILE_EXT  => '.tcc',
-                    COMPILE_DIR  => $::lx_office_conf{paths}->{userspath} . '/templates-cache',
-                    ERROR        => 'templates/webpages/generic/exception.html',
-                  }) || croak;
-
-  return $self->{__basepriv_template_obj};
-}
-
 1;
 
 __END__
@@ -369,16 +335,18 @@ C<$options>, if present, must be a hash reference. All remaining
 parameters are slurped into C<%locals>.
 
 What is rendered and how C<$template> is interpreted is determined by
-the options I<type>, I<inline>, I<partial> and I<no_layout>.
+the options I<type>, I<inline>, I<partial> and I<no_layout>. The
+actual rendering is handled by L<SL::Presenter/render>.
 
 If C<< $options->{inline} >> is trueish then C<$template> is a string
 containing the template code to interprete. Additionally the output
 will not be sent to the browser. Instead it is only returned to the
 caller.
 
-If C<< $options->{raw} >> is trueish, the function will treat the input as
-already parsed, and will not filter the input through Template. Unlike
-C<inline>, the input is taked as a reference.
+If C<< $options->{raw} >> is trueish, the function will treat the
+input as already parsed, and will not filter the input through
+Template. This also means that L<SL::Presenter/render> is not
+called either. Unlike C<inline>, the input is taken as a reference.
 
 If C<< $options->{inline} >> is falsish then C<$template> is
 interpreted as the name of a template file. It is prefixed with
@@ -400,30 +368,8 @@ C<$locals{title}> (the latter only if C<$locals{title}> is
 trueish). Setting C<< $options->{no_layout} >> to trueish will prevent
 this.
 
-The template itself has access to the following variables:
-
-=over 2
-
-=item * C<AUTH> -- C<$::auth>
-
-=item * C<FORM> -- C<$::form>
-
-=item * C<LOCALE> -- C<$::locale>
-
-=item * C<LXCONFIG> -- all parameters from C<config/kivitendo.conf>
-with the same name they appear in the file (first level is the
-section, second the actual variable, e.g. C<system.dbcharset>,
-C<features.webdav> etc)
-
-=item * C<LXDEBUG> -- C<$::lxdebug>
-
-=item * C<MYCONFIG> -- C<%::myconfig>
-
-=item * C<SELF> -- the controller instance
-
-=item * All items from C<%locals>
-
-=back
+The template itself has access to several variables. These are listed
+in the documentation to L<SL::Presenter/render>.
 
 Unless C<< $options->{inline} >> is trueish the function will send the
 output to the browser.
@@ -563,6 +509,11 @@ Returns the name of the currently executing action. If the dispatcher
 mechanism was used then this is not C<dispatch> but the actual method
 name the dispatching resolved to.
 
+=item C<presenter>
+
+Returns the global presenter object by calling
+L<SL::Presenter/get>.
+
 =back
 
 =head2 PRIVATE FUNCTIONS
diff --git a/SL/Presenter.pm b/SL/Presenter.pm
new file mode 100644 (file)
index 0000000..eeeb43f
--- /dev/null
@@ -0,0 +1,235 @@
+package SL::Presenter;
+
+use strict;
+
+use parent qw(Rose::Object);
+
+use Carp;
+use Template;
+
+use SL::Presenter::CustomerVendor;
+use SL::Presenter::DeliveryOrder;
+use SL::Presenter::EscapedText;
+use SL::Presenter::Invoice;
+use SL::Presenter::Order;
+use SL::Presenter::Project;
+use SL::Presenter::Record;
+
+sub get {
+  $::request->{presenter} ||= SL::Presenter->new;
+  return $::request->{presenter};
+}
+
+sub render {
+  my $self               = shift;
+  my $template           = shift;
+  my ($options, %locals) = (@_ && ref($_[0])) ? @_ : ({ }, @_);
+
+  $options->{type}       = lc($options->{type} || 'html');
+
+  my $source;
+  if ($options->{inline}) {
+    $source = \$template;
+
+  } else {
+    $source = "templates/webpages/${template}." . $options->{type};
+    croak "Template file ${source} not found" unless -f $source;
+  }
+
+  my %params = ( %locals,
+                 AUTH          => $::auth,
+                 FLASH         => $::form->{FLASH},
+                 FORM          => $::form,
+                 INSTANCE_CONF => $::instance_conf,
+                 LOCALE        => $::locale,
+                 LXCONFIG      => \%::lx_office_conf,
+                 LXDEBUG       => $::lxdebug,
+                 MYCONFIG      => \%::myconfig,
+                 PRESENTER     => $self,
+               );
+
+  my $output;
+  my $parser = $self->get_template;
+  $parser->process($source, \%params, \$output) || croak $parser->error;
+
+  return SL::Presenter::EscapedText->new(text => $output, is_escaped => 1);
+}
+
+sub get_template {
+  my ($self) = @_;
+
+  $self->{template} ||=
+    Template->new({ INTERPOLATE  => 0,
+                    EVAL_PERL    => 0,
+                    ABSOLUTE     => 1,
+                    CACHE_SIZE   => 0,
+                    PLUGIN_BASE  => 'SL::Template::Plugin',
+                    INCLUDE_PATH => '.:templates/webpages',
+                    COMPILE_EXT  => '.tcc',
+                    COMPILE_DIR  => $::lx_office_conf{paths}->{userspath} . '/templates-cache',
+                    ERROR        => 'templates/webpages/generic/exception.html',
+                  }) || croak;
+
+  return $self->{template};
+}
+
+sub escape {
+  my ($self, $text) = @_;
+
+  return SL::Presenter::EscapedText->new(text => $text);
+}
+
+sub escaped_text {
+  my ($self, $text) = @_;
+
+  return SL::Presenter::EscapedText->new(text => $text, is_escaped => 1);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+SL::Presenter - presentation layer class
+
+=head1 SYNOPSIS
+
+  use SL::Presenter;
+  my $presenter = SL::Presenter->get;
+
+  # Lower-level template parsing:
+  my $html = $presenter->render(
+    'presenter/dir/template.html',
+    var1 => 'value',
+  );
+
+  # Higher-level rendering of certain objects:
+  use SL::DB::Customer;
+
+  my $linked_customer_name = $presenter->customer($customer, display => 'table-cell');
+
+  # Render a list of links to sales/purchase records:
+  use SL::DB::Order;
+
+  my $quotation = SL::DB::Manager::Order->get_first(where => { quotation => 1 });
+  my $records   = $quotation->linked_records(direction => 'to');
+  my $html      = $presenter->grouped_record_list($records);
+
+=head1 CLASS FUNCTIONS
+
+=over 4
+
+=item C<get>
+
+Returns the global presenter object and creates it if it doesn't exist
+already.
+
+=back
+
+=head1 INSTANCE FUNCTIONS
+
+=over 4
+
+=item C<render $template, [ $options, ] %locals>
+
+Renders the template C<$template>. Provides other variables than
+C<Form::parse_html_template> does.
+
+C<$options>, if present, must be a hash reference. All remaining
+parameters are slurped into C<%locals>.
+
+This is the backend function that L<SL::Controller::Base/render>
+calls. The big difference is that the presenter's L<render> function
+always returns the input and never sends anything to the browser while
+the controller's function usually sends the result to the
+controller. Therefore the presenter's L<render> function does not use
+all of the parameters for controlling the output that the controller's
+function does.
+
+What is rendered and how C<$template> is interpreted is determined by
+the options I<type> and I<inline>.
+
+If C<< $options->{inline} >> is trueish then C<$template> is a string
+containing the template code to interprete.
+
+If C<< $options->{inline} >> is falsish then C<$template> is
+interpreted as the name of a template file. It is prefixed with
+"templates/webpages/" and postfixed with a file extension based on
+C<< $options->{type} >>. C<< $options->{type} >> can be either C<html>
+or C<js> and defaults to C<html>. An exception will be thrown if that
+file does not exist.
+
+The template itself has access to the following variables:
+
+=over 2
+
+=item * C<AUTH> -- C<$::auth>
+
+=item * C<FORM> -- C<$::form>
+
+=item * C<LOCALE> -- C<$::locale>
+
+=item * C<LXCONFIG> -- all parameters from C<config/kivitendo.conf>
+with the same name they appear in the file (first level is the
+section, second the actual variable, e.g. C<system.dbcharset>,
+C<features.webdav> etc)
+
+=item * C<LXDEBUG> -- C<$::lxdebug>
+
+=item * C<MYCONFIG> -- C<%::myconfig>
+
+=item * C<SELF> -- the controller instance
+
+=item * All items from C<%locals>
+
+=back
+
+The function will always return the output and never send anything to
+the browser.
+
+Example: Render a HTML template with a certain title and a few locals
+
+  $presenter->render('todo/list',
+                     title      => 'List TODO items',
+                     TODO_ITEMS => SL::DB::Manager::Todo->get_all_sorted);
+
+Example: Render a string and return its content for further processing
+by the calling function.
+
+  my $content = $presenter->render(
+    '[% USE JavaScript %][% JavaScript.replace_with("#someid", "js/something") %]',
+    { type => 'js' }
+  );
+
+=item C<escape $text>
+
+Returns an HTML-escaped version of C<$text>. Instead of a string an
+instance of the thin proxy-object L<SL::Presenter::EscapedText> is
+returned.
+
+It is safe to call C<escape> on an instance of
+L<SL::Presenter::EscapedText>. This is a no-op (the same instance will
+be returned).
+
+=item C<escaped_text $text>
+
+Returns an instance of L<SL::Presenter::EscapedText>. C<$text> is
+assumed to be a string that has already been HTML-escaped.
+
+It is safe to call C<escaped_text> on an instance of
+L<SL::Presenter::EscapedText>. This is a no-op (the same instance will
+be returned).
+
+=item C<get_template>
+
+Returns the global instance of L<Template> and creates it if it
+doesn't exist already.
+
+=back
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
diff --git a/SL/Presenter/EscapedText.pm b/SL/Presenter/EscapedText.pm
new file mode 100644 (file)
index 0000000..d482e8a
--- /dev/null
@@ -0,0 +1,100 @@
+package SL::Presenter::EscapedText;
+
+use strict;
+
+use overload '""' => \&escaped;
+
+sub new {
+  my ($class, %params) = @_;
+
+  return $params{text} if ref($params{text}) eq $class;
+
+  my $self      = bless {}, $class;
+  $self->{text} = $params{is_escaped} ? $params{text} : $::locale->quote_special_chars('HTML', $params{text});
+
+  return $self;
+}
+
+sub escaped {
+  my ($self) = @_;
+  return $self->{text};
+}
+
+1;
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+SL::Presenter::EscapedText - Thin proxy object around HTML-escaped strings
+
+=head1 SYNOPSIS
+
+  use SL::Presenter::EscapedText;
+
+  sub blackbox {
+    my ($text) = @_;
+    return SL::Presenter::EscapedText->new(text => $text);
+  }
+
+  sub build_output {
+    my $output_of_other_component = blackbox('Hello & Goodbye');
+
+    # The following is safe, text will not be escaped twice:
+    return SL::Presenter::EscapedText->new(text => $output_of_other_component);
+  }
+
+  my $output = build_output();
+  print "Yeah: $output\n";
+
+=head1 OVERVIEW
+
+Sometimes it's nice to let a sub-component build its own
+representation. However, you always have to be very careful about
+whose responsibility escaping is. Only the building function knows
+enough about the structure to be able to HTML escape properly.
+
+But higher functions should not have to care if the output is already
+escaped -- they should be able to simply escape it again. Without
+producing stuff like '&amp;amp;'.
+
+Stringification is overloaded. It will return the same as L<escaped>.
+
+This works together with the template plugin
+L<SL::Template::Plugin::P> and its C<escape> method.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<new %params>
+
+Creates an instance of C<EscapedText>.
+
+The parameter C<text> is the text to escape. If it is already an
+instance of C<EscapedText> then C<$params{text}> is returned
+unmodified.
+
+Otherwise C<text> is HTML-escaped and stored in the new instance. This
+can be overridden by setting C<$params{is_escaped}> to a trueish
+value.
+
+=item C<escaped>
+
+Returns the escaped string (not an instance of C<EscapedText> but an
+actual string).
+
+=back
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut
index 4ed65ab..09eaf72 100644 (file)
@@ -6,6 +6,8 @@ use List::MoreUtils qw(apply);
 use List::Util qw(max);
 use Scalar::Util qw(blessed);
 
+use SL::Presenter;
+
 use strict;
 
 { # This will give you an id for identifying html tags and such.
@@ -675,9 +677,7 @@ sub paginate_controls {
     },
   );
 
-  my $output;
-  $controller->_template_obj->process('templates/webpages/common/paginate.html', \%template_params, \$output);
-  return $output;
+  return SL::Presenter->get->render('common/paginate', %template_params);
 }
 
 1;
diff --git a/SL/Template/Plugin/P.pm b/SL/Template/Plugin/P.pm
new file mode 100644 (file)
index 0000000..d2f4423
--- /dev/null
@@ -0,0 +1,106 @@
+package SL::Template::Plugin::P;
+
+use base qw( Template::Plugin );
+
+use SL::Presenter;
+use SL::Presenter::EscapedText;
+
+use strict;
+
+sub new {
+  my ($class, $context, @args) = @_;
+
+  return bless {
+    CONTEXT => $context,
+  }, $class;
+}
+
+sub escape {
+  my ($self, $string) = @_;
+  return SL::Presenter::EscapedText->new(text => $string);
+}
+
+sub AUTOLOAD {
+  our $AUTOLOAD;
+
+  my ($self, @args) = @_;
+
+  my $presenter     = SL::Presenter->get;
+  my $method        =  $AUTOLOAD;
+  $method           =~ s/.*:://;
+
+  return '' unless $presenter->can($method);
+
+  splice @args, -1, 1, %{ $args[-1] } if @args && (ref($args[-1]) eq 'HASH');
+
+  $presenter->$method(@args);
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+SL::Template::Plugin::P - Template plugin for the presentation layer
+
+=head1 SYNOPSIS
+
+  [% USE P %]
+
+  Customer: [% P.customer(customer) %]
+
+  Linked records:
+  [% P.grouped_record_list(RECORDS) %]
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<AUTOLOAD>
+
+All unknown functions called on C<P> are forwarded to functions with
+the same name in the global presenter object.
+
+The presenter's functions use hashes for named-argument
+passing. Unfortunately L<Template> groups named arguments into hash
+references. This makes mixing intentional hash references and named
+arguments a bit hairy. For example, the following calls from a
+template are undistinguishable for a plugin:
+
+  [% P.some_func({ arg1 => 42, arg2 => 'Charlie' }) %]
+  [% P.some_func(arg1 => 42, arg2 => 'Charlie') %]
+  [% P.some_func(arg1=42, arg2='Charlie') %]
+  [% P.some_func(arg1=42, arg2='Charlie') %]
+
+C<AUTOLOAD> tries to be clever and unpacks a hash reference into a
+normal hash if and only if it is the very last parameter to the
+function call.
+
+Returns the result of the corresponding function in the presenter.
+
+=item C<escape $text>
+
+Returns an HTML-escaped version of C<$text>. Instead of a string an
+instance of the thin proxy-object L<SL::Presenter::EscapedText> is
+returned.
+
+It is safe to call C<escape> on an instance of
+L<SL::Presenter::EscapedText>. This is a no-op (the same instance will
+be returned).
+
+=back
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut