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 $class = ref($self) || $self;
  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({
  83                 files => [ grep { -e $_ } map { $_->stringify } @files ],
  84                 use_ext => 1,
  85               })}
  86             );
  87   if (my $super_name = $cfg{extends}) {
  88     my $super = $class->new(
  89       name => $super_name,
  90       view => $self->view,
  91       skin_base_dir => $args->{skin_base_dir},
  92     );
  93     $self->super($super);
  94   }
  95   if (exists $cfg{widget_search_path}) {
  96     $self->widget_search_path($lst->($cfg{widget_search_path}));
  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) {
 101     confess "No widget_search_path in defaults.conf or skin.conf"
 102             .($self->has_super
 103               ? " and no search path provided from super skin "
 104                 .$self->super->name
 105               : "");
 106   }
 107 }
 108 sub create_layout_set {
 109   my ($self, $name) = @_;
 110   $self->_create_layout_set($name, [], $self);
 111 };
 112 sub _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 };
 128 sub 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 };
 137 sub 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 };
 146 sub 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 };
 156 sub our_path_for_type {
 157   my ($self, $type) = @_;
 158   return $self->skin_dir->subdir($type)
 159 };
 160 sub 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 };
 167 sub 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;
 184     }
 185     confess "Couldn't locate widget '${widget_type}' for layout "
 186       ."'${\$layout_set->name}': tried: ".join(", ", @haystack);
 187   };
 188 };
 189
 190 __PACKAGE__->meta->make_immutable;
 191
 192
 193 1;