Commit | Line | Data |
7adfd53f |
1 | package Reaction::UI::LayoutSet; |
2 | |
3 | use Reaction::Class; |
4 | use File::Spec; |
5 | |
6 | class LayoutSet which { |
7 | |
8 | has 'fragments' => (is => 'ro', default => sub { {} }); |
9 | |
10 | has 'name' => (is => 'ro', required => 1); |
11 | |
12 | has 'source_file' => (is => 'rw', lazy_fail => 1); |
e22de101 |
13 | has 'file_extension'=> (isa => 'Str', is => 'rw', lazy_build => 1); |
14 | |
89939ff9 |
15 | implements _build_file_extension => as { 'html' }; |
7adfd53f |
16 | |
17 | implements 'BUILD' => as { |
18 | my ($self, $args) = @_; |
19 | my @path = @{$args->{search_path}||[]}; |
20 | confess "No search_path provided" unless @path; |
21 | my $found; |
e22de101 |
22 | my $ext = $self->file_extension; |
7adfd53f |
23 | SEARCH: foreach my $path (@path) { |
e22de101 |
24 | my $cand = $path->file($self->name . ".${ext}"); |
25 | #print STDERR $cand,"\n"; |
7adfd53f |
26 | if ($cand->stat) { |
27 | $self->_load_file($cand); |
28 | $found = 1; |
29 | last SEARCH; |
30 | } |
31 | } |
32 | confess "Unable to load file for LayoutSet ".$self->name unless $found; |
33 | }; |
34 | |
35 | implements '_load_file' => as { |
36 | my ($self, $file) = @_; |
37 | my $data = $file->slurp; |
38 | my $fragments = $self->fragments; |
39 | # cheesy match for "=for layout fragmentname ... =something" |
40 | # final split group also handles last in file, (?==) is lookahead |
41 | # assertion for '=' so "=for layout fragment1 ... =for layout fragment2" |
42 | # doesn't have the match pos go past the latter = and lose fragment2 |
43 | while ($data =~ m/=for layout (.*?)\n(.+?)(?:\n(?==)|$)/sg) { |
44 | my ($fname, $text) = ($1, $2); |
45 | $fragments->{$fname} = $text; |
46 | } |
47 | $self->source_file($file); |
48 | }; |
49 | |
50 | implements 'widget_type' => as { |
51 | my ($self) = @_; |
6ab43711 |
52 | my $widget = join('', map { ucfirst($_) } split('_', $self->name)); |
53 | $widget = join('::', map { ucfirst($_) } split('/', $widget)); |
54 | |
e22de101 |
55 | #print STDERR "--- ", $self->name, " maps to widget $widget \n"; |
6ab43711 |
56 | |
57 | return $widget; |
7adfd53f |
58 | }; |
7b78a39d |
59 | |
7adfd53f |
60 | }; |
61 | |
62 | 1; |