line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::Context::BEM; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# Created on: 2013-11-02 20:51:18 |
4
|
|
|
|
|
|
|
# Create by: Ivan Wills |
5
|
|
|
|
|
|
|
# $Id$ |
6
|
|
|
|
|
|
|
# $Revision$, $HeadURL$, $Date$ |
7
|
|
|
|
|
|
|
# $Revision$, $Source$, $Date$ |
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
22865
|
use Moose; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
use namespace::autoclean; |
11
|
|
|
|
|
|
|
use version; |
12
|
|
|
|
|
|
|
use Carp; |
13
|
|
|
|
|
|
|
use Scalar::Util; |
14
|
|
|
|
|
|
|
use List::Util; |
15
|
|
|
|
|
|
|
use Data::Dumper qw/Dumper/; |
16
|
|
|
|
|
|
|
use English qw/ -no_match_vars /; |
17
|
|
|
|
|
|
|
use Data::Context::BEM::Instance; |
18
|
|
|
|
|
|
|
use Template; |
19
|
|
|
|
|
|
|
use File::ShareDir qw/module_dir dist_dir/; |
20
|
|
|
|
|
|
|
use Path::Class; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
our $VERSION = version->new('0.0.3'); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
extends 'Data::Context'; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
has '+instance_class' => ( |
27
|
|
|
|
|
|
|
default => 'Data::Context::BEM::Instance', |
28
|
|
|
|
|
|
|
); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
has template => ( |
31
|
|
|
|
|
|
|
is => 'rw', |
32
|
|
|
|
|
|
|
isa => 'Template', |
33
|
|
|
|
|
|
|
required => 1, |
34
|
|
|
|
|
|
|
lazy => 1, |
35
|
|
|
|
|
|
|
builder => '_template', |
36
|
|
|
|
|
|
|
); |
37
|
|
|
|
|
|
|
has template_providers => ( |
38
|
|
|
|
|
|
|
is => 'rw', |
39
|
|
|
|
|
|
|
isa => 'ArrayRef[Template::Provider]', |
40
|
|
|
|
|
|
|
required => 1, |
41
|
|
|
|
|
|
|
lazy => 1, |
42
|
|
|
|
|
|
|
builder => '_template_provider', |
43
|
|
|
|
|
|
|
); |
44
|
|
|
|
|
|
|
has template_path => ( |
45
|
|
|
|
|
|
|
is => 'rw', |
46
|
|
|
|
|
|
|
isa => 'Str', |
47
|
|
|
|
|
|
|
); |
48
|
|
|
|
|
|
|
has block_map => ( |
49
|
|
|
|
|
|
|
is => 'rw', |
50
|
|
|
|
|
|
|
isa => 'HashRef', |
51
|
|
|
|
|
|
|
default => sub{{}}, |
52
|
|
|
|
|
|
|
); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
around BUILDARGS => sub { |
55
|
|
|
|
|
|
|
my ($orig, $class, @args) = @_; |
56
|
|
|
|
|
|
|
my $args |
57
|
|
|
|
|
|
|
= !@args ? {} |
58
|
|
|
|
|
|
|
: @args == 1 ? $args[0] |
59
|
|
|
|
|
|
|
: {@args}; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
if ( $args->{Template} && !$args->{template} ) { |
62
|
|
|
|
|
|
|
$args->{template_providers} = [Template::Provider->new( |
63
|
|
|
|
|
|
|
$args->{Template}, |
64
|
|
|
|
|
|
|
)]; |
65
|
|
|
|
|
|
|
$args->{template} = Template->new({ |
66
|
|
|
|
|
|
|
%{$args->{Template}}, |
67
|
|
|
|
|
|
|
LOAD_TEMPLATES => $args->{template_providers}, |
68
|
|
|
|
|
|
|
}); |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
$args->{template_path} ||= $args->{Template}{INCLUDE_PATH}; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
return $class->$orig($args); |
73
|
|
|
|
|
|
|
}; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
around get => sub { |
76
|
|
|
|
|
|
|
my ($orig, $self, @args) = @_; |
77
|
|
|
|
|
|
|
return $self->$orig(@args); |
78
|
|
|
|
|
|
|
}; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub get_html { |
81
|
|
|
|
|
|
|
my ($self, $path, $args, $params) = @_; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# get processed data |
84
|
|
|
|
|
|
|
my $instance = $self->get_instance($path, $params); |
85
|
|
|
|
|
|
|
my $data = $instance->get_data($params); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# get base template |
88
|
|
|
|
|
|
|
my $base_block = $data->{block}; |
89
|
|
|
|
|
|
|
$self->log->debug('got data'); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# set template path per config |
92
|
|
|
|
|
|
|
$self->set_template_path($instance); |
93
|
|
|
|
|
|
|
$self->log->debug('set path'); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# call template with data |
96
|
|
|
|
|
|
|
my $html = ''; |
97
|
|
|
|
|
|
|
$self->log->debug("Template for $path: blocks/$base_block/block.tt => " . Dumper $data); |
98
|
|
|
|
|
|
|
$self->template->process( |
99
|
|
|
|
|
|
|
"blocks/$base_block/block.tt", |
100
|
|
|
|
|
|
|
{ |
101
|
|
|
|
|
|
|
%{ $params || {} }, |
102
|
|
|
|
|
|
|
block => $data, |
103
|
|
|
|
|
|
|
bem => $self, |
104
|
|
|
|
|
|
|
styles => { href => '?bem=1&bem_type=styles' }, |
105
|
|
|
|
|
|
|
scripts => { src => '?bem=1&bem_type=scripts' }, |
106
|
|
|
|
|
|
|
}, |
107
|
|
|
|
|
|
|
\$html, |
108
|
|
|
|
|
|
|
) || do { |
109
|
|
|
|
|
|
|
$html = $self->template->error; |
110
|
|
|
|
|
|
|
}; |
111
|
|
|
|
|
|
|
$self->log->debug('processed html'); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# if debug mode do nothing |
114
|
|
|
|
|
|
|
# if prod mode generate js & css files (concat & compress) |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
return $html; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub get_styles { |
120
|
|
|
|
|
|
|
my ($self, $path, $args, $params) = @_; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# get processed data |
123
|
|
|
|
|
|
|
my $instance = $self->get_instance($path, $params); |
124
|
|
|
|
|
|
|
my $data = $instance->get_data($params); |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# set template path per config |
127
|
|
|
|
|
|
|
my $paths = $self->set_template_path($instance); |
128
|
|
|
|
|
|
|
my $blocks = $instance->blocks; |
129
|
|
|
|
|
|
|
my @css; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
BLOCK: |
132
|
|
|
|
|
|
|
for my $block ( keys %$blocks ) { |
133
|
|
|
|
|
|
|
for my $path (@$paths) { |
134
|
|
|
|
|
|
|
if ( -s "$path/blocks/$block/block.css" ) { |
135
|
|
|
|
|
|
|
push @css, file "$path/blocks/$block/block.css"; |
136
|
|
|
|
|
|
|
next BLOCK; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
return join "\n", |
142
|
|
|
|
|
|
|
map { |
143
|
|
|
|
|
|
|
"/* FILE : $_ */\n" |
144
|
|
|
|
|
|
|
. $_->slurp; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
@css; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
sub get_scripts { |
150
|
|
|
|
|
|
|
my ($self, $path, $args, $params) = @_; |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# get processed data |
153
|
|
|
|
|
|
|
my $instance = $self->get_instance($path, $params); |
154
|
|
|
|
|
|
|
my $data = $instance->get_data($params); |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# set template path per config |
157
|
|
|
|
|
|
|
my $paths = $self->set_template_path($instance); |
158
|
|
|
|
|
|
|
my $blocks = $instance->blocks; |
159
|
|
|
|
|
|
|
my @js; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
BLOCK: |
162
|
|
|
|
|
|
|
for my $block ( keys %$blocks ) { |
163
|
|
|
|
|
|
|
for my $path (@$paths) { |
164
|
|
|
|
|
|
|
if ( -s "$path/blocks/$block/block.js" ) { |
165
|
|
|
|
|
|
|
push @js, file "$path/blocks/$block/block.js"; |
166
|
|
|
|
|
|
|
next BLOCK; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
return join "\n", |
172
|
|
|
|
|
|
|
map { |
173
|
|
|
|
|
|
|
"/* FILE : $_ */\n" |
174
|
|
|
|
|
|
|
. $_->slurp; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
@js; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
sub block_module { |
180
|
|
|
|
|
|
|
my ($self, $block) = @_; |
181
|
|
|
|
|
|
|
return $self->block_map->{$block} if exists $self->block_map->{$block}; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
my $module = 'Data::Context::BEM::Block::' . ucfirst $block; |
184
|
|
|
|
|
|
|
my $file = "$module.pm"; |
185
|
|
|
|
|
|
|
$file =~ s{::}{/}gxms; |
186
|
|
|
|
|
|
|
eval { require $file }; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
return $self->block_map->{$block} = $EVAL_ERROR ? undef : $module; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
sub set_template_path { |
192
|
|
|
|
|
|
|
my ($self, $instance, $device_path) = @_; |
193
|
|
|
|
|
|
|
my $delimiter = $self->template->{DELIMITER} || ':'; |
194
|
|
|
|
|
|
|
my @paths = split /$delimiter/, $self->template_path; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
my $blocks = $instance->blocks; |
197
|
|
|
|
|
|
|
$self->log->debug('found blocks : ' . join ", ", keys %$blocks); |
198
|
|
|
|
|
|
|
for my $block ( keys %$blocks ) { |
199
|
|
|
|
|
|
|
$self->log->debug($block); |
200
|
|
|
|
|
|
|
next if !$self->block_module($block); |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
my $dir = module_dir( $self->block_module($block) ); |
203
|
|
|
|
|
|
|
$self->log->info( 'module_dir ' . Dumper { $block => $dir } ) if $self->debug <= 2; |
204
|
|
|
|
|
|
|
next if !$dir || !-d $dir; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
push @paths, $dir; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
push @paths, dist_dir('Data-Context-BEM'); |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# construct page extras |
211
|
|
|
|
|
|
|
my @extras; |
212
|
|
|
|
|
|
|
$self->log->debug('setting extra path info'); |
213
|
|
|
|
|
|
|
if ($device_path) { |
214
|
|
|
|
|
|
|
# TODO implement |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
for my $provider (@{ $self->template_providers }) { |
218
|
|
|
|
|
|
|
$provider->include_path(\@paths); |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
$self->log->debug('template paths = ', join ', ', @paths); |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
return \@paths; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub get_template { |
226
|
|
|
|
|
|
|
my ($self, $block) = @_; |
227
|
|
|
|
|
|
|
return "blocks/$block->{block}/block.tt"; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
sub dump { |
231
|
|
|
|
|
|
|
my $self = shift; |
232
|
|
|
|
|
|
|
$self->log->warn(Dumper @_); |
233
|
|
|
|
|
|
|
return; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub class { |
237
|
|
|
|
|
|
|
my ($self, $block) = @_; |
238
|
|
|
|
|
|
|
my @class = ( $block->{block} ); |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
# Add any modifiers |
241
|
|
|
|
|
|
|
for my $mod (@{ $block->{mods} || [] }) { |
242
|
|
|
|
|
|
|
if ( ! ref $mod ) { |
243
|
|
|
|
|
|
|
push @class, $mod; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
elsif ( ref $mod eq 'HASH' ) { |
246
|
|
|
|
|
|
|
push @class, join '_', keys %$mod, values %$mod; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# TODO make this work for elements |
251
|
|
|
|
|
|
|
return join ' ', @class; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
sub _template { |
255
|
|
|
|
|
|
|
my ($self) = @_; |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
my $template = Template->new( |
258
|
|
|
|
|
|
|
); |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
return $template; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
1; |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
__END__ |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=head1 NAME |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Data::Context::BEM - A Perl implementation of BEM |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=head1 VERSION |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
This documentation refers to Data::Context::BEM version 0.0.3 |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=head1 SYNOPSIS |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
use Data::Context::BEM; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
# Brief but working code example(s) here showing the most common usage(s) |
282
|
|
|
|
|
|
|
# This section will be as far as many users bother reading, so make it as |
283
|
|
|
|
|
|
|
# educational and exemplary as possible. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=head1 DESCRIPTION |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
BEM is a framework/protocol for how to build HTML or XML pages. The specification |
288
|
|
|
|
|
|
|
suggests how to assemble a page using Blocks, Elements and Modifiers. |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
The essence of this module is to provide a perl implementation that particularly |
291
|
|
|
|
|
|
|
allows the easy packaging of Blocks so they can be distributed alone and used |
292
|
|
|
|
|
|
|
by any site using this library. The aim is also that any site using this module |
293
|
|
|
|
|
|
|
can overwrite any part of an external block. |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=head2 Deployed Blocks |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
Here is what an example block (Example) might look like: |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
lib/MyApp/BEM/Block/Example.pm |
300
|
|
|
|
|
|
|
root/block/example/block.js |
301
|
|
|
|
|
|
|
root/block/example/block.css |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=head3 C<get_html ( )> |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
Get the processed HTML |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=head3 C<get_styles ( )> |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
Get the processed Javascript |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=head3 C<get_scripts ( )> |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
Get the processed CSS |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=head3 C<block_module ($block)> |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
Returns a module that belongs to a block (if one exists) |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=head3 C<set_template_path ( $instance, $device_path )> |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
Fora given L<Data::Context::BEM::Instance> sets the L<Template> path based |
324
|
|
|
|
|
|
|
on the specified C<template_path> and the blocks used. |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=head3 C<get_template ($block)> |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
For a given block returns the template name used to process that block. |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=head3 C<dump (@objects)> |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
Dumps the passed objects to the log file |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=head3 C<class ($block)> |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
Returns the classes for a block. |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=head1 DIAGNOSTICS |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=head1 CONFIGURATION AND ENVIRONMENT |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=head1 INCOMPATIBILITIES |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
=head1 HISTORY |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
While this is an attempt at implementing Yandex's BEM protocol it is also |
349
|
|
|
|
|
|
|
influenced by work of one of the people who originally started the work at |
350
|
|
|
|
|
|
|
Yandex but left before it had evolved into BEM. |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
There are no known bugs in this module. |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
Please report problems to Ivan Wills (ivan.wills@gmail.com). |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
Patches are welcome. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=head1 AUTHOR |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
Ivan Wills - (ivan.wills@gmail.com) |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
Copyright (c) 2013 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077). |
367
|
|
|
|
|
|
|
All rights reserved. |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or modify it under |
370
|
|
|
|
|
|
|
the same terms as Perl itself. See L<perlartistic>. This program is |
371
|
|
|
|
|
|
|
distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; |
372
|
|
|
|
|
|
|
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A |
373
|
|
|
|
|
|
|
PARTICULAR PURPOSE. |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=cut |