Fix to View.pm (oops) and the ability of using sub{} blocks with a localized %_ to...
[catagits/Reaction.git] / lib / Reaction / UI / View.pm
1 package Reaction::UI::View;
2
3 use Reaction::Class;
4
5 # declaring dependencies
6
7 use Reaction::UI::LayoutSet;
8 use Reaction::UI::RenderingContext;
9
10 class View which {
11
12   has '_layout_set_cache' => (is => 'ro', default => sub { {} });
13
14   has 'app' => (is => 'ro', required => 1);
15
16   has 'skin_name' => (is => 'ro', required => 1);
17
18   has 'layout_set_class' => (is => 'ro', lazy_build => 1);
19
20   has 'rendering_context_class' => (is => 'ro', lazy_build => 1);
21
22   implements 'COMPONENT' => as {
23     my ($class, $app, $args) = @_;
24     return $class->new(%{$args||{}}, app => $app);
25   };
26
27   sub BUILD{
28     my $self = shift;
29     my $skin_name = $self->skin_name;
30     my $skin_path = $self->app->path_to('share','skin',$skin_name);
31     confess("'${skin_path}' is not a valid path for skin '${skin_name}'")
32       unless -d $skin_path;
33   }
34
35   implements 'render_window' => as {
36     my ($self, $window) = @_;
37     my $root_vp = $window->focus_stack->vp_head;
38     $self->render_viewport(undef, $root_vp);
39   };
40
41   implements 'render_viewport' => as {
42     my ($self, $outer_rctx, $vp) = @_;
43     my $layout_set = $self->layout_set_for($vp);
44     my $rctx = $self->create_rendering_context(
45       layouts => $layout_set,
46       outer => $outer_rctx,
47     );
48     my $widget = $self->widget_for($vp, $layout_set);
49     $widget->render($rctx);
50   };
51
52   implements 'widget_for' => as {
53     my ($self, $vp, $layout_set) = @_;
54     return $self->widget_class_for($layout_set)
55                 ->new(view => $self, viewport => $vp);
56   };
57
58   implements 'widget_class_for' => as {
59     my ($self, $layout_set) = @_;
60     my $base = ref($self);
61     my $tail = $layout_set->widget_type;
62     my $class = join('::', $base, 'Widget', $tail);
63     Class::MOP::load_class($class);
64     return $class;
65   };
66
67   implements 'layout_set_for' => as {
68     my ($self, $vp) = @_;
69     my $lset_name = eval { $vp->layout };
70     confess "Couldn't call layout method on \$vp arg ${vp}: $@" if $@;
71     unless (length($lset_name)) {
72       my $last = (split('::',ref($vp)))[-1];
73       $lset_name = join('_', map { lc($_) } split(/(?=[A-Z])/, $last));
74     }
75     my $cache = $self->_layout_set_cache;
76     return $cache->{$lset_name} ||= $self->create_layout_set($lset_name);
77   };
78
79   implements 'create_layout_set' => as {
80     my ($self, $name) = @_;
81     return $self->layout_set_class->new(
82              $self->layout_set_args_for($name),
83            );
84   };
85
86   implements 'find_related_class' => as {
87     my ($self, $rel) = @_;
88     my $own_class = ref($self)||$self;
89     confess View." is abstract, you must subclass it" if $own_class eq View;
90     foreach my $super ($own_class->meta->class_precedence_list) {
91       next if $super eq View;
92       if ($super =~ /::View::/) {
93         (my $class = $super) =~ s/::View::/::${rel}::/;
94         if (eval { Class::MOP::load_class($class) }) {
95           return $class;
96         }
97       }
98     }
99     confess "Unable to find related ${rel} class for ${own_class}";
100   };
101
102   implements 'build_layout_set_class' => as {
103     my ($self) = @_;
104     return $self->find_related_class('LayoutSet');
105   };
106
107   implements 'layout_set_args_for' => as {
108     my ($self, $name) = @_;
109     return (name => $name, search_path => $self->layout_search_path);
110   };
111
112   implements 'layout_search_path' => as {
113     my ($self) = @_;
114     return $self->search_path_for_type('layout');
115   };
116
117   implements 'search_path_for_type' => as {
118     my ($self, $type) = @_;
119     return [ $self->app->path_to('share','skin',$self->skin_name,$type) ];
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 'build_rendering_context_class' => as {
131     my ($self) = @_;
132     return $self->find_related_class('RenderingContext');
133   };
134
135   implements 'rendering_context_args_for' => as {
136     return ();
137   };
138
139 };
140
141 1;