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

our $VERSION = '20150313021350'; ## 2015-03-13-02:13:50

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  = $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;


    my $indent = '   ' x ( () = $nopath =~ m/Statement/g );
    
    if($node->isa('PPI::Statement::Break') ){ # if/else
        return print "$indent# $node\n";
    } elsif($node->isa('PPI::Token::Word') ){ # elsif/continue
        my $word = "$node";
        
        return print "\n$indent# $word\n" if  $word eq "do" ; ## grr
        if( $word eq "elsif" ){
            my $rest = ( $node->xf('  ./following-sibling::Structure-C
+ondition  ' ) )[0];
            return print "$indent# $word $rest\n";
        } elsif( $word =~ m{while|until}i ){
            return if $node->parent->isa('PPI::Statement::Compound') ;
+ ## while(...){...} ## do ...while...; is PPI::Statement
            my $toin = "";
            my $tok = $node->next_token;
            while( $tok ){
                $toin .=  $tok->isa("PPI::Token::Whitespace") ? " " : 
+"$tok";
                last if $tok eq ";";
                $tok = $tok->next_token;
            }
            return print "$indent# $word $toin\n";
        } else {
            return print "$indent# $word\n";
        }
    } 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 ){
            return print "$indent# $realtype $slist\n";
        } elsif( $sfor ){
            my $rest = "$realtype ( ".join( ' ; ', $sfor->initializati
+on, $sfor->condition, $sfor->afterthought )." ) ";
            return print "$indent# $rest\n";
        } elsif( my $cond = ($node->xf('./Structure-Condition[1]'))[0]
+  ){
            return print "$indent# $realtype$cond\n"; ## unless
        } else {
            if( $nopath =~ m{Token-Word(?:\[\d+\])?$} ){
                return print "$indent# $type\n"; ## "continue" from so
+urce
            } else {
                return; ## "continue" imagined by PPI
            }
        }
    } elsif( $nopath =~ m{Statement-Given(?:\[\d+\])?$} ){
        my( $given ) = $node->xf('./Structure-Given[1]');
        return print "$indent# given $given\n";
    } elsif( $nopath =~ m{Statement-When(?:\[\d+\])?$} ){
        my( $when ) = $node->xf('./Structure-When[1]');
        if( $when ){
            return print "$indent# when $when\n"; 
        } else {
            return print "$indent# default\n";
        }
    } elsif( $nopath  =~ m{Statement-Sub(?:\[\d+\])?$} ){
        my( $name ) = $node->name ;
        return print "\n\n\n\n$indent# sub $name\n";
    } else {
        return Uhoh( $indent, $node );
    }
}
sub Uhoh {
    my( $indent, $node ) = @_;
    my $nopath  = $node->xpath_nodePath ;
    my $location = $node->location ;
    ref $location and @$location and $location = join ' ', @$location,
+ '';
    $location ||= '';
    my $uhoh = join ' ', "UHOH location($location) $nopath ",  ref $no
+de , '  ', Data::Dump::pp( "$node" ), ;
    return print "$indent## $uhoh \n";
}

__END__
[download]