From f9fce9e34a1750038eee3a858cfec018d8cdf6e5 Mon Sep 17 00:00:00 2001
From: Gianni Ceccarelli <dakkar@dechirico.(none)>
Date: Wed, 25 Mar 2009 15:33:22 +0100
Subject: initial stab at tree-building

---
 lib/Tree/Template/Declare.pm | 52 +++++++++++++++++++++++++++++++++++++
 t/01-basic.t                 | 25 ++++++++++++++++++
 t/02-xslt.t                  | 62 ++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 139 insertions(+)
 create mode 100644 lib/Tree/Template/Declare.pm
 create mode 100644 t/01-basic.t
 create mode 100644 t/02-xslt.t

diff --git a/lib/Tree/Template/Declare.pm b/lib/Tree/Template/Declare.pm
new file mode 100644
index 0000000..372781b
--- /dev/null
+++ b/lib/Tree/Template/Declare.pm
@@ -0,0 +1,52 @@
+package Tree::Template::Declare;
+use strict;
+use warnings;
+use Sub::Exporter;
+use Tree::DAG_Node::XPath;
+
+our $VERSION='0.1';
+
+Sub::Exporter::setup_exporter({
+    exports => [qw(tree node name attribs)],
+    groups => {
+        default => [qw(tree node name attribs)],
+    }
+});
+
+our $current_node;
+
+sub tree(&) {
+    local $current_node=undef;
+    my ($ret)=$_[0]->();
+    #warn "returning @{[ $ret->name ]}\n";
+    return $ret;
+}
+
+sub node(&) {
+    my $node=Tree::DAG_Node::XPath->new();
+    #warn "new node\n";
+    {
+        local $current_node=$node;
+        $_[0]->();
+    }
+    if ($current_node) {
+        #warn "adding to parent (@{[ $current_node->name ]})\n";
+        $current_node->add_daughter($node);
+    }
+    return $node;
+}
+
+sub name($) {
+    #warn "setting name ($_[0])\n";
+    $current_node->name($_[0]);
+}
+
+sub attribs {
+    my %attrs=@_;
+    #warn "setting attributes\n";
+    $current_node->attributes(\%attrs);
+    return;
+}
+
+
+1;
diff --git a/t/01-basic.t b/t/01-basic.t
new file mode 100644
index 0000000..a063a2f
--- /dev/null
+++ b/t/01-basic.t
@@ -0,0 +1,25 @@
+#!perl
+use Test::Most 'no_plan','die';
+use strict;
+use warnings;
+use Tree::Template::Declare;
+use Data::Dumper;
+
+my $tree=tree {
+    node {
+        name 'root';
+        attribs name => 'none';
+        node {
+            name 'coso1';
+            attribs name => 'coso_1';
+        };
+        node {
+            name 'coso2';
+        };
+    };
+};
+
+diag $_ for @{$tree->draw_ascii_tree()};
+is_deeply($tree->tree_to_lol(),
+          [['coso1'],['coso2'],'root'],
+          'built the tree');
diff --git a/t/02-xslt.t b/t/02-xslt.t
new file mode 100644
index 0000000..0870716
--- /dev/null
+++ b/t/02-xslt.t
@@ -0,0 +1,62 @@
+#!perl
+
+package Copy;{
+use Tree::Transform::XSLTish;
+use Tree::Template::Declare;
+use strict;
+use warnings;
+
+tree_rule match => '/', action => sub {
+    my $t=$_[0];
+    tree {
+        $t->apply_rules;
+    };
+};
+
+tree_rule match => '*', priority => 0, action => sub {
+    my $t=$_[0];
+    node {
+        name $t->it->name;
+        attribs %{$t->it->attributes};
+        $t->apply_rules;
+    };
+};
+
+}
+
+package main;
+use Test::Most 'no_plan','die';
+use strict;
+use warnings;
+use Tree::Template::Declare;
+use Data::Dumper;
+
+sub Tree::DAG_Node::XPath::Root::xpath_get_root_node { return $_[0] }
+sub Tree::DAG_Node::XPath::Root::xpath_get_parent_node { return }
+
+my $tree=tree {
+    node {
+        name 'root';
+        attribs name => 'none';
+        node {
+            name 'coso1';
+            attribs name => 'coso_1';
+        };
+        node {
+            name 'coso2';
+            node {
+                name 'coso3';
+            };
+        };
+    };
+};
+
+diag "transforming";
+my $trans=Copy->new();
+my ($tree2)=$trans->transform($tree);
+
+diag "comparing";
+is($tree->tree_to_lol_notation(),
+   $tree2->tree_to_lol_notation(),
+   'tree copy');
+
-- 
cgit v1.2.3