#!/usr/bin/perl --
use strict; use warnings;
use Path::Tiny qw/ path /;

Main( @ARGV, __FILE__ );
exit( 0 );


use PPIx::XPath; use Tree::XPathEngine;

sub PPI::Structure::For::initialization {  ( grep { $_->isa('PPI::Stat
+ement') } $_[0]->children )[ 0 ]; }
sub PPI::Structure::For::condition      {  ( grep { $_->isa('PPI::Stat
+ement') } $_[0]->children )[ 1 ]; }
sub PPI::Structure::For::afterthought   {  ( grep { $_->isa('PPI::Stat
+ement') } $_[0]->children )[ 2 ]; }


sub PPI::Token::xf { goto &PPI::Node::xf  }
sub PPI::Node::xf {
    my( $node, $query ) = @_;
    $query = PPIx::XPath->clean_xpath_expr( $query );
    $::pxp ||= Tree::XPathEngine->new();
    return $::pxp->findnodes( $query, $node );
}


BEGIN {
    sub PPI::Element::xpath_nodePath {    
        my $node = shift;
        my $ret  = '';
        $ret .= fullxpath_posonly($node);
        $ret;
    }
    sub fullxpath_posonly {
        my $node = shift;
        my $ret = '';
        my $parent = $node;
        while ($parent and $parent->xpath_get_parent_node  ()) {
            my @res = $parent->xf('preceding-sibling::*[name()="'.$par
+ent->xpath_get_name ().'"]');
            $ret = '['.( @res + 1 ).']' . $ret;
            $ret = '/'.$parent->xpath_get_name () . $ret;
            $parent = $parent->xpath_get_parent_node  ();
        }
        $ret."\n";
    }
}## end of BEGIN


sub Main {
    OutlineSpew( @_ );
    return 0;
}
sub OutlineSpew {
    my( $file ) = @_;
    my $str = path( $file )->slurp_raw;
    my $doc = PPI::Document->new( \$str );
    my $xpath_any_loopif = q{
    
//Statement-Sub
| //Statement-Compound
| //Statement-Break
| //Statement-Given
| //Statement-When

| //Token-Word[
           .= 'elsif'
        or .= 'else'
        or .= 'continue'
        or .= 'do'
        or .= 'until'
        or .= 'while'
    ]
                            };;
    
    my @nodes = $doc->xf( $xpath_any_loopif );
    my @insubs;
    for my $node (  @nodes ){
        my $nopath = $node->xpath_nodePath ;
        if( $nopath =~ /Statement-Sub/ ){
            push @insubs, $node;
            next;
        }
        ImagineIt( $node );
    }
    undef @nodes;
    for my $node ( @insubs ){
        ImagineIt( $node );
    }
    undef @insubs;
}

sub ImagineIt {
    my( $node ) = @_;
    my $nopath = my $nodepath = $node->xpath_nodePath ;
##    warn "$nopath\n"; dd( "$node" );
next if $nopath =~ m{Statement-Scheduled(?:\[\d+\])?$}i;
next if $nopath =~ m{Statement-Package(?:\[\d+\])?$}i;
next if $nopath =~ m{Statement-Include(?:\[\d+\])?$}i;
next if $nopath =~ m{Statement-Variable(?:\[\d+\])?$}i;
next if $nopath =~ m{Statement-Expression(?:\[\d+\])?$}i;
next if $nopath =~ m{Statement-Null(?:\[\d+\])?$}i;
next if $nopath =~ m{Statement-UnmatchedBrace(?:\[\d+\])?$}i;
next if $nopath =~ m{Statement-Unknown(?:\[\d+\])?$}i;
last if $nopath =~ m{Statement-Data(?:\[\d+\])?$}i;
last if $nopath =~ m{Statement-End(?:\[\d+\])?$}i;

    $nodepath =~ s{[^/]+}{}g;
    $nodepath =~ s{/}{    }g;
    my $rest = "";
    if($node->isa('PPI::Statement::Break') ){ # if/else
        $rest .=  "$node" ;
    } elsif($node->isa('PPI::Token::Word') ){ # elsif/continue
        return if $node->parent->isa('PPI::Statement::Compound') ;
## 2015-03-12-02:43:54 because do ... while is just PPI::Statement but
+ while(){} is compound ... GRR PPI
        my $word = "$node";
        $rest .= "$word ";
        print "\n" if $word eq "do" ; ## grr
        if( $word eq "elsif" ){
            $rest .=  ( $node->xf('  ./following-sibling::Structure-Co
+ndition  ' ) )[0];
        } elsif( $word =~ m{while|until}i ){
            my $toin = "";
            my $tok = $node->next_token;
            while( $tok ){
                $toin .=  $tok->isa("PPI::Token::Whitespace") ? " " : 
+"$tok";
                last if $tok eq ";";
                $tok = $tok->next_token;
            }
            $rest .= $toin;
        }
    } elsif( my $type = eval { $node->type } ){ ### if/for/foreach/whi
+le/undef/continue 
        my $realtype = ($node->xf('./Token-Word[1]'))[0];
        my $slist    = ($node->xf('./Structure-List[1]') )[0];;
        my $sfor     = ($node->xf( './Structure-For[1]') )[0];
        if( $slist ){
            $rest .= "$realtype $slist";
        } elsif( $sfor ){
            $rest .= "$realtype ( ".join( ' ; ', $sfor->initialization
+, $sfor->condition, $sfor->afterthought )." ) ";
        } elsif( my $cond = ($node->xf('./Structure-Condition[1]'))[0]
+  ){
            $rest .=  $realtype . $cond ; ## grr unless
        } else {
            if( $nopath =~ m{Token-Word(?:\[\d+\])?$} ){
                $rest .=  "$type" ; ## "continue" from source
            } else {
                return; ## "continue" imagined by PPI
            }
        }
    } elsif( $nopath =~ m{Statement-Given(?:\[\d+\])?$} ){
        my( $given ) = $node->xf('./Structure-Given[1]');
        $rest .= "given $given";
    } elsif( $nopath =~ m{Statement-When(?:\[\d+\])?$} ){
        my( $when ) = $node->xf('./Structure-When[1]');
        if( $when ){
            $rest .= "when $when";
        } else {
            $rest .= "default";
        }
    } elsif( $nopath  =~ m{Statement-Sub(?:\[\d+\])?$} ){
        my( $name ) = $node->name ;
        $rest .=  "\n\n\n\n# sub $name";
    } else {
        $rest .=  '## UHOH ' . ref $node . '  '.$node. " ".Data::Dump:
+:pp( $node );
    }
    
    $nodepath = '   ' x ( () = $nopath =~ m/Statement/g );
    print "$nodepath# $rest\n";
}
__END__
[download]