package Eertree;

use strict;
use warnings;

use Exporter 'import';
our @EXPORT_OK = qw/ ee /;

sub ee {
    my $str = shift;
    my $FULL = shift;   # if true: return "nodes" arrayref "as is", then DIY: 
                        #   extract and expand to palindrome complete list 
                        #   (it's trivial, isn't it?), work with each 
                        #   palindrome's position, do statistics, etc.
                        # if false: just return unique palindromes as a list 
                        #   (note: it's faster because there's less info 
                        #   collected)
                        
    my @nodes = ( 
        { len => -1,    lnk => 0 },
        { len =>  0,    lnk => 0 }
    );
    my $lpspi = 0;      # "longest proper suffix-palindrome index"
                        # (of substring processed so far)
    
    for my $i ( 0 .. length( $str ) - 1 ) {
        my $c = substr $str, $i, 1;
        
        my $current = $lpspi;
        my $n = $nodes[ $current ];
        while ( $c ne substr $str, $i - $n-> { len } - 1, 1 ) {
            $current = $n-> { lnk };
            $n = $nodes[ $current ]
        }
        
        my $suffix;     # trailing palindrome index 
                        # after adding current character
        
        if ( $current == 0 ) {          # lone character "palindrome"
            
            # (note: this and following branches have some code in common i.e.
            # aren't dry, I didn't test whether consolidation would impair 
            # speed, but I think a couple of vague conditionals, instead, 
            # could impair clarity
            
            if ( exists $n-> { edges }{ $c }) {     # already seen?
                $suffix = $n-> { edges }{ $c };
                push @{ $nodes[ $suffix ]{ offsets }}, $i if $FULL
            }
            else {
                my $p = { len => 1, lnk => 1, offsets => [ $i ]};
                push @nodes, $p;
                $n-> { edges }{ $c } = $suffix = $#nodes
            }
        }
        else {
            if ( exists $n-> { edges }{ $c }) {     # already seen?
                $suffix = $n-> { edges }{ $c };
                _descend( $suffix, $i, \@nodes ) if $FULL
            }
            else {
                my $L = 2 + $n-> { len };
                my $p = {
                    len => $L,
                    offsets => [ $i - $L + 1 ],
                };
                push @nodes, $p;
                $n-> { edges }{ $c } = $suffix = $#nodes;
                
                do {
                    $current = $n-> { lnk };
                    $n = $nodes[ $current ];
                } while ( $c ne substr $str, $i - $n-> { len } - 1, 1 );
                $p-> { lnk } = $n-> { edges }{ $c };
                
                _descend( $p-> { lnk }, $i, \@nodes ) if $FULL
            }
        }
        
        # make sure it's "proper"
        $lpspi = ( $i + 1 ) == $nodes[ $suffix ]{ len }
            ? $nodes[ $suffix ]{ lnk }
            : $suffix;
    }
    
    return \@nodes if $FULL;
    splice @nodes, 0, 2;
    return map substr( $str, $_-> { offsets }[ 0 ], $_-> { len }), @nodes
}

sub _descend {
    my ( $x, $i, $nodes ) = @_;
    
    while ( $x > 1 ) {
        my $n_ = $nodes-> [ $x ];
        push @{ $n_-> { offsets }}, $i - $n_-> { len } + 1;
        $x = $n_-> { lnk }
    }
}

1;