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

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';
 
Sub::Exporter::setup_exporter({
    exports => [qw(tree_rule default_rules new_transformer)],
    groups => {
        default => [ 'tree_rule',
                     'default_rules',
                     'new_transformer' => {-as => 'new'} ],
    }
});
 
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 _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);
 
=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
 
=head1 AUTHOR
 
Gianni Ceccarelli <dakkar@thenautilus.net>
 
=cut