File Coverage

blib/lib/App/Rad/Exclude.pm

Criterion	Covered	Total	%
statement	9	48	18.7
branch	0	24	0.0
condition			n/a
subroutine	3	7	42.8
pod	2	2	100.0
total	14	81	17.2

package App::Rad::Exclude;
use Carp qw/carp croak/;
use strict;
use warnings;

our $VERSION = '0.01';

sub load {
    my ($self, $c) = @_;
    $c->register('exclude', \&exclude, 'completely erase command from your program');
}

# removes given sub from the
# main program
sub _remove_code_from_file {
    my $sub = shift;

    #TODO: I really should be using PPI
    #if the user has it installed...
    open my $fh, '+<', $0
        or croak "error updating file $0: $!\n";

#    flock($fh, LOCK_EX) or carp "could not lock file $0: $!\n";

    my @file = <$fh>;
    my $ret = _remove_code_from_array(\@file, $sub);

    # TODO: only change the file if it's eval'd without errors
    seek ($fh, 0, 0) or croak "error seeking file $0: $!\n";
    print $fh @file or croak "error writing to file $0: $!\n";
    truncate($fh, tell($fh)) or croak "error truncating file $0: $!\n";

    close $fh;

    return $ret;
}

sub _remove_code_from_array {
    my $file_array_ref = shift;
    my $sub = shift;

    my $index = 0;
    my $open_braces = 0;
    my $close_braces = 0;
    my $sub_start = 0;
    while ( $file_array_ref->[$index] ) {
        if ($file_array_ref->[$index] =~ m/\s*sub\s+$sub(\s+|\s*\{)/) {
            $sub_start = $index;
        }
        if ($sub_start) {
            # in order to see where the sub ends, we'll
            # try to count the number of '{' against
            # the number of '}' available

            #TODO:I should use an actual LR parser or
            #something. This would be greatly enhanced
            #and much less error-prone, specially for
            #nested symbols in the same line.
            $open_braces++ while $file_array_ref->[$index] =~ m/\{/g;
            $close_braces++ while $file_array_ref->[$index] =~ m/\}/g;
            if ( $open_braces > 0 ) {
                if ( $close_braces > $open_braces ) {
                    croak "Error removing $sub: could not parse $0 correctly.";
                }
                elsif ( $open_braces == $close_braces ) {
                    # remove lines from array
                    splice (@{$file_array_ref}, $sub_start, ($index + 1 - $sub_start));
                    last;
                }
            }
        }
    }
    continue {
        $index++;
    }

    if ($sub_start == 0) {
        return "Error finding '$sub' command. Built-in?";
    }
    else {
        return "Command '$sub' successfuly removed.";
    }
}

sub exclude {
    my $c = shift;
    if ( $c->argv->[0] ) {
        if ( $c->is_command( $c->argv->[0] ) ) {
            return _remove_code_from_file($c->argv->[0]);
        }
        else {
            return $c->argv->[0] . ' is not an available command';
        }
    }
    else {
        return "Sintax: $0 exclude command_name"
    }
}

42;
__END__