Merge pull request #13 from briandfoy/briandfoy/git_status_ignore_unt…

…racked

git status ignore untracked - briandfoy/module-release#47

Co-authored-by: H.Merijn Brand <github@tux.freedom.nl>

.github/workflows/linux.yml

@@ -42,9 +42,6 @@ jobs:
             os:
                 - ubuntu-22.04
             perl-version:
-                - '5.10'
-                - '5.12'
-                - '5.14'
                 - '5.16'
                 - '5.18'
                 - '5.20'

MANIFEST

@@ -9,6 +9,7 @@ MANIFEST			This list of files
 MANIFEST.SKIP
 README.pod
 t/check_vcs.t
+t/lib/Local/Config.pm
 t/load.t
 t/pod.t
 t/pod_coverage.t

Makefile.PL

@@ -44,7 +44,7 @@ my $github    = 'https://github.com/briandfoy/module-release-git';
 my $main_file = catfile( 'lib', split /::/, "$module.pm" );
 
 my %WriteMakefile = (
-	'MIN_PERL_VERSION' => '5.010',
+	'MIN_PERL_VERSION' => '5.016',
 
 	'NAME'	        => $module,
 	'ABSTRACT_FROM' => $main_file,

lib/Module/Release/Git.pm

@@ -19,7 +19,7 @@ our @EXPORT = qw(
 	vcs_tag
 	);
 
-our $VERSION = '1.016';
+our $VERSION = '1.017';
 
 =encoding utf8
 
@@ -48,7 +48,8 @@ This module depends on the external git binary (so far).
 
 =item check_vcs()
 
-Check the state of the Git repository.
+Check the state of the Git repository. If you set the C<ignore_untracked>
+config to a true value, B<git> will not complain about untracked files.
 
 =cut
 
@@ -58,12 +59,19 @@ sub _get_time {
 	POSIX::strftime( '%Y%m%d%H%M%S', localtime );
 	}
 
+sub _git_status_command {
+	my $self = shift;
+	my $opt = $self->config->ignore_untracked ? '-uno' : '';
+	return "git status -s $opt 2>&1";
+	}
+
 sub check_vcs {
 	my $self = shift;
 
 	$self->_print( "Checking state of Git... " );
 
-	my $git_status = $self->run('git status -s 2>&1');
+	my $command = _git_status_command($self);
+	my $git_status = $self->run( $command );
 
 	no warnings 'uninitialized';
 
@@ -188,6 +196,7 @@ sub vcs_branch {
 
 	my( $self ) = @_;
 	( $branch ) = $self->run('git rev-parse --abbrev-ref HEAD');
+	no warnings qw(uninitialized);
 	chomp( $branch );
 	$branch;
 	}
@@ -291,7 +300,7 @@ brian d foy, <bdfoy@cpan.org>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright © 2007-2021, brian d foy <bdfoy@cpan.org>. All rights reserved.
+Copyright © 2007-2023, brian d foy <bdfoy@cpan.org>. All rights reserved.
 
 You may redistribute this under the same terms as the Artistic License 2.0.
 

t/check_vcs.t

@@ -11,13 +11,47 @@ use Test::More 'no_plan';
 my $class  = 'Module::Release::Git';
 my $method = 'check_vcs';
 
+use lib qw(t/lib);
+
+use_ok( 'Local::Config' );
+use_ok( 'Module::Release' );
 use_ok( $class );
 can_ok( $class, $method );
 
 # are we where we think we're starting?
 can_ok( $class, 'run' );
 is( $class->run, $output );
 
+subtest dummy_releaserc => sub {
+	if( -e 'releaserc' ) { return pass( "releaserc exists" ) }
+	my $fh;
+	unless( open $fh, '>', 'releaserc' ) {
+		return fail( "Could not create releaserc: $!" );
+		}
+	print { $fh } "cpan_user ADOPTME\n";
+	pass( "Created releaserc" );
+	};
+
+my $release = Module::Release->new;
+$release->load_mixin( $class );
+can_ok( $release, $method );
+
+our $config_hash = {
+	commit_message_format => 'nonsense foo bar %s'
+	};
+
+{
+package Module::Release;
+no warnings qw(redefine once);
+*run          = sub { $Module::Release::Git::run_output };
+*remote_file  = sub { $_[0]->{remote_file} };
+*dist_version = sub { $_[0]->{dist_version} };
+*_warn        = sub { 1 };
+*_print       = sub { 1 };
+*_get_time    = sub { '137' };
+*config       = sub { Local::Config->new( $config_hash ) };
+}
+
 # we're testing, so turn off output (kludge)
 {
 no warnings 'redefine';
@@ -27,38 +61,46 @@ no warnings 'redefine';
 
 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 # Test when there is nothing left to commit (using the starting $output)
-foreach my $try (qw(fine_output clean_output_git_2x)) {
-	no strict 'refs';
-	local $Module::Release::Git::run_output = ${ "Module::Release::Git::$try" };
-
-	my $rc = eval { $class->$method() };
-	my $at = $@;
-	diag( "EVAL error: $at" ) if $at;
-
-	ok( ! $at, "(Nothing left to commit) \$@ undef (good)" );
-	ok( $rc, "(Nothing left to commit) returns true (good)" );
-	}
+subtest nothing_left_to_commit => sub {
+	foreach my $try (qw(fine_output clean_output_git_2x)) {
+		subtest $try => sub {
+			no strict 'refs';
+			local $Module::Release::Git::run_output = ${ "Module::Release::Git::$try" };
+
+			my $rc = eval { $release->$method() };
+			my $at = $@;
+			diag( "EVAL error: $at" ) if $at;
+
+			ok( ! $at, "(Nothing left to commit) \$@ undef (good)" );
+			is( $rc, 1, "(Nothing left to commit) returns true (good)" );
+			};
+		}
+	};
 
 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 # Test when there is a new file
-foreach my $try (qw(newfile_output changedfile_output
-	untrackedfile_output combined_output ) )
-	{
-	no strict 'refs';
-	local $Module::Release::Git::run_output =
-		${ "Module::Release::Git::$try" };
-
-	#print STDERR "try is $Module::Release::Git::run_output\n";
-
-	my $rc = eval { $class->$method() };
-	my $at = $@;
-
-	#print STDERR "At is $@\n";
-
-	ok( defined $at, "(Dirty working dir) \$@ defined (good)" );
-	ok( ! $rc, "(Dirty working dir) returns true (good)" );
-	like( $at, qr/not up-to-date/, "Reports that Git is not up-to-date" );
-	}
+subtest working_tree_dirty => sub {
+	foreach my $try (qw(newfile_output changedfile_output
+		untrackedfile_output combined_output ) )
+		{
+		subtest $try => sub {
+			no strict 'refs';
+			local $Module::Release::Git::run_output =
+				${ "Module::Release::Git::$try" };
+
+			#print STDERR "try is $Module::Release::Git::run_output\n";
+
+			my $rc = eval { $release->$method() };
+			my $at = $@;
+
+			#print STDERR "At is $@\n";
+
+			ok( defined $at, "(Dirty working dir) \$@ defined (good)" );
+			ok( ! $rc, "(Dirty working dir) returns true (good)" );
+			like( $at, qr/not up-to-date/, "Reports that Git is not up-to-date" );
+			};
+		}
+	};
 
 # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 =pod

t/lib/Local/Config.pm

@@ -0,0 +1,9 @@
+package Local::Config;
+sub new { bless $_[1], $_[0] }
+sub DESTROY { 1 }
+sub AUTOLOAD {
+	our $AUTOLOAD;
+	( my $method = $AUTOLOAD ) =~ s/.*:://;
+	exists $_[0]{$method} ? $_[0]{$method} : ()
+	}
+1;

t/vcs_branch.t

@@ -2,10 +2,13 @@
 use strict;
 use vars qw($run_output);
 
+use lib qw(t/lib);
+
 use Test::More;
 
 my $class  = 'Module::Release::Git';
 
+use_ok( 'Local::Config' );
 use_ok( 'Module::Release' );
 
 subtest dummy_releaserc => sub {
@@ -140,15 +143,4 @@ subtest allowed_branch => sub {
 
 	};
 
-BEGIN { # 5.10 syntax
-package Local::Config;
-sub new { bless $_[1], $_[0] }
-sub DESTROY { 1 }
-sub AUTOLOAD {
-	our $AUTOLOAD;
-	( my $method = $AUTOLOAD ) =~ s/.*:://;
-	exists $_[0]{$method} ? $_[0]{$method} : ()
-	}
-}
-
 done_testing();