File Coverage

blib/lib/ShipIt/Step/ChangeAllVersions.pm

Criterion	Covered	Total	%
statement	71	73	97.2
branch	17	22	77.2
condition	4	6	66.6
subroutine	12	12	100.0
pod	1	5	20.0
total	105	118	88.9

package ShipIt::Step::ChangeAllVersions;

use 5.008_001;
use strict;
use warnings;

our $VERSION = '1.001';

use parent qw(ShipIt::Step);
use Fatal qw(open close rename opendir closedir);
use File::Find qw(find);

my $looks_like_perl = qr/\. p(?: [ml]c? | od | erl ) \z/xms;

sub collect_files {
    my @files;

    # from subdir
    find sub {
        return if not ( -f $_ && not -l $_ );

        if($_ =~ $looks_like_perl) {
            push @files, $File::Find::name;
        }
        else {
            open my $in, '<', $_;
            read $in, my($buff), 2; # I don't care whether it fail or not

            if($buff && $buff eq '#!'){
                push @files, $File::Find::name;
            }
            close $in;
       }
    }, grep{ -d } qw(lib script bin);

    # from toplevel
    opendir my $dirh, '.';
    push @files, grep { ! -l $_ } grep{ $_ =~ $looks_like_perl } readdir($dirh);
    closedir $dirh;

    return @files;
}

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

    my $dry_run = $state->dry_run;

    if($dry_run){
        $self->log("*** DRY RUN, not actually updating versions.");
    }

    my $current_version = quotemeta $state->pt->{version};
    my $new_version     = $state->version;

    foreach my $module ($self->collect_files) {
        open my $in,  '<', $module;
        binmode $in;

        my $out;
        if(!$dry_run){
            open $out, '>', "$module.tmp";
            binmode $out;
        }

        my $need_replace = 0;

        while (<$in>) {

            # update $VERSION variable
            if (s/(\$VERSION .+) \b $current_version \b/$1$new_version/xms) {
                $self->{changed_version_variable}{$module}++;
                $self->log("Update \$VERSION in $module.");
                $need_replace++;
            }

            # update the VERSION section which says,
            # "This is Foo version $ver.",
            # or "This document descrives Foo version $ver."
            if (/\A =head1 \s+ VERSION\b/xms ... /\A =\w+/xms) {
                if (s/(version \b .+) $current_version/$1$new_version/xms) {
                    $self->{changed_version_section}{$module}++;
                    $self->log("Update the VERSION section in $module.");
                    $need_replace++;
                }
            }

            print $out $_ if defined $out;
        }

        close $in;

        next if $dry_run;

        close $out;

        if($need_replace){
            rename $module       => "$module~";
            rename "$module.tmp" => $module;

            unlink "$module~";
        }
        else{
            unlink "$module.tmp";
        }
    }

    return 1;
}

sub changed_version_variable { # for testing
    return $_[0]->{changed_version_variable};
}

sub changed_version_section { # for testing
    return $_[0]->{changed_version_section};
}

sub log {
    my $self = shift;
    print @_, "\n";
}

1;
__END__