lib/Reaction/UI/View.pm

   1 package Reaction::UI::View;
   2
   3 use Reaction::Class;
   4
   5 # declaring dependencies
   6 use Reaction::UI::LayoutSet;
   7 use Reaction::UI::RenderingContext;
   8 use aliased 'Reaction::UI::Skin';
   9 use aliased 'Path::Class::Dir';
  10
  11 class View which {
  12
  13   has '_widget_cache' => (is => 'ro', default => sub { {} });
  14
  15   has '_layout_set_cache' => (is => 'ro', default => sub { {} });
  16
  17   has 'app' => (is => 'ro', required => 1);
  18
  19   has 'skin_name' => (is => 'ro', required => 1, default => 'default');
  20
  21   has 'skin' => (
  22     is => 'ro', lazy_build => 1,
  23     handles => [ qw(create_layout_set search_path_for_type) ]
  24   );
  25
  26   has 'layout_set_class' => (is => 'ro', lazy_build => 1);
  27
  28   has 'rendering_context_class' => (is => 'ro', lazy_build => 1);
  29
  30   implements '_build_layout_set_class' => as {
  31     my ($self) = @_;
  32     return $self->find_related_class('LayoutSet');
  33   };
  34
  35   implements '_build_rendering_context_class' => as {
  36     my ($self) = @_;
  37     return $self->find_related_class('RenderingContext');
  38   };
  39
  40   implements '_build_skin' => as {
  41     my ($self) = @_;
  42     Skin->new(
  43       name => $self->skin_name, view => $self,
  44       # path_to returns a File, not a Dir. Thanks, Catalyst.
  45       skin_base_dir => Dir->new($self->app->path_to('share', 'skin')),
  46     );
  47   };
  48
  49   implements 'COMPONENT' => as {
  50     my ($class, $app, $args) = @_;
  51     return $class->new(%{$args||{}}, app => $app);
  52   };
  53
  54   implements 'render_window' => as {
  55     my ($self, $window) = @_;
  56     my $root_vp = $window->focus_stack->vp_head;
  57     my $rctx = $self->create_rendering_context;
  58     my ($widget, $args) = $self->render_viewport_args($root_vp);
  59     $widget->render(widget => $rctx, $args);
  60   };
  61
  62   implements 'render_viewport_args' => as {
  63     my ($self, $vp) = @_;
  64     my $layout_set = $self->layout_set_for($vp);
  65     my $widget = $self->widget_for($vp, $layout_set);
  66     return ($widget, { viewport => $vp });
  67   };
  68
  69   implements 'widget_for' => as {
  70     my ($self, $vp, $layout_set) = @_;
  71     return
  72       $self->_widget_cache->{$layout_set->name}
  73         ||= $layout_set->widget_class
  74                        ->new(
  75                            view => $self, layout_set => $layout_set
  76                          );
  77   };
  78
  79   implements 'layout_set_for' => as {
  80     my ($self, $vp) = @_;
  81     my $lset_name = eval { $vp->layout };
  82     confess "Couldn't call layout method on \$vp arg ${vp}: $@" if $@;
  83     $lset_name = $self->layout_set_name_from_viewport( blessed($vp) )
  84       unless (length($lset_name));
  85     my $cache = $self->_layout_set_cache;
  86     return $cache->{$lset_name} ||= $self->create_layout_set($lset_name);
  87   };
  88
  89   #XXX if it ever comes to it: this could be memoized. not bothering yet.
  90   implements 'layout_set_name_from_viewport' => as {
  91     my ($self, $class) = @_;
  92     my ($last) = ($class =~ /.*(?:::ViewPort::)(.+?)$/);
  93     #split when a non-uppercase letter meets an uppercase or when an
  94     #uppercase letter is followed by another uppercase and then a non-uppercase
  95     #FooBar = foo_bar; Foo_Bar = foo_bar; FOOBar = foo_bar; FooBAR = foo_bar
  96     my @fragments = map {
  97       join("_", split(/(?:(?<=[A-Z])(?=[A-Z][^_A-Z])|(?<=[^_A-Z])(?=[A-Z]))/, $_))
  98     } split('::', $last);
  99     return lc(join('/', @fragments));
 100   };
 101
 102   implements 'layout_set_file_extension' => as {
 103     confess View." is abstract, you must subclass it";
 104   };
 105
 106   implements 'find_related_class' => as {
 107     my ($self, $rel) = @_;
 108     my $own_class = ref($self) || $self;
 109     confess View." is abstract, you must subclass it" if $own_class eq View;
 110     foreach my $super ($own_class->meta->class_precedence_list) {
 111       next if $super eq View;
 112       if ($super =~ /::View::/) {
 113         (my $class = $super) =~ s/::View::/::${rel}::/;
 114         if (eval { Class::MOP::load_class($class) }) {
 115           return $class;
 116         }
 117       }
 118     }
 119     confess "Unable to find related ${rel} class for ${own_class}";
 120   };
 121
 122   implements 'create_rendering_context' => as {
 123     my ($self, @args) = @_;
 124     return $self->rendering_context_class->new(
 125              $self->rendering_context_args_for(@args),
 126              @args,
 127            );
 128   };
 129
 130   implements 'rendering_context_args_for' => as {
 131     return ();
 132   };
 133
 134   implements 'layout_set_args_for' => as {
 135     return ();
 136   };
 137
 138 };
 139
 140 1;