has
'helper'
,
is
=>
'ro'
;
has
'wrapper'
,
is
=>
'ro'
;
has
'template'
,
is
=>
'ro'
,
required
=> 1;
has
'encoding'
,
is
=>
'ro'
,
default
=>
'UTF-8'
;
has
'loop_var'
,
is
=>
'ro'
,
default
=>
'loop'
;
has
'metadata_key'
,
is
=>
'ro'
,
default
=>
'meta'
;
has
'handlers'
,
is
=>
'ro'
,
default
=>
sub
{ [] };
has
'active_handlers'
,
is
=>
'rw'
;
has
'inactive_handlers'
,
is
=>
'rw'
;
has
'internal_id_attribute'
,
is
=>
'ro'
,
default
=>
'data-plift-id'
;
has
'_load_template'
,
is
=>
'ro'
,
required
=> 1,
init_arg
=>
'load_template'
;
has
'_load_snippet'
,
is
=>
'ro'
,
required
=> 1,
init_arg
=>
'load_snippet'
;
has
'document'
,
is
=>
'rw'
,
init_arg
=>
undef
;
has
'is_rendering'
,
is
=>
'rw'
,
init_arg
=>
undef
,
default
=> 0;
has
'_data_stack'
,
is
=>
'ro'
,
init_arg
=>
undef
,
default
=>
sub
{ [] };
has
'_directive_stack'
,
is
=>
'ro'
,
init_arg
=>
undef
,
default
=>
sub
{ [] };
sub
AUTOLOAD {
my
$self
=
shift
;
my
(
$package
,
$method
) =
our
$AUTOLOAD
=~ /^(.+)::(.+)$/;
Carp::croak
"Undefined subroutine &${package}::$method called"
unless
Scalar::Util::blessed
$self
&&
$self
->isa(__PACKAGE__);
return
if
$method
eq
'DESTROY'
;
Carp::croak
qq{Can't locate object method "$method" via package "$package"}
unless
$self
->helper &&
$self
->helper->can(
$method
);
$self
->helper->
$method
(
@_
);
}
sub
BUILD {
my
$self
=
shift
;
foreach
my
$attr
(
qw/ active_handlers inactive_handlers/
) {
$self
->
$attr
({
map
{
$_
=> 1 } @{
$self
->
$attr
} })
if
$self
->
$attr
;
}
}
sub
metadata {
my
$self
=
shift
;
my
$key
=
$self
->metadata_key;
my
$data
=
$self
->data;
$data
->{
$key
} = {}
unless
exists
$data
->{
$key
};
$data
->{
$key
};
}
sub
data {
my
$self
=
shift
;
my
$stack
=
$self
->_data_stack;
push
@$stack
, +{}
if
@$stack
== 0;
$stack
->[-1];
}
sub
_push_stack {
my
(
$self
,
$data_point
) =
@_
;
my
$data
=
$self
->get(
$data_point
) || {};
push
@{
$self
->_data_stack},
$data
;
$self
;
}
sub
_pop_stack {
my
(
$self
) =
@_
;
pop
@{
$self
->_data_stack};
$self
;
}
sub
directives {
my
$self
=
shift
;
my
$stack
=
$self
->_directive_stack;
push
@$stack
, +{
directives
=> [],
selector
=>
''
,
}
if
@$stack
== 0;
$stack
->[-1];
}
sub
rewind_directive_stack {
my
(
$self
,
$element
) =
@_
;
unless
(
defined
$element
) {
my
$directive_stack
=
$self
->_directive_stack;
pop
@$directive_stack
while
(
@$directive_stack
> 1);
return
;
}
my
$stack
=
$self
->_directive_stack;
while
(
@$stack
> 1) {
my
$parent
=
$element
->parent;
my
$parent_selector
=
$stack
->[-1]->{selector};
$self
->_parse_matchspec_modifiers(
$parent_selector
);
while
(
$parent
->get(0)->nodeType != 9) {
return
if
$parent
->filter(
$parent_selector
)->size == 1;
$parent
=
$parent
->parent;
}
pop
@$stack
;
}
}
sub
push_at {
my
(
$self
,
$selector
,
$data_point
) =
@_
;
my
$inner_directives
= [];
$self
->at(
$selector
=> {
$data_point
=>
$inner_directives
});
push
@{
$self
->_directive_stack}, {
selector
=>
$selector
,
directives
=>
$inner_directives
};
$self
;
}
sub
pop_at {
my
$self
=
shift
;
pop
@{
$self
->_directive_stack};
$self
;
}
my
$internal_id
= 1;
sub
internal_id {
my
(
$self
,
$node
) =
@_
;
$node
=
$node
->get(0)
if
$node
->isa(
'XML::LibXML::jQuery'
);
unless
(
$node
->hasAttribute(
$self
->internal_id_attribute)) {
$node
->setAttribute(
$self
->internal_id_attribute,
$internal_id
++);
}
return
$node
->getAttribute(
$self
->internal_id_attribute);
}
sub
at {
my
$self
=
shift
;
my
$directives
=
$self
->directives->{directives};
if
(
my
$reftype
=
ref
$_
[0]) {
push
@$directives
, @{
$_
[0]}
if
$reftype
eq
'ARRAY'
;
push
@$directives
, %{
$_
[0]}
if
$reftype
eq
'HASH'
;
}
else
{
push
@$directives
,
@_
;
}
$self
;
}
sub
set {
my
$self
=
shift
;
confess
"set() what?"
unless
defined
$_
[0];
my
$data
=
$self
->data;
if
(
my
$reftype
=
ref
$_
[0]) {
confess
"Invalid parameter given to set(data): data must be a hashref."
unless
$reftype
eq
'HASH'
;
$data
->{
$_
} =
$_
[0]->{
$_
}
for
keys
%{
$_
[0]};
return
$self
;
}
$data
->{
$_
[0]} =
$_
[1];
$self
;
}
sub
get {
my
(
$self
,
$reference
) =
@_
;
my
$data
=
$self
->data;
my
@keys
=
split
/\./,
$reference
;
die
"invalid reference '$reference'"
if
grep
{ !
defined
}
@keys
;
my
$current_path
=
''
;
while
(
defined
(
my
$key
=
shift
@keys
)) {
confess
"get('$reference') error: '$current_path' is undefined."
unless
defined
$data
;
die
"get('$reference') error: can't traverse key '$key': '$current_path' is a non-ref value."
unless
ref
$data
;
$current_path
.=
length
$current_path
?
".$key"
:
$key
;
my
$next_data
;
if
(
ref
$data
eq
'HASH'
) {
$next_data
=
$data
->{
$key
};
}
elsif
(
ref
$data
eq
'ARRAY'
) {
confess
"get('$reference') error: '$current_path' is an array and '$key' is not a numeric index."
unless
$key
=~ /^\-?\d+$/;
$next_data
=
$data
->[
$key
];
}
elsif
(blessed
$data
) {
die
sprintf
(
"get('%s') error: '%s' is an '%s' instance and '%s' is not a existing method."
,
$reference
,
$current_path
,
ref
$data
,
$key
)
unless
$data
->can(
$key
);
$next_data
=
$data
->
$key
;
}
elsif
(
ref
$data
) {
die
sprintf
"get('%s') error: can't traverse key '%s': '%s' is a unsupported ref value (%s)."
,
$reference
,
$key
,
$current_path
,
ref
$data
;
}
$next_data
=
$next_data
->(
$self
,
$data
)
if
ref
$next_data
eq
'CODE'
;
$data
=
$next_data
;
}
$data
=
''
unless
defined
$data
;
return
$data
;
}
sub
process_template {
my
(
$self
,
$template_name
) =
@_
;
local
$self
->{current_file} =
$self
->{current_file};
local
$self
->{current_path} =
$self
->{current_path};
my
$element
=
$self
->load_template(
$template_name
);
$self
->process_element(
$element
);
$element
;
}
sub
load_template {
my
(
$self
,
$name
) =
@_
;
$self
->_load_template->(
$self
,
$name
);
}
sub
process_element {
my
(
$self
,
$element
) =
@_
;
my
$callback
=
sub
{
$self
->_dispatch_handlers(
@_
,
$element
->_new_nodes([
$_
[1]]));
};
my
@handlers
= @{
$self
->handlers };
@handlers
=
grep
{
exists
$self
->active_handlers->{
$_
->{name}} }
@handlers
if
defined
$self
->active_handlers;
@handlers
=
grep
{ !
exists
$self
->inactive_handlers->{
$_
->{name}} }
@handlers
if
defined
$self
->inactive_handlers;
my
$find_xpath
=
join
' | '
,
map
{
$_
->{xpath} }
@handlers
;
my
$filter_xpath
=
$find_xpath
;
$filter_xpath
=~ s{\.//}{./}g;
foreach
my
$node
(
@{
$element
->xfilter(
$filter_xpath
)->{nodes} },
@{
$element
->xfind(
$find_xpath
)->{nodes} }
) {
$self
->_dispatch_handlers(
$node
,
$element
->_new_nodes([
$node
]));
}
}
sub
_dispatch_handlers {
my
(
$self
,
$node
,
$el
) =
@_
;
my
$tagname
=
$node
->localname;
foreach
my
$handler
(@{
$self
->handlers }) {
my
$handler_match
= 0;
if
(
$handler
->{tag} &&
scalar
grep
{
$_
eq
$tagname
} @{
$handler
->{tag}}) {
$handler_match
= 1;
}
elsif
(
$handler
->{attribute}) {
foreach
my
$attr
(@{
$handler
->{attribute}}) {
if
(
$node
->hasAttribute(
$attr
)) {
$handler_match
= 1;
last
;
}
}
}
$handler
->{
sub
}->(
$el
,
$self
)
if
$handler_match
;
}
}
sub
render {
my
(
$self
,
$data
) =
@_
;
@{
$self
->_data_stack } = (
$data
)
if
defined
$data
;
die
"Can't call render() now. We are already rendering."
if
$self
->is_rendering;
$self
->is_rendering(1);
my
$element
=
$self
->process_template(
$self
->template);
if
(
$self
->wrapper) {
my
$wrapper
=
$self
->process_template(
$self
->wrapper);
$wrapper
->insert_after(
$element
);
$wrapper
->find(
'#content'
)->append(
$element
);
$element
=
$wrapper
;
}
$self
->rewind_directive_stack;
$self
->_render_directives(
$element
,
$self
->directives->{directives});
$element
->xfind(
sprintf
'//*[@%s]'
,
$self
->internal_id_attribute)
->remove_attr(
$self
->internal_id_attribute);
$self
->is_rendering(0);
$element
->document;
}
sub
_render_directives {
my
(
$self
,
$el
,
$directives
) =
@_
;
for
(
my
$i
= 0;
$i
<
@$directives
;
$i
+= 2) {
my
$match_spec
=
$directives
->[
$i
];
my
$mod
=
$self
->_parse_matchspec_modifiers(
$match_spec
);
my
(
$selector
,
$attribute
) =
split
'@'
,
$match_spec
;
my
$action
=
$directives
->[
$i
+1];
my
$target_element
=
$el
->find(
$selector
);
$target_element
=
$el
->filter(
$selector
)
if
$target_element
->size == 0;
next
unless
$target_element
->size > 0;
if
(!
ref
$action
) {
my
$value
=
$self
->get(
$action
);
$target_element
->remove
unless
defined
$value
;
$value
= to_json(
$value
)
if
ref
$value
eq
'HASH'
;
$value
= encode
'UTF-8'
,
$value
;
if
(
defined
$attribute
&&
$attribute
ne
'HTML'
) {
$target_element
->attr(
$attribute
,
$value
);
}
else
{
$value
= [
$target_element
->{document}->createTextNode(
$value
)]
unless
defined
$attribute
&&
$attribute
eq
'HTML'
;
$target_element
->contents->remove
unless
$mod
->{prepend} ||
$mod
->{append};
$mod
->{prepend} ?
$target_element
->prepend(
$value
)
:
$target_element
->append(
$value
);
}
}
elsif
(
ref
$action
eq
'ARRAY'
) {
$self
->_render_directives(
$target_element
,
$action
);
}
elsif
(
ref
$action
eq
'HASH'
) {
my
(
$new_data_root
,
$new_directives
) =
%$action
;
my
$new_data
=
$self
->get(
$new_data_root
);
if
(
defined
$new_data
&&
ref
$new_data
eq
'ARRAY'
) {
my
$total
=
@$new_data
;
my
$item_tpl
=
$mod
->{replace} ?
$target_element
->contents
:
$target_element
;
for
(
my
$i
= 0;
$i
<
@$new_data
;
$i
++) {
$self
->_push_stack(
"$new_data_root.$i"
);
local
$self
->data->{
$self
->loop_var} = {
index
=>
$i
+ 1,
total
=>
$total
};
my
$new_item
=
$item_tpl
->clone;
$new_item
->insert_before(
$target_element
);
$self
->_render_directives(
$new_item
,
$new_directives
);
$self
->_pop_stack;
}
$target_element
->remove;
}
else
{
$self
->_push_stack(
$new_data_root
);
$self
->_render_directives(
$target_element
,
$new_directives
);
$self
->_pop_stack;
}
}
elsif
(
ref
$action
eq
'CODE'
) {
$action
->(
$target_element
,
$self
);
}
$target_element
->replace_with(
$target_element
->contents)
if
$mod
->{replace};
}
}
sub
_parse_matchspec_modifiers {
my
%mod
;
$mod
{replace} =
$_
[1] =~ /^\+?\^\+?/;
$mod
{prepend} =
$_
[1] =~ /^\^?\+\^?/;
$mod
{append} =
$_
[1] =~ /\+$/;
$_
[1] =~ s/^[+^]+(?=[\w\.\[\*\
$_
[1] =~ s/(?<=[\w\.\
\
%mod
;
}
sub
run_snippet {
my
(
$self
,
$name
,
$element
,
$params
,
$args
) =
@_
;
(
$name
,
my
$action
) =
split
/\//,
$name
;
my
$snippet
=
$self
->snippet(
$name
,
$params
);
$action
||=
'process'
;
my
$method
=
$snippet
->can(
$action
);
die
"Invalid action '$action' for snippet '$name'."
unless
$method
;
$snippet
->
$method
(
$element
,
$args
&&
ref
$args
eq
'ARRAY'
?
@$args
: ());
}
sub
snippet {
my
(
$self
,
$name
,
$params
) =
@_
;
$params
||= {};
$params
->{context} =
$self
;
$self
->_load_snippet->(
$name
,
$params
);
}
1;