texinfo/tp Texinfo/Common.pm t/test_tree_copy.t

[Patrice Dumas]

CVSROOT:        /sources/texinfo
Module name:    texinfo
Changes by:     Patrice Dumas <pertusus>        11/12/29 23:24:49

Modified files:
        tp/Texinfo     : Common.pm 
Added files:
        tp/t           : test_tree_copy.t 

Log message:
        First attempt at a tree copying function, for now incomplete.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Common.pm?cvsroot=texinfo&r1=1.108&r2=1.109
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/test_tree_copy.t?cvsroot=texinfo&rev=1.1

Patches:
Index: Texinfo/Common.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Common.pm,v
retrieving revision 1.108
retrieving revision 1.109
diff -u -b -r1.108 -r1.109
--- Texinfo/Common.pm   27 Dec 2011 23:11:40 -0000      1.108
+++ Texinfo/Common.pm   29 Dec 2011 23:24:49 -0000      1.109
@@ -1360,6 +1360,62 @@
   }
 }
 
+# TODO
+# also recurse into
+# extra->misc_args, extra->args_index
+# extra->index_entry extra->type
+#
+# extra that should point to other elements: 
+# command_as_argument
+# @block_command_line_contents @brace_command_contents @misc_content 
end_command
+# associated_section part_associated_section associated_node associated_part
+# @prototypes @columnfractions titlepage quotation @author command
+# menu_entry_description menu_entry_name
+# 
+# should point to other elements, or be copied.  And some should be recursed
+# into too.
+# extra->type->content
+# extra->nodes_manuals->[]
+# extra->node_content
+# extra->node_argument
+# extra->explanation_contents
+# extra->menu_entry_node
+# extra->def_arg
+
+
+sub copy_tree($$);
+sub copy_tree($$)
+{
+  my $current = shift;
+  my $parent = shift;
+  my $new = {};
+  $new->{'parent'} = $parent if ($parent);
+  foreach my $key ('type', 'cmdname', 'text') {
+    $new->{$key} = $current->{$key} if (exists($current->{$key}));
+  }
+  foreach my $key ('args', 'contents') {
+    if ($current->{$key}) {
+      $new->{$key} = [];
+      foreach my $child (@{$current->{$key}}) {
+        push @{$new->{$key}}, copy_tree($child, $new);
+      }
+    }
+  }
+  if ($current->{'extra'}) {
+    $new->{'extra'} = {};
+    foreach my $key (keys %{$current->{'extra'}}) {
+      if (!ref($current->{'extra'}->{$key})) {
+        $new->{'extra'}->{$key} = $current->{'extra'}->{$key};
+      }
+    }
+    if ($current->{'extra'}->{'end_command'}) {
+      # FIXME this should be a ref to th eend command instead...
+      $new->{'extra'}->{'end_command'} = 1;
+    }
+  }
+  return $new;
+}
+
 sub modify_tree($$$);
 sub modify_tree($$$)
 {

Index: t/test_tree_copy.t
===================================================================
RCS file: t/test_tree_copy.t
diff -N t/test_tree_copy.t
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ t/test_tree_copy.t  29 Dec 2011 23:24:49 -0000      1.1
@@ -0,0 +1,97 @@
+use strict;
+
+use Test::More;
+BEGIN { plan tests => 3 };
+
+use lib 'maintain/lib/Unicode-EastAsianWidth/lib/';
+use lib 'maintain/lib/libintl-perl/lib/';
+use lib 'maintain/lib/Text-Unidecode/lib/';
+use Texinfo::Parser;
+use Texinfo::Convert::Texinfo;
+use Data::Dumper;
+#use Text::Diff;
+
+ok(1, "modules loading");
+
+my $text = '@setfilename some@@file.ext
+
address@hidden top
address@hidden in @code{top}
+
address@hidden truc blah@@@
+
address@hidden
+Something
+
+* chapter::    description
+* name: other chapter.
+* lone node::
address@hidden menu
+
address@hidden chapter
address@hidden chap
+
address@hidden part
address@hidden other chapter, lone node, chapter, Top
address@hidden other chap
+
address@hidden lone node, ,other chapter, Top
+
address@hidden @code
address@hidden item
address@hidden vtable
+
address@hidden @columnfractions 0.8 0.2
address@hidden multitable
+
address@hidden {trc} {bidule}
address@hidden truc @tab bidule
address@hidden multitable
+
address@hidden a {b} c d
address@hidden deffn
+
address@hidden label, type
address@hidden caption}
address@hidden float
+
address@hidden type
+
address@hidden, a b ccc}.
+
address@hidden cindex
+
address@hidden cp
+
address@hidden trc
address@hidden an authoe
address@hidden second
+T
address@hidden quotation
+
+';
+
+my $tree = Texinfo::Parser::parse_texi_text(undef, $text);
+
+my $copy = Texinfo::Common::copy_tree($tree, undef);
+
+my $texi_tree = Texinfo::Convert::Texinfo::convert($tree);
+
+is ($text, $texi_tree, "tree to texi and original match");
+
+#print STDERR diff(\$text, \$texi_tree);
+
+my $texi_copy = Texinfo::Convert::Texinfo::convert($copy);
+
+#{
+#  local $Data::Dumper::Purity = 1;
+#  local $Data::Dumper::Indent = 1;
+#  print STDERR Data::Dumper->Dump([$copy]);
+#}
+
+
+is ($texi_copy, $texi_tree, "tree and copy to texi match");
+
+#print STDERR diff(\$texi_copy, \$texi_tree);
+
+1;