cleanup of hard to read layout_args code
[catagits/Reaction.git] / lib / Reaction / UI / Skin.pm
CommitLineData
8a293e2e 1package Reaction::UI::Skin;
2
3use Reaction::Class;
4
5# declaring dependencies
6use Reaction::UI::LayoutSet;
7use Reaction::UI::RenderingContext;
8b498574 8use File::ShareDir;
888532d3 9use File::Basename;
20d63b20 10use Config::Any;
8a293e2e 11
12use aliased 'Path::Class::Dir';
13
81393881 14use namespace::clean -except => [ qw(meta) ];
15
16
17has '_layout_set_cache' => (is => 'ro', default => sub { {} });
18has '_widget_class_cache' => (is => 'ro', default => sub { {} });
19
20has 'name' => (is => 'ro', isa => 'Str', required => 1);
21has 'skin_dir' => (is => 'rw', isa => Dir, lazy_fail => 1);
22
23has 'widget_search_path' => (
a8b77e2a 24 is => 'rw', isa => 'ArrayRef', required => 1, default => sub { [] }
81393881 25);
26
27has 'view' => (
28 is => 'ro', required => 1, weak_ref => 1,
29 handles => [ qw(layout_set_class) ],
30);
31
32has 'super' => (
33 is => 'rw', isa => Skin, required => 0, predicate => 'has_super',
34);
35
36sub BUILD {
37 my ($self, $args) = @_;
38 $self->_find_skin_dir($args);
39 $self->_load_skin_config($args);
40}
41sub _find_skin_dir {
42 my ($self, $args) = @_;
43 my $skin_name = $self->name;
44 if ($skin_name =~ s!^/(.*?)/!!) {
45 my $dist = $1;
46 $args->{skin_base_dir} = eval {
47 Dir->new(File::ShareDir::dist_dir($dist))
48 ->subdir('skin');
49 };
50 if ($@) {
51 # No installed Reaction
52 my $file = __FILE__;
53 my $dir = Dir->new(dirname($file));
54 my $skin_base;
55 while ($dir->parent) {
56 if (-d $dir->subdir('share') && -d $dir->subdir('share')->subdir('skin')) {
57 $skin_base = $dir->subdir('share')->subdir('skin');
58 last;
59 }
60 $dir = $dir->parent;
61 }
62 confess "could not find skinbase by recursion. ended up at $dir, from $file"
63 unless $skin_base;
64 $args->{skin_base_dir} = $skin_base;
8b498574 65 }
81393881 66 }
67 my $base = $args->{skin_base_dir}->subdir($skin_name);
68 confess "No such skin base directory ${base}"
69 unless -d $base;
70 $self->skin_dir($base);
71};
72sub _load_skin_config {
73 my ($self, $args) = @_;
987fc6e2 74 my $class = ref($self) || $self;
81393881 75 my $base = $self->skin_dir;
76 my $lst = sub { (ref $_[0] eq 'ARRAY') ? $_[0] : [$_[0]] };
77 my @files = (
78 $args->{skin_base_dir}->file('defaults.conf'), $base->file('skin.conf')
79 );
80 # we get [ { $file => $conf }, ... ]
81 my %cfg = (map { %{(values %{$_})[0]} }
82 @{Config::Any->load_files({
dc254e2d 83 files => [ grep { -e $_ } map { $_->stringify } @files ],
81393881 84 use_ext => 1,
85 })}
86 );
87 if (my $super_name = $cfg{extends}) {
987fc6e2 88 my $super = $class->new(
81393881 89 name => $super_name,
90 view => $self->view,
91 skin_base_dir => $args->{skin_base_dir},
349a57a4 92 );
81393881 93 $self->super($super);
8a293e2e 94 }
81393881 95 if (exists $cfg{widget_search_path}) {
96 $self->widget_search_path($lst->($cfg{widget_search_path}));
b0c3f1b1 97 }
98 # For some reason this conditional doesn't work correctly without
99 # the "my @x". Answers on a postcard.
100 unless (my @x = $self->full_widget_search_path) {
81393881 101 confess "No widget_search_path in defaults.conf or skin.conf"
b0c3f1b1 102 .($self->has_super
103 ? " and no search path provided from super skin "
104 .$self->super->name
105 : "");
81393881 106 }
107}
108sub create_layout_set {
109 my ($self, $name) = @_;
110 $self->_create_layout_set($name, [], $self);
111};
112sub _create_layout_set {
113 my ($self, $name, $tried, $top_skin) = @_;
114 if (my $path = $self->layout_path_for($name)) {
115 return $self->layout_set_class->new(
116 $self->layout_set_args_for($name),
117 source_file => $path,
118 top_skin => $top_skin,
119 );
120 }
121 $tried = [ @{$tried}, $self->our_path_for_type('layout') ];
122 if ($self->has_super) {
123 return $self->super->_create_layout_set($name, $tried, $top_skin);
124 }
125 confess "Couldn't find layout set file for ${name}, tried "
126 .join(', ', @$tried);
127};
128sub layout_set_args_for {
129 my ($self, $name) = @_;
130 return (
131 name => $name,
132 skin => $self,
133 ($self->has_super ? (next_skin => $self->super) : ()),
134 $self->view->layout_set_args_for($name),
135 );
136};
137sub layout_path_for {
138 my ($self, $layout) = @_;
139 my $file_name = join(
140 '.', $layout, $self->view->layout_set_file_extension
141 );
142 my $path = $self->our_path_for_type('layout')
143 ->file($file_name);
144 return (-e $path ? $path : undef);
145};
146sub search_path_for_type {
147 my ($self, $type) = @_;
148 return [
149 $self->our_path_for_type($type),
150 ($self->has_super
151 ? @{$self->super->search_path_for_type($type)}
152 : ()
153 )
154 ];
155};
156sub our_path_for_type {
157 my ($self, $type) = @_;
158 return $self->skin_dir->subdir($type)
159};
160sub full_widget_search_path {
161 my ($self) = @_;
162 return (
163 @{$self->widget_search_path},
164 ($self->has_super ? $self->super->full_widget_search_path : ())
165 );
166};
167sub widget_class_for {
168 my ($self, $layout_set) = @_;
169 my $base = blessed($self);
170 my $widget_type = $layout_set->widget_type;
171 return $self->_widget_class_cache->{$widget_type} ||= do {
172
173 my @search_path = $self->full_widget_search_path;
174 my @haystack = map {join('::', $_, $widget_type)} @search_path;
175
176 foreach my $class (@haystack) {
177 #if the class is already loaded skip the call to Installed etc.
178 return $class if Class::MOP::is_class_loaded($class);
179 next unless Class::Inspector->installed($class);
180
181 my $ok = eval { Class::MOP::load_class($class) };
182 confess("Failed to load widget '${class}': $@") if $@;
183 return $class;
8a293e2e 184 }
81393881 185 confess "Couldn't locate widget '${widget_type}' for layout "
186 ."'${\$layout_set->name}': tried: ".join(", ", @haystack);
a2a5872b 187 };
81393881 188};
a2a5872b 189
81393881 190__PACKAGE__->meta->make_immutable;
a2a5872b 191
8a293e2e 192
1931;