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