view release on metacpan or  search on metacpan

lib/Git/Reduce/Tests.pm  view on Meta::CPAN

        sub {
            $_ =~ m/\.$self->{params}->{test_extension}$/ and
                push(@tfiles, $File::Find::name)
        },
        $self->{params}->{dir}
    );

    my (@includes, @excludes);
    if ($self->{params}->{include}) {
        @includes = split(',' => $self->{params}->{include});
        croak("Did not specify test files to be included in reduced branch")
            unless @includes;
    }
    if ($self->{params}->{exclude}) {
        @excludes = split(',' => $self->{params}->{exclude});
        croak("Did not specify test files to be exclude from reduced branch")
            unless @excludes;
    }
    if ($self->{params}->{verbose}) {
        print "Test files:\n";
        print Dumper [ sort @tfiles ];
        if ($self->{params}->{include}) {
            print "Included test files:\n";
            print Dumper(\@includes);
        }
        if ($self->{params}->{exclude}) {
            print "Excluded test files:\n";
            print Dumper(\@excludes);
        }
    }
    # Create lookup tables for test files to be included in,
    # or excluded from, the reduced branch.
    my %included = map { +qq{$self->{params}->{dir}/$_} => 1 } @includes;
    my %excluded = map { +qq{$self->{params}->{dir}/$_} => 1 } @excludes;
    my @removed = ();
    if ($self->{params}->{include}) {
        @removed = grep { ! exists($included{$_}) } sort @tfiles;
    }
    if ($self->{params}->{exclude}) {
        @removed = grep { exists($excluded{$_}) } sort @tfiles;
    }
    if ($self->{params}->{verbose}) {
        print "Test files to be removed:\n";
        print Dumper(\@removed);
    }

    # Remove undesired test files and commit the reduced branch.
    $self->{git}->rm(@removed);
    $self->{git}->commit( '-m', "Remove unwanted test files" );
    return ($reduced_branch);
}

=head2 C<push_to_remote()>

=over 4

=item * Purpose

Push the reduced branch to the remote specified in the C<--remote> option,
which defaults to C<origin>.  This, of course, assumes that the user has
permission to perform that action, has proper credentials such as SSH keys,
etc.

=item * Arguments

    $self->push_to_remote($reduced_branch);

String holding name of branch with reduced test suite -- typically the return
value of the C<prepare_reduced_branch()> method.

=item * Return Value

Implicitly returns a true value upon success.

=back

=cut

sub push_to_remote {
    my ($self, $reduced_branch) = @_;
    unless ($self->{params}->{no_push}) {
        local $@;
        eval { $self->{git}->push($self->{params}->{remote}, "+$reduced_branch"); };
        croak($@) if $@;
        print "Pushing '$reduced_branch' to $self->{params}->{remote}\n"
            if $self->{params}->{verbose};
    }
    print "Finished!\n" if $self->{params}->{verbose};
}

##### INTERNAL METHODS #####

sub _get_branches {
    my $self = shift;
    my @branches = $self->{git}->branch;
    my %branches;

    for (@branches) {
        if (m/^\*\s+(.*)/) {
            my $br = $1;
            $branches{$br} = 'current';
        }
        else {
            if (m/^\s+(.*)/) {
                my $br = $1;
                $branches{$br} = 1;
            }
            else {
                croak "Could not get branch";
            }
        }
    }
    return \%branches;
}

sub _dump_branches {
    my $self = shift;
    my $branches = $self->_get_branches();
    print Dumper $branches;
}