X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FReaction%2FUI%2FSkin.pm;h=237279d35d2feb01769470216a9c557605eb986f;hb=049d22341026ead65b36eca2bddac7181f246142;hp=dad42064b44333a7d76f561b5b0dad30c73c00e9;hpb=a2a5872bdd576eb5f389499ed36b03b86587388d;p=catagits%2FReaction.git diff --git a/lib/Reaction/UI/Skin.pm b/lib/Reaction/UI/Skin.pm index dad4206..237279d 100644 --- a/lib/Reaction/UI/Skin.pm +++ b/lib/Reaction/UI/Skin.pm @@ -5,147 +5,188 @@ use Reaction::Class; # declaring dependencies use Reaction::UI::LayoutSet; use Reaction::UI::RenderingContext; +use File::ShareDir; +use File::Basename; +use Config::Any; use aliased 'Path::Class::Dir'; -class Skin which { - - has '_layout_set_cache' => (is => 'ro', default => sub { {} }); - has '_widget_class_cache' => (is => 'ro', default => sub { {} }); - - has 'skin_base_path' => (is => 'ro', isa => Dir, required => 1); - - has 'widget_search_path' => ( - is => 'rw', isa => 'ArrayRef', requred => 1, default => sub { [] } - ); - - has 'view' => ( - is => 'ro', required => 1, weak_ref => 1, - handles => [ qw(layout_set_class) ], - ); - - has 'super' => ( - is => 'rw', isa => Skin, required => 0, predicate => 'has_super', - ); - - sub BUILD { - my ($self) = @_; - $self->_load_skin_config; +use namespace::clean -except => [ qw(meta) ]; + + +has '_layout_set_cache' => (is => 'ro', default => sub { {} }); +has '_widget_class_cache' => (is => 'ro', default => sub { {} }); + +has 'name' => (is => 'ro', isa => 'Str', required => 1); +has 'skin_dir' => (is => 'rw', isa => Dir, lazy_fail => 1); + +has 'widget_search_path' => ( + is => 'rw', isa => 'ArrayRef', required => 1, default => sub { [] } +); + +has 'view' => ( + is => 'ro', required => 1, weak_ref => 1, + handles => [ qw(layout_set_class) ], +); + +has 'super' => ( + is => 'rw', isa => Skin, required => 0, predicate => 'has_super', +); + +sub BUILD { + my ($self, $args) = @_; + $self->_find_skin_dir($args); + $self->_load_skin_config($args); +} +sub _find_skin_dir { + my ($self, $args) = @_; + my $skin_name = $self->name; + if ($skin_name =~ s!^/(.*?)/!!) { + my $dist = $1; + $args->{skin_base_dir} = eval { + Dir->new(File::ShareDir::dist_dir($dist)) + ->subdir('skin'); + }; + if ($@) { + # No installed Reaction + my $file = __FILE__; + my $dir = Dir->new(dirname($file)); + my $skin_base; + while ($dir->parent) { + if (-d $dir->subdir('share') && -d $dir->subdir('share')->subdir('skin')) { + $skin_base = $dir->subdir('share')->subdir('skin'); + last; + } + $dir = $dir->parent; + } + confess "could not find skinbase by recursion. ended up at $dir, from $file" + unless $skin_base; + $args->{skin_base_dir} = $skin_base; + } } - - implements '_load_skin_config' => as { - my ($self) = @_; - my $base = $self->skin_base_path; - confess "No such skin base directory ${base}" - unless -d $base; - my $lst = sub { (ref $_[0] eq 'ARRAY') ? $_[0] : [$_[0]] }; - my @files = ( - $base->parent->file('defaults.conf'), $base->file('skin.conf') + my $base = $args->{skin_base_dir}->subdir($skin_name); + confess "No such skin base directory ${base}" + unless -d $base; + $self->skin_dir($base); +}; +sub _load_skin_config { + my ($self, $args) = @_; + my $base = $self->skin_dir; + my $lst = sub { (ref $_[0] eq 'ARRAY') ? $_[0] : [$_[0]] }; + my @files = ( + $args->{skin_base_dir}->file('defaults.conf'), $base->file('skin.conf') + ); + # we get [ { $file => $conf }, ... ] + my %cfg = (map { %{(values %{$_})[0]} } + @{Config::Any->load_files({ + files => [ grep { -e $_ } map { $_->stringify } @files ], + use_ext => 1, + })} + ); + if (my $super_name = $cfg{extends}) { + my $super = $self->new( + name => $super_name, + view => $self->view, + skin_base_dir => $args->{skin_base_dir}, ); - # we get [ { $file => $conf }, ... ] - my %cfg = (map { %{(values %{$_})[0]} } - @{Config::Any->load_files({ - files => [ grep { -e $_ } @files ], - use_ext => 1, - })} - ); - if (my $super_name = $cfg{extends}) { - my $super_dir = $base->parent->subdir($super_name); - my $super = $self->new( - view => $self->view, skin_base_path => $super_dir - ); - $self->super($super); - } - if (exists $cfg{widget_search_path}) { - $self->widget_search_path($lst->($cfg{widget_search_path})); - } else { - confess "No widget_search_path in defaults.conf or skin.conf" - ." and no search path provided from super skin" - unless $self->full_widget_search_path; - } + $self->super($super); } - - implements 'create_layout_set' => as { - my ($self, $name) = @_; - if (my $path = $self->layout_path_for($name)) { - return $self->layout_set_class->new( - $self->layout_set_args_for($name), - source_file => $path, - ); - } - if ($self->has_super) { - return $self->super->create_layout_set($name); + if (exists $cfg{widget_search_path}) { + $self->widget_search_path($lst->($cfg{widget_search_path})); + } + # For some reason this conditional doesn't work correctly without + # the "my @x". Answers on a postcard. + unless (my @x = $self->full_widget_search_path) { + confess "No widget_search_path in defaults.conf or skin.conf" + .($self->has_super + ? " and no search path provided from super skin " + .$self->super->name + : ""); + } +} +sub create_layout_set { + my ($self, $name) = @_; + $self->_create_layout_set($name, [], $self); +}; +sub _create_layout_set { + my ($self, $name, $tried, $top_skin) = @_; + if (my $path = $self->layout_path_for($name)) { + return $self->layout_set_class->new( + $self->layout_set_args_for($name), + source_file => $path, + top_skin => $top_skin, + ); + } + $tried = [ @{$tried}, $self->our_path_for_type('layout') ]; + if ($self->has_super) { + return $self->super->_create_layout_set($name, $tried, $top_skin); + } + confess "Couldn't find layout set file for ${name}, tried " + .join(', ', @$tried); +}; +sub layout_set_args_for { + my ($self, $name) = @_; + return ( + name => $name, + skin => $self, + ($self->has_super ? (next_skin => $self->super) : ()), + $self->view->layout_set_args_for($name), + ); +}; +sub layout_path_for { + my ($self, $layout) = @_; + my $file_name = join( + '.', $layout, $self->view->layout_set_file_extension + ); + my $path = $self->our_path_for_type('layout') + ->file($file_name); + return (-e $path ? $path : undef); +}; +sub search_path_for_type { + my ($self, $type) = @_; + return [ + $self->our_path_for_type($type), + ($self->has_super + ? @{$self->super->search_path_for_type($type)} + : () + ) + ]; +}; +sub our_path_for_type { + my ($self, $type) = @_; + return $self->skin_dir->subdir($type) +}; +sub full_widget_search_path { + my ($self) = @_; + return ( + @{$self->widget_search_path}, + ($self->has_super ? $self->super->full_widget_search_path : ()) + ); +}; +sub widget_class_for { + my ($self, $layout_set) = @_; + my $base = blessed($self); + my $widget_type = $layout_set->widget_type; + return $self->_widget_class_cache->{$widget_type} ||= do { + + my @search_path = $self->full_widget_search_path; + my @haystack = map {join('::', $_, $widget_type)} @search_path; + + foreach my $class (@haystack) { + #if the class is already loaded skip the call to Installed etc. + return $class if Class::MOP::is_class_loaded($class); + next unless Class::Inspector->installed($class); + + my $ok = eval { Class::MOP::load_class($class) }; + confess("Failed to load widget '${class}': $@") if $@; + return $class; } - confess "Couldn't find layout set file for ${name}"; - }; - - implements 'layout_set_args_for' => as { - my ($self, $name) = @_; - return ( - name => $name, - skin => $self, - ($self->has_super ? (next_skin => $self->super) : ()), - $self->view->layout_set_args_for($name), - ); - }; - - implements 'layout_path_for' => as { - my ($self, $layout) = @_; - my $file_name = join( - '.', $layout, $self->view->layout_set_file_extension - ); - my $path = $self->our_path_for_type('layout') - ->file($file_name); - return (-e $path ? $path : undef); - }; - - implements 'search_path_for_type' => as { - my ($self, $type) = @_; - return [ - $self->our_path_for_type($type), - ($self->has_super - ? @{$self->super->search_path_for_type($type)} - : () - ) - ]; - }; - - implements 'our_path_for_type' => as { - my ($self, $type) = @_; - return $self->skin_base_path->subdir($type) - }; - - implements 'full_widget_search_path' => as { - my ($self) = @_; - return ( - @{$self->widget_search_path}, - ($self->has_super ? $self->super->full_widget_search_path : ()) - ); + confess "Couldn't locate widget '${widget_type}' for layout " + ."'${\$layout_set->name}': tried: ".join(", ", @haystack); }; +}; - implements 'widget_class_for' => as { - my ($self, $layout_set) = @_; - my $base = $self->blessed; - my $widget_type = $layout_set->widget_type; - return $self->_widget_class_cache->{$widget_type} ||= do { - - my @search_path = $self->full_widget_search_path; - my @haystack = map {join('::', $_, $widget_type)} @search_path; - - foreach my $class (@haystack) { - #if the class is already loaded skip the call to Installed etc. - return $class if Class::MOP::is_class_loaded($class); - next unless Class::Inspector->installed($class); - - my $ok = eval { Class::MOP::load_class($class) }; - confess("Failed to load widget '${class}': $@") if $@; - return $class; - } - confess "Couldn't locate widget '${widget_type}' for layout " - ."'${\$layout_set->name}': tried: ".join(", ", @haystack); - }; - }; +__PACKAGE__->meta->make_immutable; -}; 1;