view release on metacpan or  search on metacpan

lib/Dist/Zilla/App/Command/perltidy.pm  view on Meta::CPAN

package Dist::Zilla::App::Command::perltidy;
$Dist::Zilla::App::Command::perltidy::VERSION = '0.21';
use strict;
use warnings;

# ABSTRACT: perltidy your dist
use Dist::Zilla::App -command;
use Path::Iterator::Rule;
use File::Copy;

sub abstract {'perltidy your dist'}

my $backends = {
    vanilla => sub {
        local @ARGV = ();
        require Perl::Tidy;
        return sub {
            local @ARGV = ();
            Perl::Tidy::perltidy(@_);
        };
    },
    sweet => sub {
        local @ARGV = ();
        require Perl::Tidy::Sweetened;
        return sub {
            local @ARGV = ();
            Perl::Tidy::Sweetened::perltidy(@_);
        };
    },
};

sub opt_spec {
    [ 'backend|b=s', 'tidy backend to use', { default => 'vanilla' } ];
}

sub execute {
    my ( $self, $opt, $arg ) = @_;

    # use perltidyrc from command line or from config
    my $perltidyrc;
    if ( scalar @$arg and -r $arg->[0] ) {
        $perltidyrc = $arg->[0];
    } else {
        my $plugin = $self->zilla->plugin_named('PerlTidy');
        if ( defined $plugin and defined $plugin->perltidyrc ) {
            $perltidyrc = $plugin->perltidyrc;
        }
    }

    # Verify that if a file is specified it is readable
    if ( defined $perltidyrc and not -r $perltidyrc ) {
        $self->zilla->log_fatal(
            [   "specified perltidyrc is not readable: %s ,\nNote: ~ and other shell expansions are not applicable",
                $perltidyrc
            ]
        );
    }

    if ( not exists $backends->{ $opt->{backend} } ) {
        $self->zilla->log_fatal(
            [   "specified backend not known, known backends are: %s ",
                join q[,], sort keys %{$backends}
            ]
        );
    }

    my $tidy = $backends->{ $opt->{backend} }->();

# RT 91288
# copied from https://metacpan.org/source/KENTNL/Dist-Zilla-PluginBundle-Author-KENTNL-2.007000/utils/strip_eol.pl
    my $rule = Path::Iterator::Rule->new();
    $rule->skip_vcs;
    $rule->skip(
        sub {
            return if not -d $_;
            if ( $_[1] =~ qr/^\.build$/ ) {
                $self->zilla->log_debug('Ignoring .build');
                return 1;
            }
            if ( $_[1] =~ qr/^[A-Za-z].*-[0-9.]+(-TRIAL)?$/ ) {
                $self->zilla->log_debug('Ignoring dzil build tree');
                return 1;
            }
            return;
        }
    );