#!/usr/bin/perl -w

# cleave - Partition a string into all possible fragments.
# 030223 - Gene boggs

use strict;
use Tree::DAG_Node;

my $word = shift @ARGV || die "Usage: $0 string\n";
my $tree = Tree::DAG_Node->new({ name => $word });

my @lex  = @ARGV ? @ARGV : qw(par part i tion on);
my %dict;
@dict{@lex} = ();

my %parts;  # our (global variable) universe

cleave ($word, $tree);

print join "\n", @{ $tree->draw_ascii_tree };

#use Data::Dumper;warn Dumper(\%parts);

sub cleave {
    my $string = shift;
#    print "$string: [\n";
    my $branch = shift;

    for my $n (1 .. length $string) {
#        print "\t$n ", join ('.', bisect($string, $n)), "\n";
        my ($left, $right) = bisect($string, $n);

        my ($l_node, $r_node);
        if ($branch) {
            my $node = $branch->new_daughter({ name => "$left.$right" })
                if $left && $right;
            $l_node = $node->new_daughter({ name => $left })
                if not_same ($left, $string);# && has_parts ($left);# && is_known ($left);
            $r_node = $node->new_daughter({ name => $right })
                if not_same ($right, $string);# && has_parts ($right);# && is_known ($right);
        }

        cleave ($left, $l_node)
            if not_same ($left, $string) && has_parts ($left);# && !is_known ($left);
        cleave ($right, $r_node)
            if not_same ($right, $string) && has_parts ($right);# && !is_known ($right);

#        $parts{$left} = undef if is_unseen ($left);
#        $parts{$right} = undef if is_unseen ($right);
    }

#    print "]\n";
}

sub not_same {
    my ($item, $str) = @_;
    return $item && $item ne $str;
}
sub is_unseen {
    my $item = shift;
    return $item && !exists $parts{$item};
}
sub has_parts {
    my $item = shift;
    return $item && length ($item) > 1;
}
sub is_known {
    my $item = shift;
    return $item && exists $dict{$item};
}

# Bisect the string after the i'th character.
# Only "greater than zero" integers make sense.
sub bisect {
    my ($str, $i) = @_;
    return if !$str || length ($str) <= 1;
    return substr ($str, 0, $i),
        $i < length ($str)
            ? substr ($str, $i, length ($str) - $i)
            : ();
}