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);
  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     #print STDERR "Getting layoutset for VP ".(ref($vp) || "SC:".$vp)."\n";
  82     my $lset_name = eval { $vp->layout };
  83     confess "Couldn't call layout method on \$vp arg ${vp}: $@" if $@;
  84     unless (length($lset_name)) {
  85       my $vp_class = ref($vp) || $vp;
  86       my ($last) = ($vp_class =~ /.*(?:::ViewPort::)(.+?)$/);
  87       my @fragments = split('::', $last);
  88       $_ = join("_", split(/(?=[A-Z])/, $_)) for @fragments;
  89       $lset_name = lc(join('/', @fragments));
  90       #print STDERR "--- $vp_class is rendered as $lset_name\n";
  91     }
  92     my $cache = $self->_layout_set_cache;
  93     return $cache->{$lset_name} ||= $self->create_layout_set($lset_name);
  94   };
  95
  96   implements 'layout_set_file_extension' => as {
  97     confess View." is abstract, you must subclass it";
  98   };
  99
 100   implements 'find_related_class' => as {
 101     my ($self, $rel) = @_;
 102     my $own_class = ref($self) || $self;
 103     confess View." is abstract, you must subclass it" if $own_class eq View;
 104     foreach my $super ($own_class->meta->class_precedence_list) {
 105       next if $super eq View;
 106       if ($super =~ /::View::/) {
 107         (my $class = $super) =~ s/::View::/::${rel}::/;
 108         if (eval { Class::MOP::load_class($class) }) {
 109           return $class;
 110         }
 111       }
 112     }
 113     confess "Unable to find related ${rel} class for ${own_class}";
 114   };
 115
 116   implements 'create_rendering_context' => as {
 117     my ($self, @args) = @_;
 118     return $self->rendering_context_class->new(
 119              $self->rendering_context_args_for(@args),
 120              @args,
 121            );
 122   };
 123
 124   implements 'rendering_context_args_for' => as {
 125     return ();
 126   };
 127
 128   implements 'layout_set_args_for' => as {
 129     return ();
 130   };
 131
 132 };
 133
 134 1;