From 972b87711cb3c7543d585ceedca0eda2058aa6d7 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Sven=20Sch=C3=B6ling?= <s.schoeling@linet-services.de>
Date: Mon, 13 Feb 2017 17:23:05 +0100
Subject: [PATCH] Model-Presenter Bindung mit Proxyobjekten

---
 SL/DB/Helper/Presenter.pm | 83 +++++++++++++++++++++++++++++++++++++++
 SL/DB/Object.pm           | 22 +++++++++++
 2 files changed, 105 insertions(+)
 create mode 100644 SL/DB/Helper/Presenter.pm

diff --git a/SL/DB/Helper/Presenter.pm b/SL/DB/Helper/Presenter.pm
new file mode 100644
index 000000000..48502548f
--- /dev/null
+++ b/SL/DB/Helper/Presenter.pm
@@ -0,0 +1,83 @@
+package SL::DB::Helper::Presenter;
+
+use strict;
+
+sub new {
+  # lightweight: 0: class, 1: object
+  bless [ $_[1], $_[2] ], $_[0];
+}
+
+sub AUTOLOAD {
+  our $AUTOLOAD;
+
+  my ($self, @args) = @_;
+
+  my $method = $AUTOLOAD;
+  $method    =~ s/.*:://;
+
+  return if $method eq 'DESTROY';
+
+  return $self->[0]->$method($self->[1], @args);
+}
+
+1;
+
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+SL::DB::Helper::Presenter - proxy class to allow models to access presenters
+
+=head1 SYNOPSIS
+
+  # assuming SL::Presemter::Part exists
+  # and contains a sub link_to($class, $object) {}
+  SL::DB::Part->new(%args)->presenter->link_to
+
+=head1 DESCRIPTION
+
+When coding controller one often encounters objects that are not crucial to the
+current task, but must be presented in some form to the user. Instead of
+recreating that all the time the C<SL::Presenter> namepace was introduced to
+hold such code.
+
+Unfortunately the Presenter code is designed to be stateless and thus acts _on_
+objects, but can't be instanced or wrapped. The early band-aid to that was to
+export all sub-presenter calls into the main presenter namespace. Fixing it
+would have meant to access presenter functions like this:
+
+  SL::Presenter::Object->method($object, %additional_args)
+
+which is  extremely inconvenient.
+
+This glue code allows C<SL::DB::Object> instances to access routines in their
+presenter without additional boilerplate. C<SL::DB::Object> contains a
+C<presenter> call for all objects, which will return an instance of this proxy
+class. All calls on this will then be forwarded to the appropriate presenter.
+
+=head1 INTERNAL STRUCTURE
+
+The proxy objects created are lightweight blessed arrayrefs instead of the usual blessed
+hashrefs. They only store two elements:
+
+=over 4
+
+=item * The presenter class
+
+=item * The invocing object
+
+=back
+
+Further delegation is done with C<AUTOLOAD>.
+
+=head1 BUGS
+
+None yet :)
+
+=head1 AUTHOR
+
+Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
+
+=cut
diff --git a/SL/DB/Object.pm b/SL/DB/Object.pm
index 3304ed9b6..06596dd4f 100755
--- a/SL/DB/Object.pm
+++ b/SL/DB/Object.pm
@@ -12,6 +12,7 @@ use SL::DB;
 use SL::DB::Helper::Attr;
 use SL::DB::Helper::Metadata;
 use SL::DB::Helper::Manager;
+use SL::DB::Helper::Presenter;
 use SL::DB::Object::Hooks;
 
 use base qw(Rose::DB::Object);
@@ -238,6 +239,19 @@ sub clone_and_reset {
   return $clone;
 }
 
+sub presenter {
+  my ($class_or_self) = @_;
+
+  if (ref $class_or_self) {
+    my $class = ref $class_or_self;
+    $class =~ s{^SL::DB::}{SL::Presenter::};
+    return SL::DB::Helper::Presenter->new($class, $class_or_self);
+  } else {
+    $class_or_self =~ s{^SL::DB::}{SL::Presenter::};
+    return $class_or_self;
+  }
+}
+
 1;
 
 __END__
@@ -361,6 +375,14 @@ The difference between Rose's and this function is that this function
 will also skip setting the following fields if such columns exist for
 C<$self>: C<itime>, C<mtime>.
 
+=item C<presenter>
+
+Returns a proxy wrapper that will dispatch all method calls to the presenter
+with the same name as the class of the involking object.
+
+For the full documentation about its capabilites see
+L<SL::DB::Helper::Presenter>
+
 =back
 
 =head1 AUTHOR
-- 
2.20.1