#!/usr/bin/perl
# $Id$
use strict;
use warnings;
our $VERSION = sprintf '0.%d.%d', '\$Revision: 1.0 $' =~ /(\d+)\.(\d+)/xm;
use English qw( -no_match_vars );
use Data::Dumper;

sub d {
    print Data::Dumper->new( [@_] )->Indent(1)->Sortkeys(1)->Terse(1)->Dump;
    return;
}

d thread( get_list('data.txt') );

# construct list from file
sub get_list {
    my $file = shift;
    open my $fh, q{<}, $file
        or die "Cannot open read data from $file: $OS_ERROR\n";
    my @list;
    while ( my $line = <$fh> ) {
        $line =~ /^ (\S+) \s+ (\S+) \s+ (\d+) \s* $/xm
            and push @list, [ $1, $2, $3 ];
    }
    close $fh;
    return \@list;
}

# return an AoA containing THREADED Nodes
sub thread {
    my $list = shift;
    return [] if !@{$list};

    # twist the list (keeping the timestamp): parent -> child
    # as an HoA:
    #   { Parent_ID => [ Child_ID, Child_TS ] }
    my $ch = {};
    foreach ( @{$list} ) {
        push @{ $ch->{ $_->[1] } }, [ $_->[0], $_->[2] ];
    }

    # abuse this structure, moving elements recursively beside their parents
    # => Nodes Array will get one more element: the "Children" A-ref
    my $threader;
    $threader = sub {
        for ( @{ +shift || [] } ) {
            push @{$_}, delete $ch->{ $_->[0] };
            $threader->( $_->[2] );
        }
    };

    for ( keys %{$ch} ) {
        $threader->( $ch->{$_} );
    }

    # drop sibling index info, sorting nodes in its way
    my $redux;
    $redux = sub {
        return [
            map { [ $_->[0], $redux->( $_->[2] ) ] }
                sort { $a->[1] <=> $b->[1] } @{ +shift || [] }
        ];
    };

    # drop timestamp info keeping only IDs
    return $redux->( $ch->{0} );
}