File Coverage

blib/lib/MooseX/Compile/CLI/Base.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

#!/usr/bin/perl

package MooseX::Compile::CLI::Base;
use Moose;

extends qw(MooseX::App::Cmd::Command);

use Path::Class;
use MooseX::AttributeHelpers;
use MooseX::Types::Path::Class;

has verbose => (
    documentation => "Print additional information while running.",
    metaclass     => "Getopt",
    cmd_aliases   => ["v"],
    isa => "Bool",
    is  => "rw",
    default => 0,
);

has force => (
    documentation => "Process without asking.",
    metaclass     => "Getopt",
    cmd_aliases   => ["f"],
    isa => "Bool",
    is  => "rw",
    default => 0,
);

has dirs => (
    documentation => "Directories to process recursively.",
    #traits        => [qw(Getopt Collection::Array)],
    metaclass     => "Getopt",
    cmd_aliases   => ["d"],
    isa => "ArrayRef",
    is  => "rw",
    auto_deref => 1,
    coerce     => 1,
    default    => sub { [] },
    #provides   => {
    #    push => "add_to_dirs",
    #},
);

sub add_to_dirs {
    my ( $self, @blah ) = @_;
    push @{ $self->dirs }, @blah;
}

has classes => (
    documentation => "Specific classes to process in 'inc'",
    #traits        => [qw(Getopt Collection::Array)],
    metaclass     => "Getopt",
    cmd_aliases   => ["c"],
    isa => "ArrayRef[Str]",
    is  => "rw",
    auto_deref => 1,
    coerce     => 1,
    default    => sub { [] },
    provides   => {
        push => "add_to_classes",
    },
);

sub add_to_classes {
    my ( $self, @blah ) = @_;
    push @{ $self->classes }, @blah;
}

override usage_desc => sub {
    super() . " [classes and dirs...]"
};

has perl_inc => (
    documentation => "Also include '\@INC' in the 'inc' dirs. Defaults to true.",
    isa => "Bool",
    is  => "rw",
    default => 1,
);

has local_lib => (
    documentation => "Like specifying '-I lib'",
    metaclass     => "Getopt",
    cmd_aliases   => ["l"],
    isa => "Bool",
    is  => "rw",
    default => 0,
);

has local_test_lib => (
    documentation => "Like specifying '-I t/lib'",
    metaclass     => "Getopt",
    cmd_aliases   => ["t"],
    isa => "Bool",
    is  => "rw",
    default => 0,
);

has inc => (
    documentation => "Library include paths in which specified classes are searched.",
    #traits        => [qw(Getopt Collection::Array)],
    metaclass     => "Getopt",
    cmd_aliases   => ["I"],
    isa => "ArrayRef",
    is  => "rw",
    auto_deref => 1,
    coerce     => 1,
    default    => sub { [] },
    #provides   => {
    #    push => "add_to_inc",
    #},
);

sub add_to_inc {
    my ( $self, @blah ) = @_;
    push @{ $self->inc }, @blah;
}

sub file_in_dir {
    my ( $self, %args ) = @_;

    my $dir = $args{dir} || die "dir is required";

    my $file = $args{file} ||= ($args{rel} || die "either 'file' or 'rel' is required")->absolute($dir);
    -f $file or die "file '$file' does not exist";

    my $rel = $args{rel} ||= $args{file}->relative($dir);
    $rel->is_absolute and die "rel is not relative";

    $args{class} ||= do {
        my $basename = $rel->basename;
        $basename =~ s/\.(?:pmc?|mopc)$//;

        $rel->dir->cleanup eq dir()
            ? $basename
            : join( "::", $rel->dir->dir_list, $basename );
    };

    return \%args;
}

sub filter_file {
    die "abstract method";
}

sub class_to_filename {
    my ( $self, $class ) = @_;

    ( my $file = "$class.pm" ) =~ s{::}{/}g;

    return $file;
}

sub run {
    my ( $self, $opts, $args ) = @_;

    $self->build_from_opts( $opts, $args );

    inner();
}

sub build_from_opts {
    my ( $self, $opts, $args ) = @_;

    foreach my $arg ( @$args ) {
        if ( -d $arg ) {
            $self->add_to_dirs($arg);
        } else {
            $self->add_to_classes($arg);
        }
    }

    @$args = ();

    $self->add_to_inc( dir("lib") ) if $self->local_lib;
    $self->add_to_inc( dir(qw(t lib)) ) if $self->local_test_lib;

    $self->add_to_inc( @INC ) if $self->perl_inc;

    inner();

    $_ = dir($_) for @{ $self->dirs }, @{ $self->inc };
};

sub all_files {
    my $self = shift;

    return (
        $self->files_from_dirs( $self->dirs ),
        $self->files_from_classes( $self->classes ),
    );
}


sub files_from_dirs {
    my ( $self, @dirs ) = @_;
    return unless @dirs;

    my @files;

    foreach my $dir ( @dirs ) {
        warn "Searching recursively in $dir\n" if $self->verbose;
        $dir->recurse(
            callback => sub {
                my $file = shift;
                push @files, $self->file_in_dir( file => $file, dir => $dir ) if !$file->is_dir and $self->filter_file($file);
            },
        );
    }

    return @files;
}

sub files_from_classes {
    my ( $self, @classes ) = @_;

    my @files = map { { class => $_, rel => file($self->class_to_filename($_)) }  } @classes;

    $self->files_in_includes(@files);
}

sub files_in_includes {
    my ( $self, @files ) = @_;

    map { $self->file_in_includes($_) } @files;
}

sub file_in_includes {
    my ( $self, $file ) = @_;

    my @matches = grep { $self->filter_file( $_->file($file->{rel}) ) } $self->inc;

    die "No file found for $file->{class}\n" unless @matches;

    map { $self->file_in_dir( %$file, dir => $_ ) } @matches;
}

__PACKAGE__

__END__

=pod

=head1 NAME

MooseX::Compile::CLI::Base - base class for commands working on classes and
directories of .pm files

=head1 SYNOPSIS

    package MooseX::Compile::CLI::Command::foo;
    use Moose;

    extends qw(MooseX::Compile::CLI::Base);

    sub filter_file {
        ...
    }

    augment run => sub {
        my $self = shift;

        $self->all_files();
    };

=head1 DESCRIPTION

This base class provides the various shared options for
L<MooseX::Compile::CLI::Command::clean> and
L<MooseX::Compile::CLI::Command::compile>.

=cut