lib/Reaction/UI/LayoutSet.pm

   1 package Reaction::UI::LayoutSet;
   2
   3 use Reaction::Class;
   4 use File::Spec;
   5
   6 class LayoutSet which {
   7
   8   has 'layouts' => (is => 'ro', default => sub { {} });
   9
  10   has 'name' => (is => 'ro', required => 1);
  11
  12   has 'source_file' => (is => 'rw', lazy_fail => 1);
  13   has 'file_extension'=> (isa => 'Str', is => 'rw', lazy_build => 1);
  14
  15   has 'widget_class' => (is => 'rw', lazy_fail => 1);
  16
  17   implements _build_file_extension => as { 'html' };
  18
  19   implements 'BUILD' => as {
  20     my ($self, $args) = @_;
  21     my @path = @{$args->{search_path}||[]};
  22     confess "No search_path provided" unless @path;
  23     my $found;
  24     my $ext = $self->file_extension;
  25     SEARCH: foreach my $path (@path) {
  26       my $cand = $path->file($self->name . ".${ext}");
  27       #print STDERR $cand,"\n";
  28       if ($cand->stat) {
  29         $self->_load_file($cand);
  30         $found = 1;
  31         last SEARCH;
  32       }
  33     }
  34     confess "Unable to load file for LayoutSet ".$self->name unless $found;
  35     confess "No view object provided" unless $args->{view};
  36     $self->widget_class($args->{view}->widget_class_for($self));
  37   };
  38
  39   implements 'widget_order_for' => as {
  40     my ($self, $name) = @_;
  41     if ($self->has_layout($name)) {
  42       return ([ $self->widget_class, $self ]);
  43     } else {
  44       return ();
  45     }
  46   };
  47
  48   implements 'layout_names' => as { [ keys %{shift->layouts} ] };
  49
  50   implements 'has_layout' => as { exists $_[0]->layouts->{$_[1]} };
  51
  52   implements '_load_file' => as {
  53     my ($self, $file) = @_;
  54     my $data = $file->slurp;
  55     my $layouts = $self->layouts;
  56     # cheesy match for "=for layout name ... =something"
  57     # final split group also handles last in file, (?==) is lookahead
  58     # assertion for '=' so "=for layout name1 ... =for layout name2"
  59     # doesn't have the match pos go past the latter = and lose name2
  60     while ($data =~ m/=for layout (.*?)\n(.+?)(?:\n(?==)|$)/sg) {
  61       my ($fname, $text) = ($1, $2);
  62       $layouts->{$fname} = $text;
  63     }
  64     $self->source_file($file);
  65   };
  66
  67   implements 'widget_type' => as {
  68     my ($self) = @_;
  69     my $widget = join('',   map { ucfirst($_) } split('_', $self->name));
  70     $widget    = join('::', map { ucfirst($_) } split('/', $widget));
  71
  72     #print STDERR "--- ", $self->name, " maps to widget $widget \n";
  73
  74     return $widget;
  75   };
  76
  77 };
  78
  79 1;