lib/Reaction/UI/Skin.pm

   1 package Reaction::UI::Skin;
   2
   3 use Reaction::Class;
   4
   5 # declaring dependencies
   6 use Reaction::UI::LayoutSet;
   7 use Reaction::UI::RenderingContext;
   8 use File::ShareDir;
   9 use File::Basename;
  10 use Config::Any;
  11
  12 use aliased 'Path::Class::Dir';
  13
  14 use namespace::clean -except => [ qw(meta) ];
  15
  16
  17 has '_layout_set_cache'   => (is => 'ro', default => sub { {} });
  18 has '_widget_class_cache'   => (is => 'ro', default => sub { {} });
  19
  20 has 'name' => (is => 'ro', isa => 'Str', required => 1);
  21 has 'skin_dir' => (is => 'rw', isa => Dir, lazy_fail => 1);
  22
  23 has 'widget_search_path' => (
  24   is => 'rw', isa => 'ArrayRef', required => 1, default => sub { [] }
  25 );
  26
  27 has 'view' => (
  28   is => 'ro', required => 1, weak_ref => 1,
  29   handles => [ qw(layout_set_class) ],
  30 );
  31
  32 has 'super' => (
  33   is => 'rw', isa => Skin, required => 0, predicate => 'has_super',
  34 );
  35
  36 sub BUILD {
  37   my ($self, $args) = @_;
  38   $self->_find_skin_dir($args);
  39   $self->_load_skin_config($args);
  40 }
  41 sub _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;
  65     }
  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 };
  72 sub _load_skin_config {
  73   my ($self, $args) = @_;
  74   my $base = $self->skin_dir;
  75   my $lst = sub { (ref $_[0] eq 'ARRAY') ? $_[0] : [$_[0]] };
  76   my @files = (
  77     $args->{skin_base_dir}->file('defaults.conf'), $base->file('skin.conf')
  78   );
  79   # we get [ { $file => $conf }, ... ]
  80   my %cfg = (map { %{(values %{$_})[0]} }
  81               @{Config::Any->load_files({
  82                 files => [ grep { -e $_ } @files ],
  83                 use_ext => 1,
  84               })}
  85             );
  86   if (my $super_name = $cfg{extends}) {
  87     my $super = $self->new(
  88       name => $super_name,
  89       view => $self->view,
  90       skin_base_dir => $args->{skin_base_dir},
  91     );
  92     $self->super($super);
  93   }
  94   if (exists $cfg{widget_search_path}) {
  95     $self->widget_search_path($lst->($cfg{widget_search_path}));
  96   }
  97   # For some reason this conditional doesn't work correctly without
  98   # the "my @x". Answers on a postcard.
  99   unless (my @x = $self->full_widget_search_path) {
 100     confess "No widget_search_path in defaults.conf or skin.conf"
 101             .($self->has_super
 102               ? " and no search path provided from super skin "
 103                 .$self->super->name
 104               : "");
 105   }
 106 }
 107 sub create_layout_set {
 108   my ($self, $name) = @_;
 109   $self->_create_layout_set($name, [], $self);
 110 };
 111 sub _create_layout_set {
 112   my ($self, $name, $tried, $top_skin) = @_;
 113   if (my $path = $self->layout_path_for($name)) {
 114     return $self->layout_set_class->new(
 115              $self->layout_set_args_for($name),
 116              source_file => $path,
 117              top_skin => $top_skin,
 118            );
 119   }
 120   $tried = [ @{$tried}, $self->our_path_for_type('layout') ];
 121   if ($self->has_super) {
 122     return $self->super->_create_layout_set($name, $tried, $top_skin);
 123   }
 124   confess "Couldn't find layout set file for ${name}, tried "
 125           .join(', ', @$tried);
 126 };
 127 sub layout_set_args_for {
 128   my ($self, $name) = @_;
 129   return (
 130     name => $name,
 131     skin => $self,
 132     ($self->has_super ? (next_skin => $self->super) : ()),
 133     $self->view->layout_set_args_for($name),
 134   );
 135 };
 136 sub layout_path_for {
 137   my ($self, $layout) = @_;
 138   my $file_name = join(
 139     '.', $layout, $self->view->layout_set_file_extension
 140   );
 141   my $path = $self->our_path_for_type('layout')
 142                   ->file($file_name);
 143   return (-e $path ? $path : undef);
 144 };
 145 sub search_path_for_type {
 146   my ($self, $type) = @_;
 147   return [
 148     $self->our_path_for_type($type),
 149     ($self->has_super
 150       ? @{$self->super->search_path_for_type($type)}
 151       : ()
 152     )
 153   ];
 154 };
 155 sub our_path_for_type {
 156   my ($self, $type) = @_;
 157   return $self->skin_dir->subdir($type)
 158 };
 159 sub full_widget_search_path {
 160   my ($self) = @_;
 161   return (
 162     @{$self->widget_search_path},
 163     ($self->has_super ? $self->super->full_widget_search_path : ())
 164   );
 165 };
 166 sub widget_class_for {
 167   my ($self, $layout_set) = @_;
 168   my $base = blessed($self);
 169   my $widget_type = $layout_set->widget_type;
 170   return $self->_widget_class_cache->{$widget_type} ||= do {
 171
 172     my @search_path = $self->full_widget_search_path;
 173     my @haystack = map {join('::', $_, $widget_type)} @search_path;
 174
 175     foreach my $class (@haystack) {
 176       #if the class is already loaded skip the call to Installed etc.
 177       return $class if Class::MOP::is_class_loaded($class);
 178       next unless Class::Inspector->installed($class);
 179
 180       my $ok = eval { Class::MOP::load_class($class) };
 181       confess("Failed to load widget '${class}': $@") if $@;
 182       return $class;
 183     }
 184     confess "Couldn't locate widget '${widget_type}' for layout "
 185       ."'${\$layout_set->name}': tried: ".join(", ", @haystack);
 186   };
 187 };
 188
 189 __PACKAGE__->meta->make_immutable;
 190
 191
 192 1;