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 Scalar::Util qw(blessed);
  11
  12 use aliased 'Path::Class::Dir';
  13
  14 class Skin which {
  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', requred => 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
  41   implements '_find_skin_dir' => as {
  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
  73   implements '_load_skin_config' => as {
  74     my ($self, $args) = @_;
  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 $_ } @files ],
  84                   use_ext => 1,
  85                 })}
  86               );
  87     if (my $super_name = $cfg{extends}) {
  88       my $super = $self->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     } else {
  98       confess "No widget_search_path in defaults.conf or skin.conf"
  99               ." and no search path provided from super skin"
 100         unless $self->full_widget_search_path;
 101     }
 102   }
 103
 104   implements 'create_layout_set' => as {
 105     my ($self, $name) = @_;
 106     $self->_create_layout_set($name, [], $self);
 107   };
 108
 109   implements '_create_layout_set' => as {
 110     my ($self, $name, $tried, $top_skin) = @_;
 111     if (my $path = $self->layout_path_for($name)) {
 112       return $self->layout_set_class->new(
 113                $self->layout_set_args_for($name),
 114                source_file => $path,
 115                top_skin => $top_skin,
 116              );
 117     }
 118     $tried = [ @{$tried}, $self->our_path_for_type('layout') ];
 119     if ($self->has_super) {
 120       return $self->super->_create_layout_set($name, $tried, $top_skin);
 121     }
 122     confess "Couldn't find layout set file for ${name}, tried "
 123             .join(', ', @$tried);
 124   };
 125
 126   implements 'layout_set_args_for' => as {
 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
 136   implements 'layout_path_for' => as {
 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
 146   implements 'search_path_for_type' => as {
 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
 157   implements 'our_path_for_type' => as {
 158     my ($self, $type) = @_;
 159     return $self->skin_dir->subdir($type)
 160   };
 161
 162   implements 'full_widget_search_path' => as {
 163     my ($self) = @_;
 164     return (
 165       @{$self->widget_search_path},
 166       ($self->has_super ? $self->super->full_widget_search_path : ())
 167     );
 168   };
 169
 170   implements 'widget_class_for' => as {
 171     my ($self, $layout_set) = @_;
 172     my $base = blessed($self);
 173     my $widget_type = $layout_set->widget_type;
 174     return $self->_widget_class_cache->{$widget_type} ||= do {
 175
 176       my @search_path = $self->full_widget_search_path;
 177       my @haystack = map {join('::', $_, $widget_type)} @search_path;
 178
 179       foreach my $class (@haystack) {
 180         #if the class is already loaded skip the call to Installed etc.
 181         return $class if Class::MOP::is_class_loaded($class);
 182         next unless Class::Inspector->installed($class);
 183
 184         my $ok = eval { Class::MOP::load_class($class) };
 185         confess("Failed to load widget '${class}': $@") if $@;
 186         return $class;
 187       }
 188       confess "Couldn't locate widget '${widget_type}' for layout "
 189         ."'${\$layout_set->name}': tried: ".join(", ", @haystack);
 190     };
 191   };
 192
 193 };
 194
 195 1;