[Rt-commit] [svn] r1936 - in Parse-Outline: . ex lib lib/Parse t

[jesse at pallas.eruditorum.org]

Author: jesse
Date: Fri Nov 26 18:46:16 2004
New Revision: 1936

Added:
   Parse-Outline/Makefile.PL
   Parse-Outline/ex/
   Parse-Outline/ex/parse
   Parse-Outline/lib/
   Parse-Outline/lib/Parse/
   Parse-Outline/lib/Parse/Outline.pm
   Parse-Outline/t/
   Parse-Outline/t/basic.t
Modified:
   Parse-Outline/   (props changed)
Log:
 r9352 at tinbook:  jesse | 2004-11-26T23:47:42.656065Z
 Initial commit


Added: Parse-Outline/Makefile.PL
==============================================================================
--- (empty file)
+++ Parse-Outline/Makefile.PL	Fri Nov 26 18:46:16 2004
@@ -0,0 +1,3 @@
+use inc::Module::Install;
+version_from('lib/Parse/Outline.pm');
+&WriteAll();

Added: Parse-Outline/ex/parse
==============================================================================
--- (empty file)
+++ Parse-Outline/ex/parse	Fri Nov 26 18:46:16 2004
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w 
+
+use strict;
+use warnings;
+use Parse::Outline;
+use YAML;
+
+my $file = shift @ARGV;
+
+open(FILE, "<$file") || die $@;
+
+my @lines = map { chomp; $_ } <FILE>;
+close(FILE);
+
+my $o = Parse::Outline->new();
+my $lines = $o->parse_template(@lines);
+my ($tree, undef) = $o->build_tree($lines,0);
+
+            $tree->traverse(
+                sub {
+                    my ($_tree) = @_;
+                    print( ($_tree->getDepth .  "\t" x $_tree->getDepth() ),
+                        $_tree->getNodeValue()->{'content'}, "\n" );
+                }
+            );
+
+                                                                          

Added: Parse-Outline/lib/Parse/Outline.pm
==============================================================================
--- (empty file)
+++ Parse-Outline/lib/Parse/Outline.pm	Fri Nov 26 18:46:16 2004
@@ -0,0 +1,96 @@
+use warnings;
+use strict;
+use Tree::Simple;
+
+
+package Parse::Outline;
+use vars qw/$VERSION/;
+
+$VERSION = '0.00_00';
+
+
+sub new {
+    my $proto = shift;
+    my $self = {};
+    bless $self, $proto;
+    return $self;
+}
+
+
+sub parse_template {
+    my $self = shift;
+    my @in = (@_);
+    my $i;
+    my @array = ();
+    for (@in) {
+        # Tabs are 8 spaces
+        s/\t/        /go;
+        s/^(\s*)//;
+        # Skip comments        
+        my $depth = length($1);
+        # Skip blank lines
+        my $line  = $_;
+        chomp $line;
+        next unless ($line);
+
+
+        my $obj = { id => $i++, depth => $depth};
+
+
+        if ($line =~ /^#\s*?(.*)$/gio) {
+            next;
+            #$obj->{comment} = $1;
+        } else{
+            $obj->{content} = $line;
+        }
+
+        push ( @array, $obj );
+    }
+    return ( \@array );
+}
+
+# }}}
+
+# {{{ sub build_tree
+sub build_tree {
+    my $self = shift;
+    my $lines = shift;
+
+    my $tree = Tree::Simple->new({depth => -1} , Tree::Simple->ROOT);
+    my $cursor = $tree;
+
+     foreach my $item (@$lines) {
+    #    see if it's deeper than the current node in the tree.
+
+    # If the item is shallower than our cursor, walk up the tree
+    # until we find somewhere to stick it.
+    while ( $item->{depth} < $cursor->getNodeValue->{depth}) {
+        $cursor = $cursor->getParent();
+    }
+
+    #    if it is the same depth, add a new sibling
+    if ($item->{depth}  == $cursor->getNodeValue->{'depth'}) {
+         $cursor->addSibling(Tree::Simple->new($item));
+         $cursor=$cursor->getSibling(-1);
+        
+    }
+    #    if it is deeper, add a new child.
+    elsif ($item->{depth} >= $cursor->getNodeValue->{'depth'}) {
+         $cursor->addChild(Tree::Simple->new($item));
+         $cursor=$cursor->getChild(-1);
+    }
+
+
+}
+
+
+    return($tree);
+
+}
+
+# }}}
+
+
+
+1;
+

Added: Parse-Outline/t/basic.t
==============================================================================
--- (empty file)
+++ Parse-Outline/t/basic.t	Fri Nov 26 18:46:16 2004
@@ -0,0 +1,44 @@
+#!/usr/bin/perl -w 
+use strict;
+use warnings;
+use Data::Dumper;
+use Test::More qw/no_plan/;
+
+# Remove the newlines. return the strings, not the newlines
+
+
+use_ok('Parse::Outline');
+my $o = Parse::Outline->new();
+isa_ok($o, 'Parse::Outline');
+
+can_ok($o,'parse_template');
+can_ok($o,'build_tree');
+
+
+my @data;
+
+ at data = <main::DATA>;
+
+ at data = map { chomp && $_} @data;
+my $array = $o->parse_template(@data);
+my $tree = $o->build_tree ($array);
+
+
+
+
+is($tree->getChildCount, 2, "There are only two children");
+
+
+
+__DATA__
+
+Foo
+    Bar
+    Baz
+
+# Testing
+  Bling
+
+    Bing
+2Foo
+    2Bar