summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGianni Ceccarelli <dakkar@dechirico.(none)>2009-03-19 14:45:23 +0100
committerGianni Ceccarelli <dakkar@dechirico.(none)>2009-03-19 14:45:23 +0100
commit8abf3c4080812b0295bbd9b3f658f77d60d76f22 (patch)
tree9e694bfe52d38cbc7d63edfbaf1c9fafe6fe9341
parentthe great renaming (diff)
parentthe great renaming, part 2 (diff)
downloadTree-Transform-XSLTish-8abf3c4080812b0295bbd9b3f658f77d60d76f22.tar.gz
Tree-Transform-XSLTish-8abf3c4080812b0295bbd9b3f658f77d60d76f22.tar.bz2
Tree-Transform-XSLTish-8abf3c4080812b0295bbd9b3f658f77d60d76f22.zip
renaming merge
-rw-r--r--lib/Tree/Transform.pm77
-rw-r--r--lib/Tree/Transform/Context.pm10
-rw-r--r--lib/Tree/Transform/Transformer.pm186
-rw-r--r--lib/Tree/Transform/Utils.pm21
4 files changed, 0 insertions, 294 deletions
diff --git a/lib/Tree/Transform.pm b/lib/Tree/Transform.pm
deleted file mode 100644
index bf3d18b..0000000
--- a/lib/Tree/Transform.pm
+++ /dev/null
@@ -1,77 +0,0 @@
-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
diff --git a/lib/Tree/Transform/Context.pm b/lib/Tree/Transform/Context.pm
deleted file mode 100644
index 5e70079..0000000
--- a/lib/Tree/Transform/Context.pm
+++ /dev/null
@@ -1,10 +0,0 @@
-package Tree::Transform::Context;
-use Moose;
-use Tree::Transform::Utils;
-use Carp::Clan qw(^Tree::Transform);
-
-has 'current_node' => ( is => 'rw', isa => 'Object' );
-has 'node_list' => ( is => 'rw', isa => 'ArrayRef[Object]' );
-
-__PACKAGE__->meta->make_immutable;no Moose;1;
-__END__
diff --git a/lib/Tree/Transform/Transformer.pm b/lib/Tree/Transform/Transformer.pm
deleted file mode 100644
index 95448af..0000000
--- a/lib/Tree/Transform/Transformer.pm
+++ /dev/null
@@ -1,186 +0,0 @@
-package Tree::Transform::Transformer;
-use Moose;
-use MooseX::AttributeHelpers;
-use Params::Validate ':all';
-use Tree::Transform::Utils;
-use Tree::Transform::Context;
-use Tree::XPathEngine;
-use Carp::Clan qw(^Tree::Transform);
-
-has 'rules_package' => (is => 'ro', isa => 'ClassName');
-
-has 'context_stack' => (
- metaclass => 'Collection::Array',
- is => 'rw',
- isa => 'ArrayRef[Tree::Transform::Context]',
- default => sub { [] },
- provides => {
- last => 'context',
- push => 'enter',
- pop => 'leave',
- empty => 'has_context',
- },
-);
-
-has 'engine' => (
- is => 'ro',
- isa => 'Tree::XPathEngine',
- default => sub { Tree::XPathEngine->new() },
-);
-
-sub it { $_[0]->context->current_node }
-
-sub transform {
- my ($self,$tree)=@_;
-
- return $self->apply_rules($tree->xpath_get_root_node);
-}
-
-sub apply_rules {
- my ($self,@nodes)=@_;
-
- unless (@nodes) {
- unless ($self->has_context) {
- carp 'apply_rules called without nodes nor context!';
- return;
- }
- @nodes=$self->it->xpath_get_child_nodes();
- };
-
- my $guard=Tree::Transform::ContextGuard->new
- ($self,
- Tree::Transform::Context->new(node_list=>\@nodes)
- );
-
- my @ret;
- for my $node (@nodes) {
- $self->context->current_node($node);
-
- #warn "# applying rules to @{[ $node ]}";
-
- my $rule=$self->find_rule();
- push @ret,$rule->{action}->($self);
- }
-
- return @ret;
-}
-
-sub call_rule {
- my ($self,$name)=@_;
-
- unless ($name) {
- carp 'call_rule called without a rule name!';
- return;
- }
-
- unless ($self->has_context) {
- carp 'call_rule called without context!';
- return;
- }
-
- my $rule=$self->find_rule_by_name($name);
- return $rule->{action}->($self);
-}
-
-sub find_rule {
- my ($self,$context)=@_;
-
- for my $pack (Tree::Transform::Utils::_get_inheritance
- ($self->rules_package)) {
- my $ret=$self->find_rule_in_package($pack,$context);
- return $ret if $ret;
- }
-
- croak "No valid rule";
-}
-
-sub find_rule_by_name {
- my ($self,$name,$context)=@_;
-
- for my $pack (Tree::Transform::Utils::_get_inheritance
- ($self->rules_package)) {
- my $ret=$self->find_rule_by_name_in_package($pack,$name,$context);
- return $ret if $ret;
- }
-
- croak "No rule named $name";
-}
-
-sub find_rule_in_package {
- my ($self,$package,$context)=@_;
-
- $context||=$self->context;
-
- my $store=Tree::Transform::Utils::_rules_store($package);
-
- my $rules=$store->{by_match};
-
- my @candidates=
- sort { $b->{priority} <=> $a->{priority} }
- grep { $self->rule_matches($_) } @$rules;
- if (@candidates > 1 and
- $candidates[0]->{priority} ==
- $candidates[1]->{priority}) {
- croak "Ambiguous rule application";
- }
- elsif (@candidates >= 1) {
- return $candidates[0];
- }
-}
-
-sub find_rule_by_name_in_package {
- my ($self,$package,$name,$context)=@_;
-
- $context||=$self->context;
-
- my $store=Tree::Transform::Utils::_rules_store($package);
-
- my $rules=$store->{by_name};
-
- if (exists $rules->{$name}) {
- return $rules->{$name};
- }
-}
-
-sub rule_matches {
- my ($self,$rule,$context)=@_;
-
- $context||=$self->context;
-
- my $node=$context->current_node;
- my $path=$rule->{match};
-
- # XXX check the semantic
-
- my $base_node=$node;
- while (1) {
-
- #warn "# Testing <$path> against @{[ $node ]} based on @{[ $base_node ]}";
-
- if ($self->engine->matches($node,$path,$base_node)) {
- return 1;
- }
- if ($base_node->xpath_is_document_node) {
- return;
- }
- $base_node=$base_node->xpath_get_parent_node;
- }
- return;
-}
-
-__PACKAGE__->meta->make_immutable;no Moose;
-
-package Tree::Transform::ContextGuard;
-
-sub new {
- my ($class,$trans,$context)=@_;
- $trans->enter($context);
- return bless {trans=>$trans},$class;
-}
-
-sub DESTROY {
- $_[0]->{trans}->leave();
-}
-
-1;
-__END__
diff --git a/lib/Tree/Transform/Utils.pm b/lib/Tree/Transform/Utils.pm
deleted file mode 100644
index cdc58f7..0000000
--- a/lib/Tree/Transform/Utils.pm
+++ /dev/null
@@ -1,21 +0,0 @@
-package Tree::Transform::Utils;
-use strict;
-use warnings;
-use Class::MOP;
-
-my $RULES_NAME='%_tree_transform_rules';
-
-sub _rules_store {
- my $pack=Class::MOP::Class->initialize($_[0]);
-
- if (! $pack->has_package_symbol($RULES_NAME) ) {
- $pack->add_package_symbol($RULES_NAME,{});
- }
- return $pack->get_package_symbol($RULES_NAME);
-}
-
-sub _get_inheritance {
- return Class::MOP::Class->initialize($_[0])->class_precedence_list;
-}
-
-1;