summaryrefslogtreecommitdiff
path: root/lib/Tree/Transform/XSLTish.pm
blob: bf3d18bc1d3f649cc5add344607bcb2536a596d4 (plain)
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
package Tree::Transform; 
use strict;
use warnings;
use Sub::Exporter;
use Params::Validate ':all';
use Tree::Transform::Utils;
use Tree::Transform::Transformer;
use Carp::Clan qw(^Tree::Transform);
 
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::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::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::Transformer' };
 
sub new_transformer {
    my ($rules_package)=@_;
 
    return _transformer_class->new(rules_package=>$rules_package);
}
 
1;
__END__
 
=head1 NAME
 
Tree::Transform - transform tree data, like XSLT but in Perl
 
=head1 AUTHOR
 
Gianni Ceccarelli <dakkar@thenautilus.net>
 
=cut