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