view release on metacpan or  search on metacpan

lib/App/githook/perltidy/pre_commit.pm  view on Meta::CPAN

    }
}

our $temp_dir;

sub sys {
    my $self = shift;
    $v_status = join( ' ', map { defined $_ ? $_ : '*UNDEF*' } @_ ) . "\n";
    system(@_) == 0 or Carp::croak "@_ failed: $?";
}

sub tmp_sys {
    my $self = shift;
    local $ENV{GIT_WORK_TREE} = $temp_dir;
    $self->sys(@_);
}

sub tidy_perl {
    my $self     = shift;
    my $tmp_file = shift || die 'tidy_perl($TMP_FILE, $file)';
    my $file     = shift || die 'tidy_perl($tmp_file, $FILE)';
    my $where    = shift;

    state $req = do {
        no strict 'refs';
        if ( $self->sweetened ) {
            require Perl::Tidy::Sweetened;
            *perltidy = \&Perl::Tidy::Sweetened::perltidy;
        }
        else {
            require Perl::Tidy;
            *perltidy = \&Perl::Tidy::perltidy;
        }
    };

    $status = "(perltidy) ($where)";

    my $errormsg;
    my $error = perltidy(
        argv       => [ qw{-nst -b -bext=/}, "$tmp_file" ],
        errorfile  => \$errormsg,
        perltidyrc => $self->perltidyrc->stringify,
    );

    if ( length($errormsg) ) {
        $status .= ":\n";
        die $errormsg;
    }
    elsif ($error) {
        $status .= ":\n";
        die "An unknown perltidy error occurred.";
    }
}

sub tidy_pod {
    my $self     = shift;
    my $tmp_file = shift || die 'tidy_pod($TMP_FILE, $file)';
    my $file     = shift || die 'tidy_pod($tmp_file, $FILE)';
    my $where    = shift;

    state $req = require Pod::Tidy;
    $status = "(podtidy) ($where)";

    Pod::Tidy::tidy_files(
        files     => [$tmp_file],
        recursive => 0,
        verbose   => 0,
        inplace   => 1,
        nobackup  => 1,
        columns   => 72,
        %{ $self->podtidyrc_opts },
    );
}

sub critic_perl {
    my $self     = shift;
    my $tmp_file = shift || die 'critic_perl($TMP_FILE, $file)';
    my $file     = shift || die 'critic_perl($tmp_file, $FILE)';
    my $where    = shift;

    state $req = require Perl::Critic;
    $status = "(perlcritic) ($where)";

    my @violations =
      Perl::Critic::critique( { -profile => $self->perlcriticrc->stringify },
        $tmp_file->stringify );

    if (@violations) {
        $status .= ":\n";
        die join( '', @violations );
    }
}

sub convert_readme {
    my $self = shift;
    my $file = shift || die 'convert_readme($FILE)';

    $status = '-> README';

    my $width = $self->podtidyrc_opts->{columns} // 72;

    require Pod::Text;
    Pod::Text->new( sentence => 0, width => $width )
      ->parse_from_file( "$file", 'README' );

    if ( system("git ls-files --error-unmatch README > /dev/null 2>&1") == 0 ) {
        $self->sys(qw/git add README/);
    }
}

sub run {
    my $self      = shift;
    my @perlfiles = ();
    my %partial   = ();

    untie $v_status unless $self->verbose;

    return if $ENV{NO_GITHOOK_PERLTIDY};
    $temp_dir = Path::Tiny->tempdir('githook-perltidy-XXXXXXXX');

    $v_status = "TMP=$temp_dir\n";

    my @index;
    my $force_readme = 0;
    my $readme_from  = $self->readme_from // '';

    # Use the -z flag to get clean filenames with no escaping or quoting
    # "lines" are separated with NUL, so set input record separator
    # appropriately
    {
        local $/ = "\0";
        open( my $fh, '-|', 'git status --porcelain -z' ) || die "open: $!";

        while ( my $line = <$fh> ) {
            chomp $line;
            next unless $line =~ m/^[ACMR](.) (.*)/;
            my ( $wtree, $file ) = ( $1, $2 );

            push( @index, $file );
            $partial{$file} = $wtree eq 'M';