File Coverage

blib/lib/Data/Context/BEM.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


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