File Coverage

blib/lib/Nice/Try.pm

Criterion	Covered	Total	%
statement	486	622	78.1
branch	222	406	54.6
condition	99	172	57.5
subroutine	36	45	80.0
pod	4	7	57.1
total	847	1252	67.6

##----------------------------------------------------------------------------
## A real Try Catch Block Implementation Using Perl Filter - ~/lib/Nice/Try.pm
## Version v1.3.3
## Copyright(c) 2023 DEGUEST Pte. Ltd.
## Author: Jacques Deguest
## Created 2020/05/17
## Modified 2023/01/13
## All rights reserved
##
## This program is free software; you can redistribute  it  and/or  modify  it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package Nice::Try;
BEGIN
{
    require 5.16.0;
    use strict;
    use warnings;
    use warnings::register;
    use vars qw(
        $CATCH $DIED $EXCEPTION $FINALLY $HAS_CATCH @RETVAL $SENTINEL $TRY $WANTARRAY
        $VERSION $ERROR
    );
    # XXX Only for debugging
    # use Devel::Confess;
    use PPI;
    use Filter::Util::Call;
    use Scalar::Util ();
    use List::Util ();
    use Want ();
    our $VERSION = 'v1.3.3';
    our $ERROR;
    our( $CATCH, $DIED, $EXCEPTION, $FINALLY, $HAS_CATCH, @RETVAL, $SENTINEL, $TRY, $WANTARRAY );
}

use strict;
use warnings;

# Taken from Try::Harder version 0.005
our $SENTINEL = bless( {} => __PACKAGE__ . '::SENTINEL' );

sub import
{
    my( $this, @arguments ) = @_ ;
    my $class = CORE::caller();
    my $hash = { @arguments };
    $hash->{debug} = 0 if( !CORE::exists( $hash->{debug} ) );
    $hash->{no_filter} = 0 if( !CORE::exists( $hash->{no_filter} ) );
    $hash->{debug_code} = 0 if( !CORE::exists( $hash->{debug_code} ) );
    $hash->{debug_dump} = 0 if( !CORE::exists( $hash->{debug_dump} ) );
    $hash->{dont_want} = 0 if( !CORE::exists( $hash->{dont_want} ) );
    # We check if we are running under tie and if so we cannot use Want features,
    # because they would trigger a segmentation fault.
    $hash->{is_tied} = 0;
    if( $class->can( 'TIESCALAR' ) || $class->can( 'TIEHASH' ) || $class->can( 'TIEARRAY' ) )
    {
        $hash->{is_tied} = 1;
    }
    require overload;
    $hash->{is_overloaded} = overload::Overloaded( $class ) ? 1 : 0;
    $hash->{no_context} = 0;
    # 2021-05-17 (Jacques): the following was a bad idea as it was indiscriminate and
    # would also affect use of caller outside of try-catch blocks
    # *{"${class}::caller"} = \&{"Nice::Try::caller"};
    filter_add( bless( $hash => ( ref( $this ) || $this ) ) );
}

sub unimport
{
    filter_del();
}

sub caller($;$)
{
    my $where = shift( @_ );
    my $n = shift( @_ );
    # Offsetting our internal call frames
    my $map =
    {
    try => 3,
    catch => 3,
    finally => 5,
    };
    my @info = defined( $n ) ? CORE::caller( int( $n ) + $map->{ $where } ) : CORE::caller( 1 + $map->{ $where } );
    return( @info );
}

sub caller_try { return( &Nice::Try::caller( try => @_ ) ); }

sub caller_catch { return( &Nice::Try::caller( catch => @_ ) ); }

sub caller_finally { return( &Nice::Try::caller( finally => @_ ) ); }

sub filter
{
    my( $self ) = @_ ;
    my( $status, $last_line );
    my $line = 0;
    my $code = '';
    if( $self->{no_filter} )
    {
        filter_del();
        $status = 1;
        $self->_message( 3, "Skiping filtering." ) if( $self->{debug} >= 3 );
        return( $status );
    }
    while( $status = filter_read() )
    {
        # Error
        if( $status < 0 )
        {
            $self->_message( 3, "An error occurred in fiilter, aborting." ) if( $self->{debug} >= 3 );
            return( $status );
        }
        $line++;
#         if( /^__(?:DATA|END)__/ )
#         {
#             $last_line = $_;
#             last;
#         }
        $code .= $_;
        $_ = '';
    }
    return( $line ) if( !$line );
    unless( $status < 0 )
    {
        # $self->_message( 5, "Processing at line $line code:\n$code" );
        # 2021-06-05 (Jacques): fixes the issue No. 3
        # Make sure there is at least a space at the beginning
        $code = ' ' . $code;
        $self->_message( 4, "Processing $line lines of code." ) if( $self->{debug} >= 4 );
        my $doc = PPI::Document->new( \$code, readonly => 1 ) || die( "Unable to parse: ", PPI::Document->errstr, "\n$code\n" );
        # Remove pod
        # $doc->prune('PPI::Token::Pod');
        $self->_browse( $doc ) if( $self->{debug_dump} );
        if( $doc = $self->_parse( $doc ) )
        {
            $_ = $doc->serialize;
            # $doc->save( "./dev/debug-parsed.pl" );
            # $status = 1;
        }
        # Rollback
        else
        {
            # $self->_message( 5, "Nothing found, restoring code to '$code'" );
            $_ = $code;
#             $status = -1;
#             filter_del();
        }
        if( CORE::length( $last_line ) )
        {
            $_ .= $last_line;
        }
    }
    unless( $status <= 0 )
    {
        while( $status = filter_read() )
        {
            $self->_message( 4, "Reading more line: $_" );
            return( $status ) if( $status < 0 );
            $line++;
        }
    }
    # $self->_message( 3, "Returning status '$line' with \$_ set to '$_'." );
    if( $self->{debug_file} )
    {
        if( open( my $fh, ">$self->{debug_file}" ) )
        {
            binmode( $fh, ':utf8' );
            print( $fh $_ );
            close( $fh );
        }
    }
    # filter_del();
    return( $line );
}

sub implement
{
    my $self = shift( @_ );
    my $code = shift( @_ );
    return( $code ) if( !CORE::defined( $code ) || !CORE::length( $code ) );
    unless( ref( $self ) )
    {
        my $opts = ( !@_ || !defined( $_[0] ) )
            ? {}
            : ref( $_[0] ) eq 'HASH'
                ? shift( @_ )
                : !( @_ % 2 )
                    ? { @_ }
                    : {};
        for( qw( debug no_context no_filter debug_code debug_dump debug_file dont_want is_tied is_overloaded ) )
        {
            $opts->{ $_ } //= 0;
        }
        $self = bless( $opts => $self );
    }
    # 2021-06-05 (Jacques): fixes the issue No. 3
    # Make sure there is at least a space at the beginning
    $code = ' ' . $code;
    $self->_message( 4, "Processing ", CORE::length( $code ), " bytes of code." ) if( $self->{debug} >= 4 );
    my $doc = PPI::Document->new( \$code, readonly => 1 ) || die( "Unable to parse: ", PPI::Document->errstr, "\n$code\n" );
    $self->_browse( $doc ) if( $self->{debug_dump} );
    if( $doc = $self->_parse( $doc ) )
    {
        $code = $doc->serialize;
    }
    return( $code );
}

sub _browse
{
    my $self = shift( @_ );
    my $elem = shift( @_ );
    my $level = shift( @_ ) || 0;
    if( $self->{debug} >= 4 )
    {
        $self->_message( 4, "Checking code: ", $self->_serialize( $elem ) );
        $self->_messagef( 4, "PPI element of class %s has children property '%s'.", $elem->class, $elem->{children} );
    }
    return if( !$elem->children );
    foreach my $e ( $elem->elements )
    {
        printf( STDERR "%sElement: [%d] class %s, value %s\n", ( '.' x $level ), $e->line_number, $e->class, $e->content );
        if( $e->can('children') && $e->children )
        {
            $self->_browse( $e, $level + 1 );
        }
    }
}

sub _error
{
    my $self = shift( @_ );
    if( @_ )
    {
        my $txt = join( '', map( ref( $_ ) eq 'CODE' ? $_->() : $_, @_ ) );
        $txt =~ s/[\015\012]+$//g;
        $ERROR = $txt;
        CORE::warn( "$txt\n" ) if( warnings::enabled );
        return;
    }
    return( $ERROR );
}

sub _message
{
    my $self = shift( @_ );
    my $level = $_[0] =~ /^\d+$/ ? shift( @_ ) : 0;
    return if( $self->{debug} < $level );
    my @data = @_;
    my $stackFrame = 0;
    my( $pkg, $file, $line, @otherInfo ) = CORE::caller( $stackFrame );
    my $sub = ( CORE::caller( $stackFrame + 1 ) )[3];
    my $sub2 = substr( $sub, rindex( $sub, '::' ) + 2 );
    my $txt = "${pkg}::${sub2}( $self ) [$line]: " . join( '', map( ref( $_ ) eq 'CODE' ? $_->() : $_, @data ) );
    $txt    =~ s/\n$//gs;
    $txt = '## ' . join( "\n## ", split( /\n/, $txt ) );
    CORE::print( STDERR $txt, "\n" );
}

sub _messagef
{
    my $self = shift( @_ );
    my $level = $_[0] =~ /^\d+$/ ? shift( @_ ) : 0;
    return if( $self->{debug} < $level );
    my @data = @_;
    my $stackFrame = 0;
    my $fmt = shift( @data );
    my( $pkg, $file, $line, @otherInfo ) = CORE::caller( $stackFrame );
    my $sub = ( CORE::caller( $stackFrame + 1 ) )[3];
    my $sub2 = substr( $sub, rindex( $sub, '::' ) + 2 );
    for( @data )
    {
        next if( ref( $_ ) );
        s/\b\%/\x{025}/g;
    }
    my $txt = "${pkg}::${sub2}( $self ) [$line]: " . sprintf( $fmt, map( ref( $_ ) eq 'CODE' ? $_->() : $_, @data ) );
    $txt    =~ s/\n$//gs;
    $txt = '## ' . join( "\n## ", split( /\n/, $txt ) );
    CORE::print( STDERR $txt, "\n" );
}

sub _parse
{
    my $self = shift( @_ );
    my $elem = shift( @_ );
    no warnings 'uninitialized';
    if( !Scalar::Util::blessed( $elem ) || !$elem->isa( 'PPI::Node' ) )
    {
        return( $self->_error( "Element provided to parse is not a PPI::Node object" ) );
    }

    my $ref = $elem->find(sub
    {
        my( $top, $this ) = @_;
        return( $this->class eq 'PPI::Statement' && substr( $this->content, 0, 3 ) eq 'try' );
    });
    return( $self->_error( "Failed to find any try-catch clause: $@" ) ) if( !defined( $ref ) );
    $self->_messagef( 4, "Found %d match(es)", scalar( @$ref ) ) if( $ref && ref( $ref ) && $self->{debug} >= 4 );
    return if( !$ref || !scalar( @$ref ) );

    # 2020-09-13: PPI will return 2 or more consecutive try-catch block as 1 statement
    # It does not tell them apart, so we need to post process the result to effectively search within for possible for other try-catch blocks and update the @$ref array consequently
    # Array to contain the new version of the $ref array.
    my $alt_ref = [];
    $self->_message( 3, "Checking for consecutive try-catch blocks in results found by PPI" ) if( $self->{debug} >= 3 );
    foreach my $this ( @$ref )
    {
        my( @block_children ) = $this->children;
        next if( !scalar( @block_children ) );
        my $tmp_ref = [];
        ## to contain all the nodes to move
        my $tmp_nodes = [];
        my $prev_sib = $block_children[0];
        push( @$tmp_nodes, $prev_sib );
        my $sib;
        while( $sib = $prev_sib->next_sibling )
        {
            # We found a try-catch block. Move the buffer to $alt_ref
            if( $sib->class eq 'PPI::Token::Word' && $sib->content eq 'try' )
            {
                # Look ahead for a block...
                my $next = $sib->snext_sibling;
                if( $next && $next->class eq 'PPI::Structure::Block' )
                {
                    $self->_message( 3, "Found consecutive try-block." ) if( $self->{debug} >= 3 );
                    # Push the previous statement $st to the stack $alt_ref
                    $self->_messagef( 3, "Saving previous %d nodes collected.", scalar( @$tmp_nodes ) ) if( $self->{debug} >= 3 );
                    push( @$tmp_ref, $tmp_nodes );
                    $tmp_nodes = [];
                }
            }
            push( @$tmp_nodes, $sib );
            $prev_sib = $sib;
        }
        $self->_messagef( 3, "Saving last %d nodes collected.", scalar( @$tmp_nodes ) ) if( $self->{debug} >= 3 );
        push( @$tmp_ref, $tmp_nodes );
        $self->_messagef( 3, "Found %d try-catch block(s) in initial PPI result.", scalar( @$tmp_ref ) ) if( $self->{debug} >= 3 );
        # If we did find consecutive try-catch blocks, we add each of them after the nominal one and remove the nominal one after. The nominal one should be empty by then
        if( scalar( @$tmp_ref ) > 1 )
        {
            my $last_obj = $this;
            my $spaces = [];
            foreach my $arr ( @$tmp_ref )
            {
                $self->_message( 3, "Adding statement block with ", scalar( @$arr ), " children after '$last_obj'" ) if( $self->{debug} >= 3 );
                # 2021-06-05 (Jacques): Fixing issue No. 2:
                # Find the last block that belongs to us
                $self->_message( 4, "Checking first level objects collected." ) if( $self->{debug} >= 4 );
                my $last_control = '';
                my $last_block;
                my $last = {};
                foreach my $o ( @$arr )
                {
                    # $self->_message( 4, "Found object '$o' of class '", $o->class, "' (", overload::StrVal( $o ), ")." );
                    if( $o->class eq 'PPI::Structure::Block' && $last_control )
                    {
                        $last->{block} = $o;
                        $last->{control} = $last_control;
                        $last_control = '';
                    }
                    elsif( $o->class eq 'PPI::Token::Word' )
                    {
                        my $ct = $o->content;
                        if( $ct eq 'try' || $ct eq 'catch' || $ct eq 'finally' )
                        {
                            $last_control = $o;
                        }
                    }
                }
                # $self->_message( 4, "Last control was '$last->{control}' and last block '$last->{block}' (", overload::StrVal( $last->{block} ), ")." );

                # Get the trailing insignificant elements at the end of the statement and move them out of the statement
                my $insignificants = [];
                while( scalar( @$arr ) > 0 )
                {
                    my $o = $arr->[-1];
                    # $self->_message( 4, "Checking trailing object with class '", $o->class, "' and value '$o'" );
                    # 2021-06-05 (Jacques): We don't just look for the last block, because
                    # that was making a bad assumption that the last trailing block would be our
                    # try-catch block.
                    # Following issue No. 2 reported with a trailing anonymous subroutine,
                    # We remove everything up until our known last block that belongs to us.
                    last if( $o->class eq 'PPI::Structure::Block' && Scalar::Util::refaddr( $o ) eq Scalar::Util::refaddr( $last->{block} ) );
                    unshift( @$insignificants, pop( @$arr )->remove );
                }
                $self->_messagef( 3, "%d insignificant objects found.", scalar( @$insignificants ) ) if( $self->{debug} >= 3 );

                my $new_code = join( '', map( "$_", @$arr ) );
                # $self->_message( 4, "New code is: '$new_code'" );
                # 2021-06-05 (Jacques): It is unfortunately difficult to simply add a new PPI::Statement object
                # Instead, we have PPI parse our new code and we grab what we need.
                my $new_block = PPI::Document->new( \$new_code, readonly => 1 );
                # $self->_message( 4, "New block code is: '$new_block'" );
                # $self->_browse( $new_block );
                my $st = $new_block->{children}->[0]->remove;
                # $self->_message( 4, "Statemnt now contains: '$st'" );

                # $self->_messagef( 3, "Adding the updated statement objects with %d children.", scalar( @$arr ) );
                foreach my $o ( @$arr )
                {
                    # We remove the object from its parent, now that it has become useless
                    my $old = $o->remove || die( "Unable to remove element '$o'\n" );
                }
                my $err = '';
                $self->_messagef( 3, "Adding the statement object after last object '%s' of class '%s' with parent with class '%s'.", Scalar::Util::refaddr( $last_obj ), ( defined( $last_obj ) ? $last_obj->class : 'undefined class' ), ( defined( $last_obj ) ? $last_obj->parent->class : 'undefined parent class' ) ) if( $self->{debug} >= 3 );
                $self->_message( 4, "In other word, adding:\n'$st'\nAFTER:\n'$last_obj'" ) if( $self->{debug} >= 4 );
                # my $rc = $last_obj->insert_after( $st );
                my $rc;
                if( $last_obj->class eq 'PPI::Token::Whitespace' )
                {
                    $rc = $last_obj->__insert_after( $st );
                }
                else
                {
                    $rc = $last_obj->insert_after( $st );
                }

                if( !defined( $rc ) )
                {
                    $err = sprintf( 'Object to be added after last try-block statement must be a PPI::Element. Class provided is \"%s\".', $st->class );
                }
                elsif( !$rc )
                {
                    $err = sprintf( "Object of class \"%s\" could not be added after object '%s' of class '%s' with parent '%s' with class '%s': '$last_obj'.", $st->class, Scalar::Util::refaddr( $last_obj ), $last_obj->class, Scalar::Util::refaddr( $last_obj->parent ), $last_obj->parent->class );
                }
                else
                {
                    $last_obj = $st;
                    if( scalar( @$insignificants ) )
                    {
                        $self->_messagef( 4, "Adding %d trailing insignificant objects after last element of class '%s'", scalar( @$insignificants ), $last_obj->class ) if( $self->{debug} >= 4 );
                        foreach my $o ( @$insignificants )
                        {
                            $self->_messagef( 4, "Adding trailing insignificant object of class '%s' after last element of class '%s'", $o->class, $last_obj->class ) if( $self->{debug} >= 4 );
                            ## printf( STDERR "Inserting object '%s' (%s) of type '%s' after object '%s' (%s) of type %s who has parent '%s' of type '%s'\n", overload::StrVal( $o ), Scalar::Util::refaddr( $o ), ref( $o ), overload::StrVal( $last_obj), Scalar::Util::refaddr( $last_obj ), ref( $last_obj ), overload::StrVal( $last_obj->parent ), ref( $last_obj->parent ) );
                            CORE::eval
                            {
                                $rc = $last_obj->insert_after( $o ) ||
                                do
                                {
                                    warn( "Failed to insert object of class '", $o->class, "' before last object of class '", $st->class, "'\n" ) if( $self->{debug} );
                                };
                            };
                            if( $@ )
                            {
                                if( ref( $o ) )
                                {
                                    warn( "Failed to insert object of class '", $o->class, "' before last object of class '", $st->class, "': $@\n" ) if( $self->{debug} );
                                }
                                else
                                {
                                    warn( "Was expecting an object to insert before last object of class '", $st->class, "', but instead got '$o': $@\n" ) if( $self->{debug} );
                                }
                            }
                            elsif( !defined( $rc ) )
                            {
                                warn( sprintf( 'Object to be added after last try-block statement must be a PPI::Element. Class provided is \"%s\".', $o->class ) ) if( $self->{debug} );
                            }
                            elsif( !$rc )
                            {
                                warn( sprintf( "Object of class \"%s\" could not be added after object of class '%s': '$last_obj'.", $o->class, $last_obj->class ) ) if( $self->{debug} );
                            }
                            ## printf( STDERR "Object inserted '%s' (%s) of class '%s' now has parent '%s' (%s) of class '%s'\n", overload::StrVal( $o ), Scalar::Util::refaddr( $o ), ref( $o ), overload::StrVal( $o->parent ), Scalar::Util::refaddr( $o->parent ), ref( $o->parent ) );
                            $o->parent( $last_obj->parent ) if( !$o->parent );
                            $last_obj = $o;
                        }
                    }
                }
                die( $err ) if( length( $err ) );
                push( @$alt_ref, $st );
            }
            my $parent = $this->parent;
            ## Completely destroy it; it is now replaced by our updated code
            $this->delete;
        }
        else
        {
            push( @$alt_ref, $this );
        }
    }
    $self->_messagef( 3, "Results found increased from %d to %d results.", scalar( @$ref ), scalar( @$alt_ref ) ) if( $self->{debug} >= 3 );
    @$ref = @$alt_ref if( scalar( @$alt_ref ) > scalar( @$ref ) );

    # $self->_message( 3, "Script code is now:\n'$elem'" );

    foreach my $this ( @$ref )
    {
        $self->_browse( $this ) if( $self->{debug} >= 5 );
        # $self->_message( 4, "\$this is of class '", $this->class, "' and its parent of class '", $this->parent->class, "'." );
        my $element_before_try = $this->previous_sibling;
        # $self->_message( 4, "Is \$element_before_try defined ? ", defined( $element_before_try ) ? 'Yes' : 'No', "(", overload::StrVal( $element_before_try ), ") -> '$element_before_try'" );
        my $try_block_ref = [];
        # Contains the finally block reference
        my $fin_block_ref = [];
        my $nodes_to_replace = [];
        my $catch_def = [];
        # Replacement data
        my $repl = [];
        my $catch_repl = [];

        # There is a weird bug in PPI that I have searched but could not find
        # If I don't attempt to stringify, I may end up with a PPI::Statement object that has no children as an array reference
        my $ct = "$this";
        # $self->_message( 3, "Checking sibling elements for '$ct'" );
        my( @block_children ) = $this->children;
        next if( !scalar( @block_children ) );
        my $prev_sib = $block_children[0];
        push( @$nodes_to_replace, $prev_sib );
        my( $inside_catch, $inside_finally );
        my $temp = {};
        # Buffer of nodes found in between blocks
        my $buff = [];
        # Temporary new line counter between try-catch block so we can reproduce it and ensure proper reporting of error line
        my $nl_counter = 0;
        my $sib;
        while( $sib = $prev_sib->next_sibling )
        {
            # $self->_messagef( 3, "Try sibling at line %d with class '%s': '%s'", $sib->line_number, $sib->class, $sib->content );
            if( !scalar( @$try_block_ref ) )
            {
                # $self->_message( 3, "\tWorking on the initial try block." );
                if( $sib->class eq 'PPI::Structure::Block' &&
                    substr( "$sib", 0, 1 ) eq "\{" &&
                    substr( "$sib", -1, 1 ) eq "\}" )
                {
                    $temp->{block} = $sib;
                    push( @$try_block_ref, $temp );
                    $temp = {};
                    if( scalar( @$buff ) )
                    {
                        push( @$nodes_to_replace, @$buff );
                        $buff = [];
                    }
                    push( @$nodes_to_replace, $sib );
                }
                elsif( $sib->class eq 'PPI::Token::Whitespace' && $sib->content =~ /[\015\012]+/ )
                {
                    ## $self->_messagef( 4, "\tTry -> Found open new line at line %d", $sib->line_number );
                    $temp->{open_curly_nl}++;
                    push( @$buff, $sib );
                }
                ## We skip anything else until we find that try block
                else
                {
                    push( @$buff, $sib );
                    $prev_sib = $sib;
                    next;
                }
            }
            elsif( $sib->class eq 'PPI::Token::Word' && $sib->content eq 'catch' )
            {
                $inside_catch++;
                if( scalar( @$buff ) )
                {
                    push( @$nodes_to_replace, @$buff );
                    $buff = [];
                }
                push( @$nodes_to_replace, $sib );
            }
            elsif( $inside_catch )
            {
                # $self->_message( 3, "\tWorking on a catch block." );
                # This is the catch list as in catch( $e ) or catch( Exception $e )
                if( $sib->class eq 'PPI::Structure::List' )
                {
                    $temp->{var} = $sib;
                    push( @$nodes_to_replace, $sib );
                }
                elsif( $sib->class eq 'PPI::Structure::Block' )
                {
                    $temp->{block} = $sib;
                    if( scalar( @$catch_def ) )
                    {
                        $catch_def->[-1]->{close_curly_nl} = $nl_counter;
                    }
                    else
                    {
                        $try_block_ref->[-1]->{close_curly_nl} = $nl_counter;
                    }
                    $nl_counter = 0;
                    push( @$catch_def, $temp );
                    $temp = {};
                    $inside_catch = 0;
                    push( @$nodes_to_replace, $sib );
                }
                elsif( $sib->class eq 'PPI::Token::Whitespace' && $sib->content =~ /[\015\012]+/ )
                {
                    # $self->_messagef( 4, "\tCatch -> Found open new line at line %d", $sib->line_number );
                    $temp->{open_curly_nl}++;
                    push( @$nodes_to_replace, $sib );
                }
                else
                {
                    push( @$nodes_to_replace, $sib );
                }
            }
            elsif( $sib->class eq 'PPI::Token::Word' && $sib->content eq 'finally' )
            {
                $inside_finally++;
                if( scalar( @$buff ) )
                {
                    push( @$nodes_to_replace, @$buff );
                    $buff = [];
                }
                push( @$nodes_to_replace, $sib );
            }
            elsif( $inside_finally )
            {
                ## $self->_message( 3, "\tWorking on a finally block." );
                ## We could ignore it, but it is best to let the developer know in case he/she counts on it somehow
                if( $sib->class eq 'PPI::Structure::List' )
                {
                    die( sprintf( "the finally block does not accept any list parameters at line %d\n", $sib->line_number ) );
                }
                elsif( $sib->class eq 'PPI::Structure::Block' )
                {
                    $temp->{block} = $sib;
                    if( scalar( @$fin_block_ref ) )
                    {
                        die( sprintf( "There can only be one finally block at line %d\n", $sib->line_number ) );
                    }
                    elsif( scalar( @$catch_def ) )
                    {
                        $catch_def->[-1]->{close_curly_nl} = $nl_counter;
                    }
                    else
                    {
                        $try_block_ref->[-1]->{close_curly_nl} = $nl_counter;
                    }
                    $nl_counter = 0;
                    push( @$fin_block_ref, $temp );
                    $temp = {};
                    $inside_finally = 0;
                    push( @$nodes_to_replace, $sib );
                }
                elsif( $sib->class eq 'PPI::Token::Whitespace' && $sib->content =~ /[\015\012]+/ )
                {
                    ## $self->_messagef( 4, "\tFinally -> Found open new line at line %d", $sib->line_number );
                    $temp->{open_curly_nl}++;
                    push( @$nodes_to_replace, $sib );
                }
                else
                {
                    push( @$nodes_to_replace, $sib );
                }
            }
            # Check for new lines after closing blocks. The ones before, we can account for them in each section above
            # We could have } catch {
            # or
            # }
            # catch {
            # etc.
            # This could also be new lines following the last catch block
            elsif( $sib->class eq 'PPI::Token::Whitespace' && $sib->content =~ /[\015\012]+/ )
            {
                # $self->_messagef( 4, "Between -> Found closing new line at line %d", $sib->line_number );
                $nl_counter++;
                push( @$buff, $sib );
            }
            else
            {
                push( @$buff, $sib );
            }
            $prev_sib = $sib;
        }

        my $has_catch_clause = scalar( @$catch_def ) > 0 ? 1 : 0;

        # Prepare the finally block, if any, and add it below at the appropriate place
        my $fin_block = '';
        if( scalar( @$fin_block_ref ) )
        {
            my $fin_def = $fin_block_ref->[0];
            $self->_process_caller( finally => $fin_def->{block} );
            ## my $finally_block = $fin_def->{block}->content;
            my $finally_block = $self->_serialize( $fin_def->{block} );
            $finally_block =~ s/^\{[[:blank:]]*|[[:blank:]]*\}$//gs;
            $fin_block = <
CORE::local \$Nice::Try::FINALLY = Nice\::Try\::ScopeGuard->_new(sub __FINALLY_OPEN_NL__{ __BLOCK_PLACEHOLDER__ __FINALLY__CLOSE_NL__}, [\@_], \$Nice::Try::CATCH_DIED);
EOT
            $fin_block =~ s/\n/ /gs unless( $self->{debug_code} );
            $fin_block =~ s/__BLOCK_PLACEHOLDER__/$finally_block/gs;
            if( $fin_def->{open_curly_nl} )
            {
                $fin_block =~ s/__FINALLY_OPEN_NL__/"\n" x $fin_def->{open_curly_nl}/gex;
            }
            else
            {
                $fin_block =~ s/__FINALLY_OPEN_NL__//gs;
            }
            if( $fin_def->{close_curly_nl} )
            {
                $fin_block =~ s/__FINALLY__CLOSE_NL__/"\n" x $fin_def->{close_curly_nl}/gex;
            }
            else
            {
                $fin_block =~ s/__FINALLY__CLOSE_NL__//gs;
            }
        }

        # Found any try block at all?
        if( scalar( @$try_block_ref ) )
        {
            # $self->_message( 3, "Original code to remove is:\n", join( '', @$nodes_to_replace ) );
            # $self->_message( 3, "Try definition: ", $try_block_ref->[0]->{block}->content );
            # $self->_messagef( 3, "%d catch clauses found", scalar( @$catch_def ) );
            foreach my $c ( @$catch_def )
            {
                # $self->_message( 3, "Catch variable assignment: ", $c->{var} );
                # $self->_message( 3, "Catch block: ", $c->{block} );
            }
            my $try_def = $try_block_ref->[0];
            # $self->_messagef( 3, "Try new lines before block: %d, after block %d", $try_def->{open_curly_nl}, $try_def->{close_curly_nl} );

            # Checking for embedded try-catch
            # $self->_message( 4, "Checking for embedded try-catch in ", $try_def->{block} );
            if( my $emb = $self->_parse( $try_def->{block} ) )
            {
                $try_def->{block} = $emb;
            }

            $self->_process_loop_breaks( $try_def->{block} );
            $self->_process_caller( try => $try_def->{block} );

            ## my $try_block = $try_def->{block}->content;
            my $try_block = $self->_serialize( $try_def->{block} );
            $try_block =~ s/^\{[[:blank:]]*|[[:blank:]]*\}$//gs;

            my $try_sub = <
CORE::local \$Nice::Try::THREADED;
if( \$INC{'threads.pm'} && !CORE::exists( \$INC{'forks.pm'} ) )
{
    \$Nice::Try::THREADED = threads->tid;
}
CORE::local \$Nice::Try::WANT;
CORE::local ( \$Nice::Try::EXCEPTION, \$Nice::Try::DIED, \$Nice::Try::CATCH_DIED, \@Nice::Try::RETVAL, \@Nice::Try::VOID );
CORE::local \$Nice::Try::WANTARRAY = CORE::wantarray;
CORE::local \$Nice::Try::TRY = CORE::sub
{
    \@Nice::Try::LAST_VAL = CORE::do __TRY_OPEN_NL__{ __BLOCK_PLACEHOLDER__ };__TRY__CLOSE_NL__
    CORE::return( \@Nice::Try::LAST_VAL ) if( !CORE::defined( \$Nice::Try::WANTARRAY ) && CORE::scalar( \@Nice::Try::LAST_VAL ) );
    CORE::return( \$Nice::Try::VOID[0] = \$Nice::Try::SENTINEL );
};
__FINALLY_BLOCK__ CORE::local \$Nice::Try::HAS_CATCH = $has_catch_clause;
EOT
            if( !$self->{is_tied} && !$self->{dont_want} && !$self->{is_overloaded} )
            {
                $try_sub .= <
CORE::local \$Nice::Try::NOOP = sub
{
    my \$ref = CORE::shift( \@_ );
    CORE::return(sub{ CORE::return( \$ref ) });
};
if( CORE::defined( \$Nice::Try::WANTARRAY ) && !\$Nice::Try::THREADED && !( !CORE::length( [CORE::caller]->[1] ) && [CORE::caller(1)]->[3] eq '(eval)' ) )
{
    CORE::eval "\\\$Nice::Try::WANT = Want::want( 'LIST' )
            ? 'LIST'
            : Want::want( 'HASH' )
                ? 'HASH'
                : Want::want( 'ARRAY' )
                    ? 'ARRAY'
                    : Want::want( 'OBJECT' )
                        ? 'OBJECT'
                        : Want::want( 'CODE' )
                            ? 'CODE'
                            : Want::want( 'REFSCALAR' )
                                ? 'REFSCALAR'
                                : Want::want( 'BOOLEAN' )
                                    ? 'BOOLEAN'
                                    : Want::want( 'GLOB' )
                                        ? 'GLOB'
                                        : Want::want( 'SCALAR' )
                                            ? 'SCALAR'
                                            : Want::want( 'VOID' )
                                                ? 'VOID'
                                                : '';";
    undef( \$Nice::Try::WANT ) if( \$\@ );
}
EOT
            }
            $try_sub .= <
{
    CORE::local \$\@;
    CORE::eval
    {
        if( CORE::defined( \$Nice::Try::WANT ) && CORE::length( \$Nice::Try::WANT ) )
        {
            if( \$Nice::Try::WANT eq 'OBJECT' )
            {
                \$Nice::Try::RETVAL[0] = Nice::Try::ObjectContext->new( &\$Nice::Try::TRY )->callback();
            }
            elsif( \$Nice::Try::WANT eq 'CODE' )
            {
                \$Nice::Try::RETVAL[0] = \$Nice::Try::NOOP->( &\$Nice::Try::TRY )->();
            }
            elsif( \$Nice::Try::WANT eq 'HASH' )
            {
                \@Nice::Try::RETVAL = \%{ &\$Nice::Try::TRY };
            }
            elsif( \$Nice::Try::WANT eq 'ARRAY' )
            {
                \@Nice::Try::RETVAL = \@{ &\$Nice::Try::TRY };
            }
            elsif( \$Nice::Try::WANT eq 'REFSCALAR' )
            {
                \$Nice::Try::RETVAL[0] = \${&\$Nice::Try::TRY};
            }
            elsif( \$Nice::Try::WANT eq 'GLOB' )
            {
                \$Nice::Try::RETVAL[0] = \*{ &\$Nice::Try::TRY };
            }
            elsif( \$Nice::Try::WANT eq 'LIST' )
            {
                \@Nice::Try::RETVAL = &\$Nice::Try::TRY;
            }
            elsif( \$Nice::Try::WANT eq 'BOOLEAN' )
            {
                \$Nice::Try::RETVAL[0] = &\$Nice::Try::TRY ? 1 : 0;
                \$Nice::Try::RETVAL[0] = \$Nice::Try::VOID[0] if( scalar( \@Nice::Try::VOID ) );
            }
            elsif( \$Nice::Try::WANT eq 'VOID' )
            {
                \$Nice::Try::VOID[0] = &\$Nice::Try::TRY;
            }
            elsif( \$Nice::Try::WANT eq 'SCALAR' )
            {
                \$Nice::Try::RETVAL[0] = &\$Nice::Try::TRY;
            }
        }
        else
        {
            if( \$Nice::Try::WANTARRAY )
            {
                \@Nice::Try::RETVAL = &\$Nice::Try::TRY;
            }
            elsif( defined( \$Nice::Try::WANTARRAY ) )
            {
                \$Nice::Try::RETVAL[0] = &\$Nice::Try::TRY;
            }
            else
            {
                &\$Nice::Try::TRY;
                \$Nice::Try::RETVAL[0] = \$Nice::Try::LAST_VAL if( CORE::defined( \$Nice::Try::LAST_VAL ) );
            }
        }
    };
    \$Nice::Try::DIED = CORE::length( \$\@ ) ? 1 : 0;
    \$\@ =~ s/[\\015\\012]+\$//g unless( Scalar::Util::blessed( \$\@ ) );
    \$Nice::Try::EXCEPTION = \$\@;
};

EOT
            $try_sub =~ s/\n/ /gs unless( $self->{debug_code} );
            $try_sub =~ s/__BLOCK_PLACEHOLDER__/$try_block/gs;
            if( $try_def->{open_curly_nl} )
            {
                $try_sub =~ s/__TRY_OPEN_NL__/"\n" x $try_def->{open_curly_nl}/gex;
            }
            else
            {
                $try_sub =~ s/__TRY_OPEN_NL__//gs;
            }
            if( $try_def->{close_curly_nl} )
            {
                $try_sub =~ s/__TRY__CLOSE_NL__/"\n" x $try_def->{close_curly_nl}/gex;
            }
            else
            {
                $try_sub =~ s/__TRY__CLOSE_NL__//gs;
            }

            # Add the final block if there is no catch block, otherwise the final block comes at the end below
            if( !$has_catch_clause )
            {
                $try_sub =~ s/__FINALLY_BLOCK__/$fin_block/gs;
            }
            # If it should not be here, remove the placeholder
            else
            {
                $try_sub =~ s/__FINALLY_BLOCK__//gs;
            }
            push( @$repl, $try_sub );
        }
        else
        {
            # $self->_message( 3, "** No try block found!!" );
            next;
        }

        my $if_start = <
if( \$Nice::Try::DIED )
{
    if( \$Nice::Try::HAS_CATCH )
    {
EOT
        $if_start =~ s/\n/ /gs unless( $self->{debug_code} );
        push( @$catch_repl, $if_start );
        if( scalar( @$catch_def ) )
        {
            # $self->_messagef( 3, "Found %d catch blocks", scalar( @$catch_def ) );
            my $total_catch = scalar( @$catch_def );
            # To count how many times we have else's – obviously we should not have more than 1
            my $else = 0;
            for( my $i = 0; $i < $total_catch; $i++ )
            {
                my $cdef = $catch_def->[$i];
                # $self->_messagef( 3, "Catch No ${i} new lines before block: %d, after block %d", $cdef->{open_curly_nl}, $cdef->{close_curly_nl} );
                # Checking for embedded try-catch
                if( my $emb = $self->_parse( $cdef->{block} ) )
                {
                    $cdef->{block} = $emb;
                }

                if( $cdef->{var} )
                {
                    $cdef->{var}->prune( 'PPI::Token::Comment' );
                    $cdef->{var}->prune( 'PPI::Token::Pod' );
                    $self->_messagef( 3, "Catch assignment is: '%s'", $cdef->{var}->content );
                    # my $str = $cdef->{var}->content;
                    my $str = $self->_serialize( $cdef->{var} );
                    $str =~ s/^\([[:blank:]\h\v]*|[[:blank:]]*\)$//g;
                    # My::Exception $e
                    if( $str =~ /^(\S+)[[:blank:]\h\v]+(\$\S+)$/ )
                    {
                        @$cdef{qw( class var )} = ( $1, $2 );
                    }
                    elsif( $str =~ /^(\S+)[[:blank:]\h\v]+(\$\S+)[[:blank:]\h\v]+where[[:blank:]\h\v]+\{(.*?)\}$/ )
                    {
                        @$cdef{qw( class var where )} = ( $1, $2, $3 );
                    }
                    elsif( $str =~ /^(\$\S+)[[:blank:]\h\v]+where[[:blank:]\h\v]+\{(.*?)\}$/ )
                    {
                        @$cdef{qw( var where )} = ( $1, $2 );
                    }
                    elsif( $str =~ /^(\$\S+)[[:blank:]\h\v]+isa[[:blank:]\h\v]+(\S+)(?:[[:blank:]\h\v]+where[[:blank:]\h\v]+\{(.*?)\})?$/ )
                    {
                        @$cdef{qw( var class where )} = ( $1, $2, $3 );
                    }
                    elsif( $str =~ /^(?\$\S+)[[:blank:]\h\v]+isa[[:blank:]\h\v]*\([[:blank:]\h\v]*(?["'])?(?[^[:blank:]\h\v\'\"\)]+)\k{quote}[[:blank:]\h\v]*\)(?:[[:blank:]\h\v]+where[[:blank:]\h\v]+\{(?.*?)\})?$/ )
                    {
                        @$cdef{qw( var class where )} = ( $+{var}, $+{class}, $+{where} );
                    }
                    else
                    {
                        $cdef->{var} = $str;
                    }
                }
                else
                {
                    # $self->_message( 3, "No Catch assignment found" );
                }

                if( $cdef->{block} )
                {
                    # $self->_messagef( 3, "Catch block is:\n%s", $cdef->{block}->content );
                }
                else
                {
                    # $self->_message( 3, "No catch block found!" );
                    next;
                }
                my $cond;
                if( $i == 0 )
                {
                    $cond = 'if';
                }
                elsif( $i == ( $total_catch - 1 ) )
                {
                    $cond = $total_catch == 1
                        ? 'if'
                        : $cdef->{class}
                            ? 'elsif'
                            : 'else';
                }
                else
                {
                    $cond = 'elsif';
                }
                # $self->_message( 3, "\$i = $i, \$total_catch = $total_catch and cond = '$cond'" );
                # my $block = $cdef->{block}->content;
                $self->_process_loop_breaks( $cdef->{block} );
                $self->_process_caller( catch => $cdef->{block} );
                my $block = $self->_serialize( $cdef->{block} );
                $block =~ s/^\{[[:blank:]]*|[[:blank:]]*\}$//gs;
                my $catch_section = '';
                my $catch_code = <
            CORE::local \$Nice::Try::CATCH = CORE::sub
            {
                \@Nice::Try::LAST_VAL = CORE::do __CATCH_OPEN_NL__{ __BLOCK_PLACEHOLDER__ }; __CATCH__CLOSE_NL__
                CORE::return( \@Nice::Try::LAST_VAL ) if( !CORE::defined( \$Nice::Try::WANTARRAY ) && CORE::scalar( \@Nice::Try::LAST_VAL ) );
                CORE::return \$Nice::Try::SENTINEL;
            };

            eval
            {
                local \$\@ = \$Nice::Try::EXCEPTION;
                if( CORE::defined( \$Nice::Try::WANT ) && CORE::length( \$Nice::Try::WANT ) )
                {
                    if( \$Nice::Try::WANT eq 'OBJECT' )
                    {
                        \$Nice::Try::RETVAL[0] = Nice::Try::ObjectContext->new( \&\$Nice::Try::CATCH )->callback();
                    }
                    elsif( \$Nice::Try::WANT eq 'CODE' )
                    {
                        \$Nice::Try::RETVAL[0] = \$Nice::Try::NOOP->( \&\$Nice::Try::CATCH )->();
                    }
                    elsif( \$Nice::Try::WANT eq 'HASH' )
                    {
                        \@Nice::Try::RETVAL = \%{ \&\$Nice::Try::CATCH };
                    }
                    elsif( \$Nice::Try::WANT eq 'ARRAY' )
                    {
                        \@Nice::Try::RETVAL = \@{ \&\$Nice::Try::CATCH };
                    }
                    elsif( \$Nice::Try::WANT eq 'REFSCALAR' )
                    {
                        \$Nice::Try::RETVAL[0] = \${\&\$Nice::Try::CATCH};
                    }
                    elsif( \$Nice::Try::WANT eq 'GLOB' )
                    {
                        \$Nice::Try::RETVAL[0] = \*{ \&\$Nice::Try::CATCH };
                    }
                    elsif( \$Nice::Try::WANT eq 'LIST' )
                    {
                        \@Nice::Try::RETVAL = \&\$Nice::Try::CATCH;
                    }
                    elsif( \$Nice::Try::WANT eq 'BOOLEAN' )
                    {
                        my \$this = \&\$Nice::Try::CATCH ? 1 : 0;
                        \$Nice::Try::RETVAL[0] = \$Nice::Try::VOID[0] if( scalar( \@Nice::Try::VOID ) );
                    }
                    elsif( \$Nice::Try::WANT eq 'VOID' )
                    {
                        \$Nice::Try::VOID[0] = \&\$Nice::Try::CATCH;
                    }
                    elsif( \$Nice::Try::WANT eq 'SCALAR' )
                    {
                        \$Nice::Try::RETVAL[0] = \&\$Nice::Try::CATCH;
                    }
                }
                else
                {
                    if( \$Nice::Try::WANTARRAY )
                    {
                        \@Nice::Try::RETVAL = \&\$Nice::Try::CATCH;
                    }
                    elsif( defined( \$Nice::Try::WANTARRAY ) )
                    {
                        \$Nice::Try::RETVAL[0] = \&\$Nice::Try::CATCH;
                    }
                    else
                    {
                        \&\$Nice::Try::CATCH;
                    }
                }
            };
            \$Nice::Try::CATCH_DIED = \$\@ if( \$\@ );
EOT
                if( $cdef->{var} )
                {
                    my $ex_var = $cdef->{var};
                    if( $cdef->{class} && $cdef->{where} )
                    {
                        my $ex_class = $cdef->{class};
                        my $eval = "q{CORE::local \$_ = \$Nice::Try::EXCEPTION; my $ex_var = \$Nice::Try::EXCEPTION; CORE::local \$\@ = \$Nice::Try::EXCEPTION; $cdef->{where}}";
                        $catch_section = <
        ${cond}( Scalar::Util::blessed( \$Nice::Try::EXCEPTION ) && \$Nice::Try::EXCEPTION->isa( '$ex_class' ) && CORE::eval( $eval ) )
        {
            CORE::local \$\@ = \$Nice::Try::EXCEPTION;
            my $ex_var = \$Nice::Try::EXCEPTION;
$catch_code
        }
EOT
                    }
                    elsif( $cdef->{class} )
                    {
                        my $ex_class = $cdef->{class};
                        # Tilmann Haeberle (TH) 2021-03-25: Fix: properly test for exception class inheritance via ->isa
                        $catch_section = <
        ${cond}( Scalar::Util::blessed( \$Nice::Try::EXCEPTION ) && \$Nice::Try::EXCEPTION->isa( '$ex_class' ) )
        {
            CORE::local \$\@ = \$Nice::Try::EXCEPTION;
            my $ex_var = \$Nice::Try::EXCEPTION;
$catch_code
        }
EOT
                    }
                    elsif( $cdef->{where} )
                    {
                        my $eval = "q{CORE::local \$_ = \$Nice::Try::EXCEPTION; my $ex_var = \$Nice::Try::EXCEPTION; CORE::local \$\@ = \$Nice::Try::EXCEPTION; $cdef->{where}}";
                        $catch_section = <
        ${cond}( CORE::eval( $eval ) )
        {
            CORE::local \$\@ = \$Nice::Try::EXCEPTION;
            my $ex_var = \$Nice::Try::EXCEPTION;
$catch_code
        }
EOT
                    }
                    # No class, just variable assignment like $e or something
                    else
                    {
                        # $self->_message( 3, "Called here for fallback for element No $i" );
                        if( ++$else > 1 )
                        {
                            # CORE::warn( "Cannot have more than one falllback catch clause for block: ", $cdef->{block}->content, "\n" ) if( warnings::enabled );
                            CORE::warn( "Cannot have more than one falllback catch clause for block: ", $self->_serialize( $cdef->{block} ), "\n" ) if( warnings::enabled );
                            # Skip, not die. Not fatal, just ignored
                            next;
                        }
                        $cond = "${cond}( 1 )" if( $cond eq 'if' || $cond eq 'elsif' );
                        # push( @$catch_repl, <
                        $catch_section = <
        ${cond}
        {
            CORE::local \$\@ = \$Nice::Try::EXCEPTION;
            my $ex_var = \$Nice::Try::EXCEPTION;
$catch_code
        }
EOT
                    }
                }
                # No variable assignment like $e
                else
                {
                    $cond = "${cond}( 1 )" if( $cond eq 'if' || $cond eq 'elsif' );
                    $catch_section = <
        ${cond}
        {
            CORE::local \$\@ = \$Nice::Try::EXCEPTION;
$catch_code
        }
EOT
                }
                $catch_section =~ s/\n/ /gs unless( $self->{debug_code} );
                $catch_section =~ s/__BLOCK_PLACEHOLDER__/$block/gs;
                if( $cdef->{open_curly_nl} )
                {
                    $catch_section =~ s/__CATCH_OPEN_NL__/"\n" x $cdef->{open_curly_nl}/gex;
                }
                else
                {
                    $catch_section =~ s/__CATCH_OPEN_NL__//gs;
                }
                if( $cdef->{close_curly_nl} )
                {
                    $catch_section =~ s/__CATCH__CLOSE_NL__/"\n" x $cdef->{close_curly_nl}/gex;
                }
                else
                {
                    $catch_section =~ s/__CATCH__CLOSE_NL__//gs;
                }
                push( @$catch_repl, $catch_section );
            }
            # End catch loop
            # Tilmann Haeberle (TH) 2021-03-25: Fix: put an else at the end to avoid 'fall_through' issue unless an else exists already
            my $if_end;
            if( $else )
            {
                $if_end = <
    }
EOT
            }
            else
            {
                $if_end = <
        else
        {
            die( \$Nice::Try::EXCEPTION );
        }
    }
EOT
            }
            $if_end =~ s/\n/ /g unless( $self->{debug_code} );
            push( @$catch_repl, $if_end );
        }
        # No catch clause
        else
        {
            # If the try-catch block is called inside an eval, propagate the exception
            # Otherwise, we just make the $@ available
            my $catch_else = <
    }
    else
    {
        if( CORE::defined( (CORE::caller(0))[3] ) && (CORE::caller(0))[3] eq '(eval)' )
        {
            CORE::die( \$Nice::Try::EXCEPTION );
        }
        else
        {
            \$\@ = \$Nice::Try::EXCEPTION;
        }
    }
EOT
            $catch_else =~ s/\n/ /g unless( $self->{debug_code} );
            push( @$catch_repl, $catch_else );
        }

        # Add
        my $catch_res = scalar( @$catch_repl ) ? join( '', @$catch_repl ) : '';
        push( @$repl, $catch_res ) if( $catch_res );
        # Closing the If DIED condition
        push( @$repl, "\};" );

        # If there is a catch clause, we put the final block here, if any
        if( $has_catch_clause && CORE::length( $fin_block ) )
        {
            push( @$repl, $fin_block );
        }

        # After the finally block has been registered, we will die if catch had a fatal error
        my $catch_dies = <
if( defined( \$Nice::Try::CATCH_DIED ) )
{
    die( \$Nice::Try::CATCH_DIED );
}
EOT
        $catch_dies =~ s/\n/ /gs unless( $self->{debug_code} );
        push( @$repl, $catch_dies );

        my $last_return_block = <
if( ( CORE::defined( \$Nice::Try::WANTARRAY ) || ( defined( \$Nice::Try::BREAK ) && \$Nice::Try::BREAK eq 'return' ) ) and
    (
      !Scalar::Util::blessed( \$Nice::Try::RETVAL[0] ) or
      ( Scalar::Util::blessed( \$Nice::Try::RETVAL[0] ) && !\$Nice::Try::RETVAL[0]->isa( 'Nice::Try::SENTINEL' ) )
    ) )
{
    if( !CORE::defined( \$Nice::Try::BREAK ) || \$Nice::Try::BREAK eq 'return' )
    {
        if( CORE::defined( \$Nice::Try::WANT ) && CORE::length( \$Nice::Try::WANT ) )
        {
            if( \$Nice::Try::WANT eq 'LIST' )
            {
                CORE::return( \@Nice::Try::RETVAL );
            }
            elsif( \$Nice::Try::WANT eq 'VOID' )
            {
                if( CORE::defined( \$Nice::Try::RETVAL[0] ) && \$Nice::Try::RETVAL[0] eq '__NEXT__' )
                {
                    \$Nice::Try::BREAK = 'next';
                }
                elsif( CORE::defined( \$Nice::Try::RETVAL[0] ) && \$Nice::Try::RETVAL[0] eq '__LAST__' )
                {
                    \$Nice::Try::BREAK = 'last';
                }
                elsif( CORE::defined( \$Nice::Try::RETVAL[0] ) && \$Nice::Try::RETVAL[0] eq '__REDO__' )
                {
                    \$Nice::Try::BREAK = 'redo';
                }
                elsif( defined( \$Nice::Try::BREAK ) && \$Nice::Try::BREAK eq 'return' )
                {
                    CORE::return( \$Nice::Try::RETVAL[0] );
                }
            }
            elsif( \$Nice::Try::WANT eq 'OBJECT' )
            {
                CORE::return( \$Nice::Try::RETVAL[0] );
            }
            elsif( \$Nice::Try::WANT eq 'REFSCALAR' )
            {
                CORE::return( \\\$Nice::Try::RETVAL[0] );
            }
            elsif( \$Nice::Try::WANT eq 'SCALAR' )
            {
                CORE::return( \$Nice::Try::RETVAL[0] );
            }
            elsif( \$Nice::Try::WANT eq 'BOOLEAN' )
            {
                CORE::return( \$Nice::Try::RETVAL[0] );
            }
            elsif( \$Nice::Try::WANT eq 'CODE' )
            {
                CORE::return( \$Nice::Try::RETVAL[0] );
            }
            elsif( \$Nice::Try::WANT eq 'HASH' )
            {
                CORE::return( { \@Nice::Try::RETVAL } );
            }
            elsif( \$Nice::Try::WANT eq 'ARRAY' )
            {
                CORE::return( \\\@Nice::Try::RETVAL );
            }
            elsif( \$Nice::Try::WANT eq 'GLOB' )
            {
                CORE::return( \$Nice::Try::RETVAL[0] );
            }
        }
        else
        {
            CORE::return( \$Nice::Try::WANTARRAY ? \@Nice::Try::RETVAL : \$Nice::Try::RETVAL[0] );
        }
    }
}
EOT
        $last_return_block =~ s/\n/ /gs unless( $self->{debug_code} );
        push( @$repl, $last_return_block );
        my $try_catch_code = join( '', @$repl );
        # my $token = PPI::Token->new( "; \{ $try_catch_code \}" ) || die( "Unable to create token" );
        # XXX 2021-05-11 (Jacques): Need to remove blocks so that next or last statements can be effective.
        my $envelop = <
; CORE::local( \$Nice::Try::BREAK, \@Nice::Try::LAST_VAL );
\{
__TRY_CATCH_CODE__
\}
if( CORE::defined( \$Nice::Try::BREAK ) )
{
    if( \$Nice::Try::BREAK eq 'next' )
    {
        CORE::next;
    }
    elsif( \$Nice::Try::BREAK eq 'last' )
    {
        CORE::last;
    }
    elsif( \$Nice::Try::BREAK eq 'redo' )
    {
        CORE::redo;
    }
}
no warnings 'void';
CORE::scalar( \@Nice::Try::LAST_VAL ) > 1 ? \@Nice::Try::LAST_VAL : \$Nice::Try::LAST_VAL[0];
EOT
        $envelop =~ s/\n/ /gs unless( $self->{debug_code} );
        $envelop =~ s/__TRY_CATCH_CODE__/$try_catch_code/;
        my $token = PPI::Token->new( $envelop ) || die( "Unable to create token" );
        $token->set_class( 'Structure' );
        # $self->_messagef( 3, "Token is '$token' and of class '%s' and inherit from PPI::Token? %s", $token->class, ($token->isa( 'PPI::Token' ) ? 'yes' : 'no' ) );
        my $struct = PPI::Structure->new( $token ) || die( "Unable to create PPI::Structure element" );
        # $self->_message( 3, "Resulting try-catch block is:\n'$token'" );
        my $orig_try_catch_block = join( '', @$nodes_to_replace );
        # $self->_message( 3, "Original try-catch block is:\n'$orig_try_catch_block'" );
        # $self->_messagef( 3, "Element before our try-catch block is of class %s with value '%s'", $element_before_try->class, $element_before_try->content );
        my $rc;
        if( !( $rc = $element_before_try->insert_after( $token ) ) )
        {
            # $self->_message( 3, "Return code is defined? ", CORE::defined( $rc ) ? 'yes' : 'no', " and is it a PPI::Element object? ", $token->isa( 'PPI::Element' ) ? 'yes' : 'no' );
            $self->_error( "Failed to add replacement code of class '", $token->class, "' after '$element_before_try'" );
            next;
        }
        $self->_message( 3, "Return code is defined? ", defined( $rc ) ? "yes" : "no" ) if( $self->{debug} >= 3 );

        for( my $k = 0; $k < scalar( @$nodes_to_replace ); $k++ )
        {
            my $e = $nodes_to_replace->[$k];
            ## $self->_messagef( 4, "[$k] Removing node: $e" );
            $e->delete || warn( "Could not remove node No $k: '$e'\n" );
        }
    }
    # End foreach catch found

    # $self->_message( 3, "\n\nResulting code is\n", $elem->content );
    return( $elem );
}

# .Element: [11] class PPI::Token::Word, value caller
# .Element: [11] class PPI::Structure::List, value (1)
#
# ..Element: [12] class PPI::Token::Word, value caller
# ..Element: [12] class PPI::Token::Structure, value ;

sub _process_caller
{
    my $self = shift( @_ );
    my $where = shift( @_ );
    my $elem = shift( @_ ) || return( '' );
    no warnings 'uninitialized';
    return( $elem ) if( !$elem->children );
    foreach my $e ( $elem->elements )
    {
        my $content = $e->content // '';
        # $self->_messagef( 6, "Checking element: [%d] class %s with %d children and value '%s'\n", $e->line_number, $e->class, ( $e->can('elements') ? scalar( $e->elements ) : 0 ), $content );
        my $class = $e->class;
        if( $class eq 'PPI::Token::Word' && $content =~ /^(?:CORE\::)?(?:GLOBAL\::)?caller$/ )
        {
            # $self->_message( 4, "Found caller, replacing with ", 'Nice::Try::caller_' . $where );
            $e->set_content( 'Nice::Try::caller_' . $where );
        }

        if( $e->can('elements') && $e->elements )
        {
            $self->_process_caller( $where => $e );
        }
    }
    # $self->_message( 5, "Element now is: '$elem'" );
    # $self->_browse( $elem );
    return( $elem );
}

sub _process_loop_breaks
{
    my $self = shift( @_ );
    my $elem = shift( @_ ) || return( '' );
    no warnings 'uninitialized';
    return( $elem ) if( !$elem->children );
    $self->_message( 5, "Checking ", scalar( $elem->elements ), " elements for '$elem'" ) if( $self->{debug} >= 5 );
    foreach my $e ( $elem->elements )
    {
        my $content = $e->content // '';
        $self->_messagef( 6, "Checking element: [%d] class %s with %d children and value '%s'\n", $e->line_number, $e->class, ( $e->can('elements') ? scalar( $e->elements ) : 0 ), $content ) if( $self->{debug} >= 6 );
        my $class = $e->class;
        # We found a for, foreach or while loops and we skip, because if there are any break words (next, last, redo) inside, it is not our problem.
        if( $class eq 'PPI::Structure::For' ||
            ( $class eq 'PPI::Statement::Compound' &&
              CORE::defined( $e->first_element->content ) &&
              $e->first_element->content =~ /^(for|foreach|while)$/ ) )
        {
            # $self->_message( 6, "Skipping it. Its first word was '", $e->first_element->content, "'" );
            next;
        }
        elsif( $class eq 'PPI::Token::Word' && $content =~ /^(?:CORE\::)?(?:GLOBAL\::)?(next|last|redo)$/ )
        {
            $self->_message( 5, "Found loop keyword '$content'." ) if( $self->{debug} >= 5 );
            # $e->set_content( qq{CORE::return( '__} . uc( $1 ) . qq{__' )} );
            # $e->set_content( q{$Nice::Try::BREAK='__} . uc( $1 ) . qq{__' ); return;} );
            my $break_code = q{$Nice::Try::BREAK='} . $1 . qq{', return;};
            my $break_doc = PPI::Document->new( \$break_code, readonly => 1 );
            my $new_elem = $break_doc->first_element;
            # $self->_browse( $new_elem );
            $new_elem->remove;
            $self->_message( 5, "New element is object '", sub{ overload::StrVal( $new_elem ) }, "' -> $new_elem" ) if( $self->{debug} >= 5 );
            # Not yet implemented as of 2021-05-11 dixit PPI, so we use a hack to make it available anyhow
            $e->replace( $new_elem );
            $self->_message( 5, "Loop keyword now replaced with '$e'." ) if( $self->{debug} >= 5 );
        }
        elsif( $class eq 'PPI::Statement::Break' )
        {
            my $words = $e->find( 'PPI::Token::Word' );
            $self->_messagef( 5, "Found %d word elements inside break element.", scalar( @$words ) ) if( $self->{debug} >= 5 );
            my $word1 = ( scalar( @$words ) ? $words->[0]->content // '' : '' );
            my $word2 = ( scalar( @$words ) > 1 ? $words->[1]->content // '' : '' );
            $self->_message( 5, "Word 1 -> ", $word1 ) if( $self->{debug} >= 5 );
            $self->_message( 5, "Word 2 -> ", $word2 ) if( $self->{debug} >= 5 && scalar( @$words ) > 1 );
            # $self->_browse( $e );
            # If we found a break word without a label, i.e. next, last, redo,
            # we replace it with a special return statement
            if( (
                  scalar( @$words ) == 1 ||
                  ( scalar( @$words ) > 1 && $word2 =~ /^(for|foreach|given|if|unless|until|while)$/ ) ||
                  $word1 eq 'return'
                ) &&
                (
                  $word1 eq 'next' ||
                  $word1 eq 'last' ||
                  $word1 eq 'redo' ||
                  $word1 eq 'return'
                ) )
            {
                # We add our special return value. Notice that we use 'return' and not
                # 'CORE::return'. See below why.
                # my $break_code = qq{return( '__} . uc( $word1 ) . qq{__' )};
                my $break_code = q{$Nice::Try::BREAK='} . $word1 . ( $word1 eq 'return' ? "', $e" : qq{', return} );
                # e.g. next if( $i == 2 );
                # next and if are both treated as 'word' by PPI
                if( scalar( @$words ) > 1 )
                {
                    ( my $ct = $e->content ) =~ s/^(next|last|redo)//;
                    $break_code .= $ct;
                }
                else
                {
                    $break_code .= ';'
                }
                $self->_message( 5, "Replacing this node with: $break_code" ) if( $self->{debug} >= 5 );

                my $break_doc = PPI::Document->new( \$break_code, readonly => 1 );
                my $new_elem = $break_doc->first_element;
                # $self->_browse( $new_elem );
                $new_elem->remove;
                $self->_message( 5, "New element is object '", sub{ overload::StrVal( $new_elem ) }, "' -> $new_elem" ) if( $self->{debug} >= 5 );
                # Not yet implemented as of 2021-05-11 dixit PPI, so we use a hack to make it available anyhow
                $self->_message( 5, "Updated element now is '$e' for class '", $e->class, "' and parent class '", $e->parent->class, "'." ) if( $self->{debug} >= 5 );
                $e->replace( $new_elem );
                # 2021-05-12 (Jacques): I have to do this workaround, because weirdly enough
                # PPI (at least with PPI::Node version 1.270) will refuse to add our element
                # if the 'return' word is 'CORE::return' so, we add it without and change it after
                # $new_elem->first_element->set_content( 'CORE::return' );
                # $self->_message( 5, "return litteral value is: ", $new_elem->first_element->content );
            }
            next;
        }

        if( $e->can('elements') && $e->elements )
        {
            $self->_process_loop_breaks( $e );
        }
    }
    # $self->_message( 5, "Element now is: '", sub{ $elem->content }, "'" );
    # $self->_message( 5, "Element now is: '$elem'" );
    # $self->_browse( $elem );
    return( $elem );
}

## Taken from PPI::Document
sub _serialize
{
    my $self   = shift( @_ );
    my $ppi    = shift( @_ ) || return( '' );
    no warnings 'uninitialized';
    my @tokens = $ppi->tokens;

    # The here-doc content buffer
    my $heredoc = '';

    # Start the main loop
    my $output = '';
    foreach my $i ( 0 .. $#tokens ) {
        my $Token = $tokens[$i];

        # Handle normal tokens
        unless ( $Token->isa('PPI::Token::HereDoc') ) {
            my $content = $Token->content;

            # Handle the trivial cases
            unless ( $heredoc ne '' and $content =~ /\n/ ) {
                $output .= $content;
                next;
            }

            # We have pending here-doc content that needs to be
            # inserted just after the first newline in the content.
            if ( $content eq "\n" ) {
                # Shortcut the most common case for speed
                $output .= $content . $heredoc;
            } else {
                # Slower and more general version
                $content =~ s/\n/\n$heredoc/;
                $output .= $content;
            }

            $heredoc = '';
            next;
        }

        # This token is a HereDoc.
        # First, add the token content as normal, which in this
        # case will definitely not contain a newline.
        $output .= $Token->content;

        # Now add all of the here-doc content to the heredoc buffer.
        foreach my $line ( $Token->heredoc ) {
            $heredoc .= $line;
        }

        if ( $Token->{_damaged} ) {
            # Special Case:
            # There are a couple of warning/bug situations
            # that can occur when a HereDoc content was read in
            # from the end of a file that we silently allow.
            #
            # When writing back out to the file we have to
            # auto-repair these problems if we aren't going back
            # on to the end of the file.

            # When calculating $last_line, ignore the final token if
            # and only if it has a single newline at the end.
            my $last_index = $#tokens;
            if ( $tokens[$last_index]->{content} =~ /^[^\n]*\n$/ ) {
                $last_index--;
            }

            # This is a two part test.
            # First, are we on the last line of the
            # content part of the file
            my $last_line = List::Util::none {
                $tokens[$_] and $tokens[$_]->{content} =~ /\n/
                } (($i + 1) .. $last_index);
            if ( ! defined $last_line ) {
                # Handles the null list case
                $last_line = 1;
            }

            # Secondly, are their any more here-docs after us,
            # (with content or a terminator)
            my $any_after = List::Util::any {
                $tokens[$_]->isa('PPI::Token::HereDoc')
                and (
                    scalar(@{$tokens[$_]->{_heredoc}})
                    or
                    defined $tokens[$_]->{_terminator_line}
                    )
                } (($i + 1) .. $#tokens);
            if ( ! defined $any_after ) {
                # Handles the null list case
                $any_after = '';
            }

            # We don't need to repair the last here-doc on the
            # last line. But we do need to repair anything else.
            unless ( $last_line and ! $any_after ) {
                # Add a terminating string if it didn't have one
                unless ( defined $Token->{_terminator_line} ) {
                    $Token->{_terminator_line} = $Token->{_terminator};
                }

                # Add a trailing newline to the terminating
                # string if it didn't have one.
                unless ( $Token->{_terminator_line} =~ /\n$/ ) {
                    $Token->{_terminator_line} .= "\n";
                }
            }
        }

        # Now add the termination line to the heredoc buffer
        if ( defined $Token->{_terminator_line} ) {
            $heredoc .= $Token->{_terminator_line};
        }
    }

    # End of tokens

    if ( $heredoc ne '' ) {
        # If the file doesn't end in a newline, we need to add one
        # so that the here-doc content starts on the next line.
        unless ( $output =~ /\n$/ ) {
            $output .= "\n";
        }

        # Now we add the remaining here-doc content
        # to the end of the file.
        $output .= $heredoc;
    }

    $output;
}


{
    # NOTE: Nice::Try::ScopeGuard class
    package # hide from PAUSE
        Nice::Try::ScopeGuard;

    # older versions of perl have an issue with $@ during global destruction
    use constant UNSTABLE_DOLLARAT => ("$]" < '5.013002') ? 1 : 0;

    sub _new
    {
        my $this = shift( @_ );
        return( bless( [ @_ ] => ( ref( $this ) || $this ) ) );
    }

    sub DESTROY
    {
        my( $code, $args, $catch_err ) = @{ $_[0] };
        # save the current exception to make it available in the finally sub,
        # and to restore it after the eval
        my $err = defined( $catch_err ) ? $catch_err : $@;
        local $@ if( UNSTABLE_DOLLARAT );
        $@ = $catch_err if( defined( $catch_err ) );
        CORE::eval
        {
            $@ = $err;
            $code->( @$args );
            1;
        }
        or do
        {
            CORE::warn
            "Execution of finally() block $code resulted in an exception, which "
            . '*CAN NOT BE PROPAGATED* due to fundamental limitations of Perl. '
            . 'Your program will continue as if this event never took place. '
            . "Original exception text follows:\n\n"
            . (defined $@ ? $@ : '$@ left undefined...')
            . "\n"
            ;
        };
        # maybe unnecessary?
        $@ = $err;
    }
}

{
    package
        Nice::Try::ObjectContext;

    sub new
    {
        my $that = shift( @_ );
        # print( STDERR "Got here in Nice::Try::ObjectContext->new with args '", join( "', '", @_ ), "'\n" );
        return( bless( { val => [@_] } => ( ref( $that ) || $that ) ) );
    }

    sub callback
    {
        my $self = shift( @_ );
        # print( STDERR "Got here in Nice::Try::ObjectContext->dummy with args '", join( "', '", @_ ), "'\n" );
        return( $self->{val}->[0] );
    }
}

{
    package
        PPI::Element;

    no warnings 'redefine';
    sub replace {
        my $self    = ref $_[0] ? shift : return undef;
        # If our object and the other are not of the same class, PPI refuses to replace
        # to avoid damages to perl code
        # my $other = _INSTANCE(shift, ref $self) or return undef;
        my $other = shift;
        # die "The ->replace method has not yet been implemented";
        $self->parent->__replace_child( $self, $other );
        1;
    }
}

1;

# XXX POD
__END__