view release on metacpan or  search on metacpan

lib/Devel/IntelliPerl.pm  view on Meta::CPAN

package Devel::IntelliPerl;
our $VERSION = '0.04';

use Moose;
use Moose::Util::TypeConstraints;
use PPI;
use Class::MOP;
use Path::Class;
use List::Util qw(first);

my $KEYWORD = '[a-zA-Z_][_a-zA-Z0-9]*';
my $CLASS   = '(' . $KEYWORD . ')(::' . $KEYWORD . ')*';
my $VAR     = '\$' . $CLASS;


has line_number => ( isa => 'Int', is => 'rw', required => 1 );
has column      => ( isa => 'Int', is => 'rw', required => 1 );
has filename    => ( isa => 'Str', is => 'rw', trigger  => \&update_inc );
has source      => ( isa => 'Str', is => 'rw', required => 1 );
has inc => ( isa => 'ArrayRef[Str]', is => 'rw' );
has ppi => (
    isa     => 'PPI::Document',
    is      => 'rw',
    lazy    => 1,
    builder => '_build_ppi',
    clearer => 'clear_ppi'
);
has error => ( isa => 'Str', is => 'rw' );

after source => sub {
    my $self = shift;
    $self->clear_ppi if (@_);
};

after inc => sub {
    my $self = shift;
    unshift( @INC, @{ $_[0] } ) if ( $_[0] );
};

sub update_inc {
    my $self = shift;
    return unless ( $self->filename );
    my $parent = Path::Class::File->new( $self->filename );
    my @libs;
    while ( $parent = $parent->parent ) {
        last if ( $parent eq $parent->parent );
        last unless -d $parent;
        push( @libs, $parent->subdir('lib')->stringify )
          if ( -e $parent->subdir('lib') );
    }
    return $self->inc( \@libs );
}

sub line {
    my ( $self, $line ) = @_;
    my @source = split( "\n", $self->source );
    if ( defined $line ) {
        $source[ $self->line_number - 1 ] = $line;
        $self->source( join( "\n", @source ) );
    }
    return $source[ $self->line_number - 1 ];
}

sub inject_statement {
    my ( $self, $statement ) = @_;
    my $line = $self->line;
    my $prefix = substr( $line, 0, $self->column - 1 );
    my $postfix;
    $postfix = substr( $self->line, $self->column - 1 )
      if ( length $self->line >= $self->column );
    $self->line( $prefix . $statement . ( $postfix || '' ) );
    return $self->line;
}

sub _build_ppi {
    return PPI::Document->new( \( shift->source ) );
}

sub keyword {
    my ($self) = @_;
    my $line = substr( $self->line, 0, $self->column - 1 );
    if ( $line =~ /.*?(\$?$CLASS(->($KEYWORD))*)->($KEYWORD)?$/ ) {
        return $1 || '';
    }
}

sub prefix {
    my ($self) = @_;
    my $line = substr( $self->line, 0, $self->column - 1 );
    if ( $line =~ /.*?(\$?$CLASS)->($KEYWORD)?$/ ) {
        return $4 || '';
    }
}

sub handle_self {
    my ( $self, $keyword ) = @_;
    $self->inject_statement('; my $FINDME;');
    my $doc     = $self->ppi;
    my $package = $doc->find_first('Statement::Package');