lib/Tree/Transform/XSLTish.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160

package Tree::Transform::XSLTish; 
use strict;
use warnings;
use Sub::Exporter;
use Params::Validate ':all';
use Tree::Transform::XSLTish::Utils;
use Tree::Transform::XSLTish::Transformer;
use Carp::Clan qw(^Tree::Transform::XSLTish);
 
our $VERSION='0.1';
 
my @DEFAULT_EXPORTS=('tree_rule',
                     'default_rules',
                     'new_transformer' => {-as => 'new'});
 
Sub::Exporter::setup_exporter({
    exports => [qw(tree_rule default_rules new_transformer engine_class engine_factory)],
    groups => {
        default => \@DEFAULT_EXPORTS,
        engine => [@DEFAULT_EXPORTS, qw(engine_class engine_factory)],
    }
});
 
sub default_rules {
    my $store=Tree::Transform::XSLTish::Utils::_rules_store(scalar caller);
 
    push @{$store->{by_match}},
        {match=> '/',priority=>0,action=>sub { $_[0]->apply_rules } },
        {match=> '*',priority=>0,action=>sub { $_[0]->apply_rules } },
            ;
    return;
}
 
sub tree_rule {
    my (%args)=validate(@_, {
        match => { type => SCALAR, optional => 1 },
        action => { type => CODEREF },
        name => { type => SCALAR, optional => 1},
        priority => { type => SCALAR, default => 1 },
    });
 
    # TODO at least one of 'name' and 'match' must be specified 
    # TODO default priority mased on match 
 
    my $store=Tree::Transform::XSLTish::Utils::_rules_store(scalar caller);
 
    if ($args{match}) {
        push @{$store->{by_match}},\%args;
    }
    if ($args{name}) {
        if (exists $store->{by_name}{$args{name}}) {
            carp "Duplicate rule named $args{name}, ignoring";
            return;
        }
        $store->{by_name}{$args{name}}=\%args;
    }
 
    return;
}
 
sub engine_class {
    my ($classname)=@_;
 
    my $factory=Tree::Transform::XSLTish::Utils::_engine_factory(scalar caller);
    $$factory=sub{$classname->new()};
 
    return;
}
 
sub engine_factory(&) {
    my ($new_factory)=@_;
 
    my $factory=Tree::Transform::XSLTish::Utils::_engine_factory(scalar caller);
    $$factory=$new_factory;
 
    return;
}
 
sub _transformer_class { 'Tree::Transform::XSLTish::Transformer' };
 
sub new_transformer {
    my $rules_package=shift;
 
    return _transformer_class->new(rules_package=>$rules_package,@_);
}
 
1;
__END__
 
=head1 NAME
 
Tree::Transform::XSLTish - transform tree data, like XSLT but in Perl
 
=head1 SYNOPSIS
 
  package MyTransform;
  use Tree::Transform::XSLTish;
 
  default_rules;
 
  tree_rule match => 'node[@id=5]', action => sub {
    return $_[0]->it->data();
  };
 
  package main;
  use My::Tree;
 
  my $tree= My::Tree->new();
  # build something inside the tree
 
  my ($node5_data)=MyTransform->new->transform($tree);
 
Transforming an HTML document:
 
 package HtmlTransform;
 use Tree::Transform::XSLTish;
 use strict;
 use warnings;
 
 default_rules;
 
 tree_rule match => 'img[@alt="pick"]', action => sub {
     return $_[0]->it->findvalue('@src');
 };
 
 package main;
 use XML::XPathEngine;
 use HTML::TreeBuilder::XPath;
 
 my $tree=HTML::TreeBuilder::XPath->new();
 $tree->parse_file('mypage.html');
 
 my $trans=HtmlTransform->new(engine=>XML::XPathEngine->new());
 my ($image_srce)=$trans->transform($tree);
 
=head1 DESCRIPTION
 
This module allows you to transform tree with Perl subroutines, just
like XSLT does for XML documents.
 
It tries to model as closely as reasonable the semantic of XSLT.
 
=head1 REQUIREMENTS
 
By default, this module uses L<Tree::XPathEngine> as its XPath engine,
but you can use any other similar module, provided it implements the
method C<findnodes> with the same signature and
meaning. L<XML::XPathEngine> is a good candidate, or you could use
L<XML::LibXML::XPathContext>.
 
The tree that you intend to manipulate must be implemented by classes
that are compatible with the XPath engine; for example,
L<Tree::DAG_Node::XPath> if you use L<Tree::XPathEngine>, or
L<HTML::TreeBuilder::XPath> if you use L<XML::XPathEngine>.
 
=head1 AUTHOR
 
Gianni Ceccarelli <dakkar@thenautilus.net>
 
=cut