Commit | Line | Data |
7adfd53f |
1 | package Reaction::UI::LayoutSet; |
2 | |
3 | use Reaction::Class; |
4 | use File::Spec; |
5 | |
81393881 |
6 | use namespace::clean -except => [ qw(meta) ]; |
7adfd53f |
7 | |
7adfd53f |
8 | |
81393881 |
9 | has 'layouts' => (is => 'ro', default => sub { {} }); |
7adfd53f |
10 | |
81393881 |
11 | has 'name' => (is => 'ro', required => 1); |
e22de101 |
12 | |
81393881 |
13 | has 'source_file' => (is => 'ro', required => 1); |
1c41e332 |
14 | |
81393881 |
15 | has 'widget_class' => ( |
16 | is => 'rw', lazy_fail => 1, predicate => 'has_widget_class' |
17 | ); |
f2fef590 |
18 | |
81393881 |
19 | has 'widget_type' => (is => 'rw', lazy_build => 1); |
f2fef590 |
20 | |
81393881 |
21 | has 'super' => (is => 'rw', predicate => 'has_super'); |
22 | sub BUILD { |
23 | my ($self, $args) = @_; |
24 | my @path = @{$args->{search_path}||[]}; |
25 | confess "No skin object provided" unless $args->{skin}; |
26 | confess "No top skin object provided" unless $args->{top_skin}; |
27 | $self->_load_file($self->source_file, $args); |
28 | unless ($self->has_widget_class) { |
29 | $self->widget_class($args->{skin}->widget_class_for($self)); |
30 | } |
31 | }; |
32 | sub widget_order_for { |
33 | my ($self, $name) = @_; |
34 | return ( |
35 | ($self->has_layout($name) |
36 | ? ([ $self->widget_class, $self ]) #; |
37 | : ()), |
38 | ($self->has_super |
39 | ? ($self->super->widget_order_for($name)) |
40 | : ()), |
41 | ); |
42 | }; |
43 | sub layout_names { |
44 | my ($self) = @_; |
45 | my %seen; |
46 | return [ |
47 | grep { !$seen{$_}++ } |
48 | keys %{shift->layouts}, |
aa8c0c90 |
49 | ($self->has_super |
81393881 |
50 | ? (@{$self->super->layout_names}) |
51 | : ()) |
52 | ]; |
53 | }; |
54 | sub has_layout { exists $_[0]->layouts->{$_[1]} }; |
55 | sub _load_file { |
56 | my ($self, $file, $build_args) = @_; |
57 | my $data = $file->slurp; |
58 | my $layouts = $self->layouts; |
59 | # cheesy match for "=for layout name ... =something" |
60 | # final split group also handles last in file, (?==) is lookahead |
61 | # assertion for '=' so "=for layout name1 ... =for layout name2" |
62 | # doesn't have the match pos go past the latter = and lose name2 |
63 | while ($data =~ m/=(.*?)\n(.*?)(?:\n(?==)|$)/sg) { |
64 | my ($data, $text) = ($1, $2); |
65 | if ($data =~ /^for layout (\S+)/) { |
66 | my $fname = $1; |
67 | $text =~ s/^(?:\s*\r?\n)+//; #remove leading empty lines |
68 | $text =~ s/[\s\r\n]+$//; #remove trailing whitespace |
69 | $layouts->{$fname} = $text; |
70 | } elsif ($data =~ /^extends (\S+)/) { |
71 | my $super_name = $1; |
72 | my $skin; |
73 | if ($super_name eq 'NEXT') { |
74 | confess "No next skin and layout extends NEXT" |
75 | unless $build_args->{next_skin}; |
76 | $skin = $build_args->{next_skin}; |
77 | $super_name = $self->name; |
aa8c0c90 |
78 | } else { |
81393881 |
79 | $skin = $build_args->{top_skin}; |
aa8c0c90 |
80 | } |
81393881 |
81 | $self->super($skin->create_layout_set($super_name)); |
82 | } elsif ($data =~ /^widget (\S+)/) { |
83 | my $widget_type = $1; |
84 | $self->widget_type($1); |
85 | } elsif ($data =~ /^cut/) { |
86 | # no-op |
87 | } else { |
88 | confess "Unparseable directive ${data} in ${file}"; |
7adfd53f |
89 | } |
81393881 |
90 | } |
91 | }; |
92 | sub _build_widget_type { |
93 | my ($self) = @_; |
94 | my $widget = join('', map { ucfirst($_) } split('_', $self->name)); |
95 | $widget = join('::', map { ucfirst($_) } split('/', $widget)); |
7adfd53f |
96 | |
81393881 |
97 | #print STDERR "--- ", $self->name, " maps to widget $widget \n"; |
6ab43711 |
98 | |
81393881 |
99 | return $widget; |
100 | }; |
6ab43711 |
101 | |
81393881 |
102 | __PACKAGE__->meta->make_immutable; |
7b78a39d |
103 | |
7adfd53f |
104 | |
105 | 1; |