Bug#872432: [PATCH 1/1] New "--extra-ignore" flag to ignore additional files from licensecheck

IOhannes m zmölnig (Debian/GNU) umlaeute at debian.org
Fri Oct 6 08:29:22 UTC 2017


that's in addition to "some backup and VCS files" which we usually want
to ignore in any case.

Closes: #872432
---
 bin/licensecheck        | 22 +++++++++++++---------
 lib/App/Licensecheck.pm | 23 +++++++++++++++++++----
 2 files changed, 32 insertions(+), 13 deletions(-)

diff --git a/bin/licensecheck b/bin/licensecheck
index df8da68..4148eae 100755
--- a/bin/licensecheck
+++ b/bin/licensecheck
@@ -61,6 +61,9 @@ my ( $opt, $usage ) = describe_options(
 	[   'ignore|i=s', 'regular expression of files to skip',
 		{ default => 'some backup and VCS files' }
 	],
+	[   'extra-ignore|x=s', 'regular expression of additional files to skip',
+		{ default => '<none>' }
+	],
 	[ 'recursive|r', 'traverse directories recursively' ],
 	[],
 	[   'lines|l=i',
@@ -128,15 +131,16 @@ print( "$progname: No paths provided.\n", $usage->leader_text ), exit 2
 	unless @ARGV;
 
 my $app = App::Licensecheck->new(
-	check_regex  => $opt->check,
-	ignore_regex => $opt->ignore,
-	recursive    => $opt->recursive,
-	lines        => $opt->lines,
-	tail         => $opt->tail,
-	verbose      => $opt->verbose,
-	skipped      => $opt->skipped,
-	deb_fmt      => $opt->deb_fmt // $opt->deb_machine,
-	deb_machine  => $opt->deb_machine,
+	check_regex        => $opt->check,
+	ignore_regex       => $opt->ignore,
+	ignore_extra_regex => $opt->extra_ignore,
+	recursive          => $opt->recursive,
+	lines              => $opt->lines,
+	tail               => $opt->tail,
+	verbose            => $opt->verbose,
+	skipped            => $opt->skipped,
+	deb_fmt            => $opt->deb_fmt // $opt->deb_machine,
+	deb_machine        => $opt->deb_machine,
 );
 
 if ( $opt->deb_machine ) {
diff --git a/lib/App/Licensecheck.pm b/lib/App/Licensecheck.pm
index fa85b30..1639477 100755
--- a/lib/App/Licensecheck.pm
+++ b/lib/App/Licensecheck.pm
@@ -138,6 +138,19 @@ has ignore_regex => (
 	default => sub {qr/$default_ignore_regex/x},
 );
 
+has ignore_extra_regex => (
+	is     => 'rw',
+	lazy   => 1,
+	coerce => sub {
+		my $value = shift;
+		return qr/^$/x
+			if $value eq '<none>';
+		return $value if ref $value eq 'Regexp';
+		return qr/$value/;
+	},
+	default => sub {qr/^$/x},
+);
+
 has recursive => (
 	is => 'rw',
 );
@@ -181,16 +194,18 @@ sub find
 {
 	my ( $self, @paths ) = @_;
 
-	my $check_re  = $self->check_regex;
-	my $ignore_re = $self->ignore_regex;
-	my $rule      = Path::Iterator::Rule->new;
-	my %options   = (
+	my $check_re   = $self->check_regex;
+	my $ignore_re  = $self->ignore_regex;
+	my $ignore_rex = $self->ignore_extra_regex;
+	my $rule       = Path::Iterator::Rule->new;
+	my %options    = (
 		follow_symlinks => 0,
 	);
 
 	$rule->max_depth(1)
 		unless $self->recursive;
 	$rule->not( sub {/$ignore_re/} );
+	$rule->not( sub {/$ignore_rex/} );
 	$rule->file->nonempty;
 
 	if ( @paths >> 1 ) {
-- 
2.14.2



More information about the pkg-perl-maintainers mailing list