summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorgregor herrmann <gregoa@debian.org>2021-08-19 01:48:24 +0200
committergregor herrmann <gregoa@debian.org>2021-08-19 01:48:24 +0200
commit4cdbd6c1df65153dac84f3d1ff273c915b61a236 (patch)
tree5e32219477dc82b53379c41af501e135a5163a44
parent5db35e368f5e68b167712b26509a3e1f5ed802b5 (diff)
parent690e071fa734b7c9dbf3dca3724c422ad2a4852c (diff)
Merge branch 'experimental'
-rw-r--r--bin/scan-copyrights9
-rw-r--r--debian/changelog28
-rw-r--r--debian/libconfig-model-dpkg-perl.examples1
-rw-r--r--examples/README.org9
-rw-r--r--examples/dpkg-new13
-rw-r--r--examples/dpkg-parser.pl19
-rw-r--r--examples/dpkg-writer.pl17
-rw-r--r--lib/Config/Model/Backend/Dpkg.pm70
-rw-r--r--lib/Config/Model/Backend/Dpkg/Autopkgtest.pm13
-rw-r--r--lib/Config/Model/Backend/Dpkg/Control.pm14
-rw-r--r--lib/Config/Model/Backend/Dpkg/Copyright.pm22
-rw-r--r--lib/Config/Model/Backend/Dpkg/DebHelperFile.pm1
-rw-r--r--lib/Config/Model/Backend/Dpkg/Meta.pm10
-rw-r--r--lib/Config/Model/Backend/Dpkg/Patch.pm16
-rw-r--r--lib/Config/Model/Backend/DpkgStoreRole.pm2
-rw-r--r--lib/Config/Model/Backend/DpkgSyntax.pm77
-rw-r--r--lib/Config/Model/Dpkg.pm7
-rw-r--r--lib/Config/Model/Dpkg/Copyright.pm46
-rw-r--r--lib/Config/Model/Dpkg/Copyright/License.pm9
-rw-r--r--lib/Config/Model/Dpkg/Dependency.pm28
-rw-r--r--lib/Config/Model/Dpkg/Lintian/Overrides.pm147
-rw-r--r--lib/Config/Model/models/Dpkg.d/source-name/Dpkg/Copyright.pl5
-rw-r--r--lib/Config/Model/models/Dpkg.pl36
-rw-r--r--lib/Config/Model/models/Dpkg/Install.pl2
-rw-r--r--lib/Config/Model/models/Dpkg/Source.pl18
-rw-r--r--lib/Config/Model/models/Dpkg/Tests/Control.pl2
-rw-r--r--lib/Dpkg/Copyright/Scanner.pm61
-rw-r--r--t/license-short-name.t2
-rw-r--r--t/lintian.t68
-rw-r--r--t/model_tests.d/dpkg-examples/lintian-overrides/debian/changelog6
-rw-r--r--t/model_tests.d/dpkg-examples/lintian-overrides/debian/control64
-rw-r--r--t/model_tests.d/dpkg-examples/lintian-overrides/debian/copyright38
-rw-r--r--t/model_tests.d/dpkg-examples/lintian-overrides/debian/libburn4.lintian-overrides9
-rw-r--r--t/model_tests.d/dpkg-examples/lintian-overrides/debian/lintian-overrides4
-rwxr-xr-xt/model_tests.d/dpkg-examples/lintian-overrides/debian/rules26
-rw-r--r--t/model_tests.d/dpkg-examples/lintian-overrides/debian/source/format1
-rw-r--r--t/model_tests.d/dpkg-examples/lintian-overrides/debian/source/lintian-overrides4
-rw-r--r--t/model_tests.d/dpkg-examples/t0/debian/examples/ex1.pl1
-rw-r--r--t/model_tests.d/dpkg-examples/t0/debian/examples/ex2.pl1
-rw-r--r--t/model_tests.d/dpkg-examples/t0/debian/t0.examples1
-rw-r--r--t/model_tests.d/dpkg-test-conf.pl27
-rw-r--r--t/perl-critic.t21
-rw-r--r--t/perlcriticrc16
-rw-r--r--t/scanner/README.md27
-rw-r--r--t/scanner/README.org69
-rw-r--r--t/scanner/examples/less.js.d/package.json33
-rw-r--r--t/scanner/examples/less.js.out4
-rw-r--r--t/scanner/examples/node-to-regex-range.d/package.json88
-rw-r--r--t/scanner/examples/node-to-regex-range.out4
-rw-r--r--t/scanner/scan-copyright.t2
50 files changed, 999 insertions, 199 deletions
diff --git a/bin/scan-copyrights b/bin/scan-copyrights
index 82908925..31470e0f 100644
--- a/bin/scan-copyrights
+++ b/bin/scan-copyrights
@@ -4,10 +4,15 @@ use 5.20.0;
use warnings ;
use strict;
use Path::Tiny;
+use Getopt::Long;
use Dpkg::Copyright::Scanner qw/print_copyright/;
my %args;
+my $long;
+
+GetOptions('long' => \$long);
+
if (my $input = $ENV{COPYRIGHT_SCANNER_INPUT} || $ARGV[0]) {
# used for test setup
my $input_path = path($input);
@@ -19,6 +24,10 @@ if (my $input = $ENV{COPYRIGHT_SCANNER_INPUT} || $ARGV[0]) {
}
}
+if ($long) {
+ $args{long} = 1;
+}
+
print_copyright(%args);
__END__
diff --git a/debian/changelog b/debian/changelog
index 0d832241..745c8f73 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -9,6 +9,34 @@ libconfig-model-dpkg-perl (2.147) unstable; urgency=medium
-- gregor herrmann <gregoa@debian.org> Thu, 19 Aug 2021 01:35:33 +0200
+libconfig-model-dpkg-perl (2.146) experimental; urgency=medium
+
+ [ Walter Lozano ]
+ * Support "author" as object in package.json
+ * Add test based on package less.js
+
+ [ Dominique Dumont ]
+ * translated t/scanner/README in org-mode file
+ * update t/scanner/README.org
+ * add Walter Lozano as contributor (thanks !)
+ * fixed lot of style issues reported by perlcritic
+ * handles debian/<pkg>.examples files
+
+ -- Dominique Dumont <dod@debian.org> Sun, 06 Jun 2021 16:04:27 +0200
+
+libconfig-model-dpkg-perl (2.145) experimental; urgency=medium
+
+ * test with lintian tag instead of pkg-perl tag
+
+ -- Dominique Dumont <dod@debian.org> Mon, 22 Mar 2021 14:09:56 +0100
+
+libconfig-model-dpkg-perl (2.144) experimental; urgency=medium
+
+ * handle lintian override files. Obsolete tags can be updated with
+ "cme fix dpkg" command.
+
+ -- Dominique Dumont <dod@debian.org> Sun, 21 Mar 2021 19:27:36 +0100
+
libconfig-model-dpkg-perl (2.143) unstable; urgency=medium
* Team upload.
diff --git a/debian/libconfig-model-dpkg-perl.examples b/debian/libconfig-model-dpkg-perl.examples
new file mode 100644
index 00000000..e39721e2
--- /dev/null
+++ b/debian/libconfig-model-dpkg-perl.examples
@@ -0,0 +1 @@
+examples/*
diff --git a/examples/README.org b/examples/README.org
new file mode 100644
index 00000000..538814b5
--- /dev/null
+++ b/examples/README.org
@@ -0,0 +1,9 @@
+This directory contains:
+
+- 2 examples using [[https://manpages.debian.org/buster/libconfig-model-dpkg-perl/Config::Model::Backend::DpkgSyntax.3pm.en.html][Config::Model::Backend::DpkgSyntax]] to read and
+ write Debian control files:
+ - dpkg-parser.pl :: an example to add DpkgSyntax role to a class and
+ parse a control file (=dpkg-test=)
+ - dpkg-writer.pl :: an example to add DpkgSyntax role to a class and
+ write a control file. The control data is hardcoded in
+ =dpkg-writer.pl= and the control file is shown on its output.
diff --git a/examples/dpkg-new b/examples/dpkg-new
deleted file mode 100644
index 4fbb6241..00000000
--- a/examples/dpkg-new
+++ /dev/null
@@ -1,13 +0,0 @@
-# section comment
-Name: Foo
-# data comment
-Version: 1.2
-
-Name: Bar
-Version: 1.3
-Files: file1,
-# inline comment
- file2
-Description: A very
- .
- long description
diff --git a/examples/dpkg-parser.pl b/examples/dpkg-parser.pl
index 53d9a8c9..c36b1289 100644
--- a/examples/dpkg-parser.pl
+++ b/examples/dpkg-parser.pl
@@ -5,6 +5,7 @@ use warnings;
use 5.20.1;
+# DpkgSyntax uses Log4perl, so we must initialise this module
use Log::Log4perl qw(:easy);
Log::Log4perl->easy_init($WARN);
@@ -13,17 +14,19 @@ use Mouse ;
with 'Config::Model::Backend::DpkgSyntax';
package main ;
-use IO::File;
-use Data::Dumper;
+use Path::Tiny;
+use YAML::XS;
-my $file = 'examples/dpkg-test';
-my $fh = IO::File->new();
-$fh->open("< $file");
+# load control file
+my $file = path('dpkg-test');
+# create your parser
my $parser = MyParser->new() ;
-my $data = $parser->parse_dpkg_file($file, $fh, 'yes', 1);
-$fh->close;
+# convert control file data in a Perl data structure
+# documented in Config::Model::Backend::DpkgSyntax
+my $data = $parser->parse_dpkg_file($file, 'yes', 1);
-print Dumper $data;
+# print this data in YAML format
+print Dump $data;
diff --git a/examples/dpkg-writer.pl b/examples/dpkg-writer.pl
index 85b91f49..8182988d 100644
--- a/examples/dpkg-writer.pl
+++ b/examples/dpkg-writer.pl
@@ -5,6 +5,7 @@ use warnings;
use 5.20.1;
+# DpkgSyntax uses Log4perl, so we must initialise this module
use Log::Log4perl qw(:easy);
Log::Log4perl->easy_init($WARN);
@@ -13,11 +14,13 @@ use Mouse ;
with 'Config::Model::Backend::DpkgSyntax';
package main ;
-use IO::File;
-use Data::Dumper;
+use Path::Tiny;
my $data = [
- [ '# section comment', qw/Name Foo/, '# data comment', qw/Version 1.2/ ],
+ [
+ '# section comment', qw/Name Foo/,
+ '# data comment', qw/Version 1.2/
+ ],
[
qw/Name Bar Version 1.3/ ,
Files => [qw/file1/, [ 'file2' , '# inline comment'] ] ,
@@ -27,9 +30,5 @@ my $data = [
my $parser = MyParser->new() ;
-
-my $fhw = IO::File->new ;
-$fhw -> open ( 'examples/dpkg-new' ,'>',"," ) ;
-
-$parser->write_dpkg_file($fhw,$data) ;
-$fhw->close;
+# print control file content
+say $parser->write_dpkg_file($data) ;
diff --git a/lib/Config/Model/Backend/Dpkg.pm b/lib/Config/Model/Backend/Dpkg.pm
index 6fd9c37c..e6af49f9 100644
--- a/lib/Config/Model/Backend/Dpkg.pm
+++ b/lib/Config/Model/Backend/Dpkg.pm
@@ -19,21 +19,37 @@ with 'Config::Model::Role::FileHandler';
my $logger = get_logger("Backend::Dpkg::Root");
my $user_logger = get_logger('User');
-my %dispatch = (
+my %hash_dispatch = (
patches => \&read_patch_series,
install => \&read_install_files,
+ examples => \&read_examples_files,
+ 'lintian-overrides' => \&read_lintian_overrides,
);
-
around read_hash => sub ( $orig, $self, $obj, $elt, $file, $check, $args ) {
- $logger->info("called for $elt ".$obj->location." file $file" );
- my $method = $dispatch{$elt} // $orig;
+ $logger->info("around read_hash called for $elt ".$obj->location." file $file" );
+ my $method = $hash_dispatch{$elt} // $orig;
# $file was made from element name. This does not match the actual
# files, so we drop it
$self->$method( $obj, $elt, $check, $args );
};
+sub read_examples_files ( $self, $hash, $elt, $check, $args ) {
+ my $dir = $self->get_tuned_config_dir(%$args);
+
+ return unless $dir->exists;
+
+ $logger->info("Checking $elt directory ($dir) for ".$hash->location );
+ foreach my $file ($dir->children(qr/\.examples$/)) {
+ my $pkg = $file->basename(qr/\.examples$/);
+ $logger->info("examples: found $pkg examples file");
+ # Just create the element. The read backend will kick in by itself
+ $hash->fetch_with_id($pkg);
+ }
+ return;
+}
+
sub read_install_files ( $self, $hash, $elt, $check, $args ) {
my $dir = $self->get_tuned_config_dir(%$args);
@@ -59,6 +75,27 @@ sub read_install_files ( $self, $hash, $elt, $check, $args ) {
$logger->info("install: found $arch install file");
$hash->fetch_with_id("./$arch");
}
+ return;
+}
+
+sub read_lintian_overrides ( $self, $hash, $elt, $check, $args ) {
+ my $dir = $self->get_tuned_config_dir(%$args);
+
+ return unless $dir->exists;
+
+ $logger->info("Checking $elt directory ($dir) for ".$hash->location );
+
+ my $plain_file = $dir->child('lintian-overrides');
+ if ($plain_file->exists) {
+ $hash->fetch_with_id('.')->store($plain_file->slurp_utf8);
+ }
+
+ foreach my $file ($dir->children(qr/\.lintian-overrides$/)) {
+ my $pkg = $file->basename(qr/\.lintian-overrides$/);
+ $logger->info("found $pkg lintian-overrides file");
+ $hash->fetch_with_id($pkg)->store($file->slurp_utf8);
+ }
+ return;
}
sub read_patch_series ( $self, $hash, $elt, $check, $args ) {
@@ -102,12 +139,14 @@ sub read_patch_series ( $self, $hash, $elt, $check, $args ) {
$logger->info("found patch $pname, stored in $location ($obj)");
}
}
+ return;
}
-sub write {
- my $self = shift;
- my %args = @_;
+my %write_hash_dispatch = (
+ 'lintian-overrides' => \&write_lintian_overrides,
+);
+sub write ($self, %args) { ## no critic (ProhibitBuiltinHomonyms)
# args are:
# object => $obj, # Config::Model::Node object
# root => './my_test', # fake root directory, userd for tests
@@ -129,6 +168,10 @@ sub write {
my $file = $dir->child($elt);
my $obj = $args{object}->fetch_element( name => $elt );
+ if (my $method = $write_hash_dispatch{$elt}) {
+ $self->$method($dir,$obj);
+ next;
+ }
my $type = $obj->get_type;
my @v;
my $skip = 0;
@@ -162,6 +205,19 @@ sub write {
return 1;
}
+sub write_lintian_overrides ($self, $dir, $hash) {
+ foreach my $name ($hash->fetch_all_indexes) {
+ my $file = $name eq '.' ? 'lintian-overrides'
+ : $name.'.lintian-overrides';
+
+ if (my $content = $hash->fetch_with_id($name)->fetch) {
+ $logger->debug( "Dpkg writing $name in $dir");
+ $dir->child($file)->spew_utf8($content);
+ }
+ }
+ return;
+}
+
no Mouse;
__PACKAGE__->meta->make_immutable;
diff --git a/lib/Config/Model/Backend/Dpkg/Autopkgtest.pm b/lib/Config/Model/Backend/Dpkg/Autopkgtest.pm
index cf0c55b5..c3495351 100644
--- a/lib/Config/Model/Backend/Dpkg/Autopkgtest.pm
+++ b/lib/Config/Model/Backend/Dpkg/Autopkgtest.pm
@@ -22,10 +22,7 @@ use IO::File;
my $logger = get_logger("Backend::Dpkg::Autopkgtest");
my $user_logger = get_logger('User');
-sub read {
- my $self = shift;
- my %args = @_;
-
+sub read ($self, %args) { ## no critic (ProhibitBuiltinHomonyms)
# args is:
# object => $obj, # Config::Model::Node object
# root => './my_test', # fake root directory, userd for tests
@@ -72,12 +69,10 @@ sub parse_control_file ($self, $control_file, $node, $check) {
}
}
}
+ return;
}
-sub write {
- my $self = shift;
- my %args = @_;
-
+sub write ($self, %args) { ## no critic (ProhibitBuiltinHomonyms)
# args is:
# object => $obj, # Config::Model::Node object
# root => './my_test', # fake root directory, userd for tests
@@ -101,6 +96,8 @@ sub write_control_file ($self, $node, $control_file) {
my $res = $self->write_dpkg_file(\@sections,", " ) ;
$control_file->spew_utf8($res);
+
+ return;
}
1;
diff --git a/lib/Config/Model/Backend/Dpkg/Control.pm b/lib/Config/Model/Backend/Dpkg/Control.pm
index d51dc48c..225385e3 100644
--- a/lib/Config/Model/Backend/Dpkg/Control.pm
+++ b/lib/Config/Model/Backend/Dpkg/Control.pm
@@ -21,10 +21,7 @@ use Config::Model::Dpkg::Dependency;
my $logger = get_logger("Backend::Dpkg::Control") ;
-sub read {
- my $self = shift ;
- my %args = @_ ;
-
+sub read ($self, %args) { ## no critic (ProhibitBuiltinHomonyms)
# args is:
# object => $obj, # Config::Model::Node object
# root => './my_test', # fake root directory, userd for tests
@@ -125,6 +122,7 @@ sub fill_package_cache ($self, $c) {
}
my @pkgs = keys %packages;
Config::Model::Dpkg::Dependency::cache_info_from_madison ($self->node->instance,@pkgs);
+ return;
}
sub read_sections {
@@ -152,6 +150,7 @@ sub read_sections {
my $ref = delete $sections{$lc_key} ;
$self->store_section_element_in_tree ($node,$check, @$ref);
}
+ return;
}
#
@@ -196,13 +195,11 @@ sub store_section_element_in_tree {
my $unexpected_obj = $node->fetch_element($key);
$self->store_section_leaf_element ( $logger, $unexpected_obj, $check, $v_ref);
}
+ return;
}
-sub write {
- my $self = shift ;
- my %args = @_ ;
-
+sub write ($self, %args) { ## no critic (ProhibitBuiltinHomonyms)
# args is:
# object => $obj, # Config::Model::Node object
# root => './my_test', # fake root directory, userd for tests
@@ -242,6 +239,7 @@ sub _re_order ($list, $move_after) {
splice @$list, $ik, 1; # remove $k from list
splice @$list, $iv, 0, $k; # add back $k after $v
}
+ return;
}
my @move_after = (
diff --git a/lib/Config/Model/Backend/Dpkg/Copyright.pm b/lib/Config/Model/Backend/Dpkg/Copyright.pm
index aaa93aad..ed36faf7 100644
--- a/lib/Config/Model/Backend/Dpkg/Copyright.pm
+++ b/lib/Config/Model/Backend/Dpkg/Copyright.pm
@@ -31,10 +31,7 @@ my %store_dispatch = (
uniline => 'store_section_leaf_element',
);
-sub read {
- my $self = shift ;
- my %args = @_ ;
-
+sub read ($self, %args) { ## no critic (ProhibitBuiltinHomonyms)
# args is:
# object => $obj, # Config::Model::Node object
# root => './my_test', # fake root directory, userd for tests
@@ -133,15 +130,15 @@ sub read {
elsif (defined $section{license}) {
# license_paragragh hash is used to contain license data indexed by license names
# license name contains only one line
- my ($v,$l, $a) = $section{license}[0]->@* ;
+ my ($v,$l, $author) = $section{license}[0]->@* ;
# need to extract license name from license text
my ($lic_name) = ($v =~ /^([^\n]+)/) ;
if (not defined $lic_name) {
$lic_name = 'other';
- $a = $section{license}[2] = q!use 'other' to replace undefined license name!;
+ $author = $section{license}[2] = q!use 'other' to replace undefined license name!;
}
if ($logger->is_debug) {
- my $a_str = $a ? "altered: '$a' ":'' ;
+ my $a_str = $author ? "altered: '$author' ":'' ;
$logger->debug("Found license paragraph line $l, $a_str ($lic_name)");
}
$license_paragraph{$lic_name} = $section_ref ;
@@ -268,6 +265,7 @@ sub append_text_no_synopsis ($self, $logger_param, $object, $check, $v_ref) {
}
$self->store_section_leaf_element($logger_param,$object, $check, \@new_ref);
+ return;
}
sub _store_line {
@@ -276,6 +274,7 @@ sub _store_line {
chomp $v ;
$logger->debug("_store_line with check $check ".$object->name." = $v");
$object->store(value => $v, check => $check) ;
+ return;
}
sub _store_file_info ($self,$section, $object, $target_name,$key, $check, $v_ref) {
@@ -285,6 +284,7 @@ sub _store_file_info ($self,$section, $object, $target_name,$key, $check, $v_ref
my $f = $store_dispatch{$dispatcher}
|| die "Error in $section section (line ".$v_ref->[0][1]."): unexpected '$key' field\n";
$self->$f($logger, $target,$check,$v_ref) ;
+ return;
}
sub _store_license_info ($self, $lic_node, $key, $check, $v_ref ) {
@@ -296,11 +296,13 @@ sub _store_license_info ($self, $lic_node, $key, $check, $v_ref ) {
);
}
$self->_store_file_license( $lic_node, $check, $v_ref );
+ return;
}
sub _store_file_license ($self, $lic_object, $check, $v_ref) {
return unless grep { /\S/ } map {$_->[0]} $v_ref->@*; # skip empty-ish value
+
my ( $lic_line_ref, @lic_text_ref ) = $v_ref->@*;
my $lic_line = $lic_line_ref->[0];
$logger->debug("_store_file_license check $check called on ".$lic_object->name);
@@ -316,12 +318,10 @@ sub _store_file_license ($self, $lic_object, $check, $v_ref) {
my $short_name_obj = $lic_object->fetch_element('short_name');
$self->store_section_leaf_element ($logger, $short_name_obj, $check, [ $lic_line_ref ]);
+ return;
}
-sub write {
- my $self = shift;
- my %args = @_;
-
+sub write ($self, %args) { ## no critic (ProhibitBuiltinHomonyms)
# args is:
# object => $obj, # Config::Model::Node object
# root => './my_test', # fake root directory, userd for tests
diff --git a/lib/Config/Model/Backend/Dpkg/DebHelperFile.pm b/lib/Config/Model/Backend/Dpkg/DebHelperFile.pm
index d66783b1..3fe3c8f9 100644
--- a/lib/Config/Model/Backend/Dpkg/DebHelperFile.pm
+++ b/lib/Config/Model/Backend/Dpkg/DebHelperFile.pm
@@ -16,7 +16,6 @@ use Config::Model::Exception;
use Log::Log4perl qw(get_logger);
use IO::File;
use Path::Tiny;
-use 5.14.0;
my $logger = get_logger("Backend.Dpkg.DebHelperFile");
my $user_logger = get_logger('User');
diff --git a/lib/Config/Model/Backend/Dpkg/Meta.pm b/lib/Config/Model/Backend/Dpkg/Meta.pm
index df38aa44..3b46b745 100644
--- a/lib/Config/Model/Backend/Dpkg/Meta.pm
+++ b/lib/Config/Model/Backend/Dpkg/Meta.pm
@@ -54,10 +54,7 @@ sub _get_cfg_dir {
return $file;
}
-sub read {
- my $self = shift;
- my %args = @_;
-
+sub read ($self, %args) { ## no critic (ProhibitBuiltinHomonyms)
# args is:
# object => $obj, # Config::Model::Node object
# root => './my_test', # fake root directory, userd for tests
@@ -98,10 +95,7 @@ sub read {
return 1;
}
-sub write {
- my $self = shift;
- my %args = @_;
-
+sub write ($self, %args) { ## no critic (ProhibitBuiltinHomonyms)
# args is:
# object => $obj, # Config::Model::Node object
# root => './my_test', # fake root directory, userd for tests
diff --git a/lib/Config/Model/Backend/Dpkg/Patch.pm b/lib/Config/Model/Backend/Dpkg/Patch.pm
index 657e5370..33dfca17 100644
--- a/lib/Config/Model/Backend/Dpkg/Patch.pm
+++ b/lib/Config/Model/Backend/Dpkg/Patch.pm
@@ -21,12 +21,10 @@ use Path::Tiny;
my $logger = get_logger("Backend::Dpkg::Patch");
-sub skip_open { 1;}
+sub skip_open { return 1;}
# TODO: use a role provided by Config::Model
-sub cfg_path {
- my $self = shift;
- my %args = @_;
+sub cfg_path ($self, %args) {
my $cfg_dir = $args{config_dir};
my $dir
= $args{root} ? path($args{root})->child($cfg_dir)
@@ -35,10 +33,7 @@ sub cfg_path {
return $dir;
}
-sub read {
- my $self = shift;
- my %args = @_;
-
+sub read ($self, %args) { ## no critic (ProhibitBuiltinHomonyms)
# args is:
# object => $obj, # Config::Model::Node object
# root => './my_test', # fake root directory, userd for tests
@@ -169,10 +164,7 @@ sub read {
return 1;
}
-sub write {
- my $self = shift;
- my %args = @_;
-
+sub write ($self, %args) { ## no critic (ProhibitBuiltinHomonyms)
# args is:
# object => $obj, # Config::Model::Node object
# root => './my_test', # fake root directory, userd for tests
diff --git a/lib/Config/Model/Backend/DpkgStoreRole.pm b/lib/Config/Model/Backend/DpkgStoreRole.pm
index c6f70f27..049b55d1 100644
--- a/lib/Config/Model/Backend/DpkgStoreRole.pm
+++ b/lib/Config/Model/Backend/DpkgStoreRole.pm
@@ -42,6 +42,7 @@ sub store_section_list_element ($self, $logger, $list_obj, $check, $v_ref) {
}
}
$list_obj->annotation(@list_comment) if @list_comment;
+ return;
}
sub store_section_leaf_element ($self, $logger, $elt_obj, $check, $v_ref) {
@@ -75,6 +76,7 @@ sub store_section_leaf_element ($self, $logger, $elt_obj, $check, $v_ref) {
$elt_obj->store( value => $v, check => $check );
$elt_obj->annotation(@comment) if @comment ;
$elt_obj->notify_change(note => $note, really => 1) if $note ;
+ return;
}
1;
diff --git a/lib/Config/Model/Backend/DpkgSyntax.pm b/lib/Config/Model/Backend/DpkgSyntax.pm
index eef10d8c..5ec1bf83 100644
--- a/lib/Config/Model/Backend/DpkgSyntax.pm
+++ b/lib/Config/Model/Backend/DpkgSyntax.pm
@@ -171,6 +171,7 @@ sub _store_line_and_comments ($store_ref,$file_path,$line,$check,$line_nb, $hand
$logger->error($msg) if $check eq 'skip';
}
$comments->@* = (); # reset comments, they are now stored
+ return;
}
# input is [ section [ keyword => value | value_list_ref ] ]
@@ -334,7 +335,7 @@ With a dpkg file containing:
Name: Foo
Version: 1.2
-
+
# section comment
Name: Bar
# data comment
@@ -349,9 +350,13 @@ With a dpkg file containing:
Parse the file with:
package MyParser ;
+
use strict;
use warnings;
+ use 5.20.1;
+
+ # DpkgSyntax uses Log4perl, so we must initialise this module
use Log::Log4perl qw(:easy);
Log::Log4perl->easy_init($WARN);
@@ -360,18 +365,18 @@ Parse the file with:
with 'Config::Model::Backend::DpkgSyntax';
package main ;
- use IO::File;
- use Data::Dumper;
+ use Path::Tiny;
+ use YAML::XS;
- my $file = 'examples/dpkg-test'; # replace with any file name
- my $fh = IO::File->new();
- $fh->open("< $file");
+ # load control file
+ my $file = path('dpkg-test');
+ # create your parser
my $parser = MyParser->new() ;
- my $data = $parser->parse_dpkg_file($file, $fh, 'yes', 1);
- $fh->close;
-
- print Dumper $data;
+
+ # convert control file data in a Perl data structure
+ # documented in Synopsis
+ my $data = $parser->parse_dpkg_file($file, 'yes', 1);
Data contains:
@@ -410,46 +415,44 @@ Data contains:
To write Dpkg file back:
package MyParser ;
-
+
use strict;
use warnings;
-
+
use 5.20.1;
-
+
+ # DpkgSyntax uses Log4perl, so we must initialise this module
use Log::Log4perl qw(:easy);
Log::Log4perl->easy_init($WARN);
-
+
# load role
use Mouse ;
with 'Config::Model::Backend::DpkgSyntax';
-
+
package main ;
- use IO::File;
- use Data::Dumper;
-
- # note: the structure is different compared to the one returned by
- # the parser (no line number)
+ use Path::Tiny;
+
my $data = [
- [ '# section comment', qw/Name Foo/, '# data comment', qw/Version 1.2/ ],
- [
- qw/Name Bar Version 1.3/ ,
- Files => [qw/file1/, [ 'file2' , '# inline comment'] ] ,
- Description => "A very\n\nlong description"
- ]
+ [
+ '# section comment', qw/Name Foo/,
+ '# data comment', qw/Version 1.2/
+ ],
+ [
+ qw/Name Bar Version 1.3/ ,
+ Files => [qw/file1/, [ 'file2' , '# inline comment'] ] ,
+ Description => "A very\n\nlong description"
+ ]
];
-
+
my $parser = MyParser->new() ;
-
- my $fhw = IO::File->new ;
- $fhw -> open ( 'examples/dpkg-new' ,'>',"," ) ;
-
- $parser->write_dpkg_file($fhw,$data) ;
- $fhw->close;
+
+ # print control file content
+ say $parser->write_dpkg_file($data) ;
=head1 DESCRIPTION
-This module is a Moose role to read and write dpkg control files.
+This module is a Moose role to read and write dpkg control files.
Debian control file are read and transformed in a structure
matching the control file. The top level list of a list of section.
@@ -462,9 +465,9 @@ syntax idiosyncrasies. The leading white space is removed and the
single dot is transformed in to a "\n". These characters are restored
when the file is written back.
-Last not but not least, this module could re-used outside of
+Last not but not least, this module can be re-used outside of
C<Config::Model> with some small modifications in exception
-handing. Ask the author if you want this module shipped in its own
+handling. Ask the author if you want this module shipped in its own
distribution.
=head1
@@ -476,7 +479,7 @@ Parameters: C<( file_path, file_handle, [ check, [ comment_allowed ]] )>
Read a control file from C<file_handle> and returns a nested list (or
a list ref) containing data from the file.
-See sysnopsis for the returned structure.
+See synopsis for the returned structure.
C<check> is C<yes>, C<skip> or C<no> (default C<yes>).
C<comment_allowed> is boolean (default 0)
diff --git a/lib/Config/Model/Dpkg.pm b/lib/Config/Model/Dpkg.pm
index 08ef06a1..a45dc18d 100644
--- a/lib/Config/Model/Dpkg.pm
+++ b/lib/Config/Model/Dpkg.pm
@@ -1,6 +1,7 @@
package Config::Model::Dpkg;
-our $VERSION='2.057';
+use strict;
+use warnings;
1;
@@ -212,8 +213,9 @@ See L<Config::Model::Loader/"load string syntax">
=head1 BUGS
-Config::Model design does not really cope well with a some detail of
+Config::Model design does not really cope well with some details of
L<Debian patch header specification|http://dep.debian.net/deps/dep3/> (aka DEP-3).
+
Description and subject are both authorized, but only B<one> of them is
required and using the 2 is forbidden. So, both fields are accepted,
but subject is stored as description in the configuration tree.
@@ -233,6 +235,7 @@ In alphabetical order:
Paul Wise
Ross Vandegrift
Salvatore Bonaccorso
+ Walter Lozano
Xavier Guimard
Thanks all.
diff --git a/lib/Config/Model/Dpkg/Copyright.pm b/lib/Config/Model/Dpkg/Copyright.pm
index d22bd26e..a831fe29 100644
--- a/lib/Config/Model/Dpkg/Copyright.pm
+++ b/lib/Config/Model/Dpkg/Copyright.pm
@@ -3,7 +3,7 @@ package Config::Model::Dpkg::Copyright ;
use strict;
use warnings;
-use 5.20.0;
+use 5.020;
use IO::Pipe;
use feature qw/postderef signatures/;
@@ -26,8 +26,9 @@ sub get_joined_path ($self, $paths) {
}
sub split_path ($self,$path) {
- return sort ( ref $path ? @$path : split ( /[\s\n]+/ , $path ) );
+ return ( sort ( ref $path ? @$path : split ( /[\s\n]+/ , $path ) ) );
}
+
sub normalize_path ($self,$path) {
my @paths = $self->split_path($path);
return $self->get_joined_path(\@paths);
@@ -37,6 +38,7 @@ my $dumper = Config::Model::DumpAsData->new;
sub _say ($self,$msg) {
say $msg unless $self->{quiet};
+ return;
}
sub _get_old_data ($old_split_files, $old_split_dirs, $path) {
@@ -115,7 +117,7 @@ sub update ($self, %args) {
# skip when no info is found in original data
my $d_key;
- if ( $new_data->{Copyright} =~ /no-info-found|unknown/i
+ if ( $new_data->{Copyright} =~ /no-info-found|unknown/xi
and $new_data->{License}{short_name} =~ /unknown/i) {
$new_copyrights_by_id[0] //= $new_data;
$d_key = 0;
@@ -124,8 +126,8 @@ sub update ($self, %args) {
# create an inventory of different file copyright and license data
# this works like $copyrights_by_id but takes into account data coming
# from old copyright file like comments
- my $dumper = Data::Dumper->new([$new_data])->Sortkeys(1)->Indent(0);
- my $datum_dump = $dumper->Dump;
+ my $data_dumper = Data::Dumper->new([$new_data])->Sortkeys(1)->Indent(0);
+ my $datum_dump = $data_dumper->Dump;
$d_key = $data_keys{$datum_dump};
if (not defined $d_key) {
@@ -204,12 +206,12 @@ sub update ($self, %args) {
my $using_old_data = 0;
if ($old_data and $old_data->{Copyright} and $old_data->{License}{short_name}) {
- if ($datum->{Copyright} =~ /unknown|no-info-found/i) {
+ if ($datum->{Copyright} =~ /unknown|no-info-found/xi) {
$self->_say( "keeping copyright dir data for $p");
$datum->{Copyright} = $old_data->{Copyright};
$using_old_data = 1;
}
- if ($datum->{License}{short_name} =~ /unknown|no-info-found/i) {
+ if ($datum->{License}{short_name} =~ /unknown|no-info-found/xi) {
$self->_say( "keeping license dir data for $p");
$datum->{License}{short_name} = $old_data->{License}{short_name};
$datum->{License}{full_license} = $old_data->{License}{full_license};
@@ -240,7 +242,7 @@ sub update ($self, %args) {
# if full_license is not provided in datum, check global license(s)
if (not $datum->{License}{full_license}) {
my $ok = 0;
- my @sub_licenses = split m![,\s]+(?:and/or|or|and)[,\s]+!,$l;
+ my @sub_licenses = split m![,\s]+ (?:and/or|or|and) [,\s]+!x,$l;
my $lic_count = 0;
my @empty_licenses = grep {
my $text = $self->grab_value(steps => qq!License:"$_" text!, check =>'no') ;
@@ -253,7 +255,9 @@ sub update ($self, %args) {
my $filler = "Please fill license $l from header of @paths";
if ($lic_count > 1 ) {
$self->_say( "Adding dummy global license text for license $l for path @paths");
- map { $self->load(qq!License:"$_" text="$filler"!) } @empty_licenses ;
+ for my $lic (@empty_licenses) {
+ $self->load(qq!License:"$lic" text="$filler"!)
+ };
}
else {
@@ -265,16 +269,18 @@ sub update ($self, %args) {
}
eval {
- $files_obj->fetch_with_id($path_str)->load_data( data => $datum, check =>'yes' );
- };
- if ($@) {
+ $files_obj
+ ->fetch_with_id($path_str)
+ ->load_data( data => $datum, check =>'yes' );
+ 1;
+ } or do {
die "Error: Data extracted from source file is corrupted:\n$@"
."This usually mean that cme or licensecheck (or both) "
."have a bug. You may work-around this issue by adding an override entry in "
."fill.copyright.blanks file. See "
."https://github.com/dod38fr/config-model/wiki/Updating-debian-copyright-file-with-cme "
."for instructions. Last but not least, please file a bug against libconfig-model-dpkg-perl.\n";
- }
+ };
}
# delete global license without text
@@ -326,13 +332,15 @@ sub _apply_fix_scan_copyright_file ($self, $current_dir) {
# read a debian/fix.scanned.copyright file to patch scanned data
my $debian = $current_dir->child('debian'); # may be missing in test environment
if ($debian->is_dir) {
- my @fixes = $current_dir->child('debian')->children(qr/fix\.scanned\.copyright$/);
+ my @fixes = $current_dir->child('debian')->children(qr/fix\.scanned\.copyright$/x);
$self->_say( "Note: loading @fixes fixes from copyright fix files") if @fixes;
foreach my $fix ( @fixes) {
- my @l = grep { /[^\s]/ } grep { ! m!^(#|//)! } $fix->lines_utf8;
- eval { $self->load( steps => join(' ',@l) , caller_is_root => 1 ); };
- my $e = $@;
- if ($e) {
+ my @l = grep { /[^\s]/ } grep { ! m!^(?:#|//)! } $fix->lines_utf8;
+ eval {
+ $self->load( steps => join(' ',@l) , caller_is_root => 1 );
+ 1;
+ } or do {
+ my $e = $@;
my $msg = $e->full_message;
Config::Model::Exception::User->throw(
object => $self,
@@ -341,6 +349,7 @@ sub _apply_fix_scan_copyright_file ($self, $current_dir) {
}
}
}
+ return;
}
sub _prune_old_dirs ($self, $h, $old_dirs, $path = [] ) {
@@ -359,6 +368,7 @@ sub _prune_old_dirs ($self, $h, $old_dirs, $path = [] ) {
$self->_say( "Removing old entry $dir_path" );
delete $old_dirs->{$dir_path};
}
+ return;
}
1;
diff --git a/lib/Config/Model/Dpkg/Copyright/License.pm b/lib/Config/Model/Dpkg/Copyright/License.pm
index c9dfbd36..a9133c41 100644
--- a/lib/Config/Model/Dpkg/Copyright/License.pm
+++ b/lib/Config/Model/Dpkg/Copyright/License.pm
@@ -19,13 +19,14 @@ sub BUILD ($self, @args) {
$self->SUPER::BUILD(@args);
weaken($self);
- $self-> add_check_content( sub { $self->check_unused_licenses(@_);} )
+ $self-> add_check_content( sub { $self->check_unused_licenses(@_);} );
+ return;
}
-sub check_idx {
+sub check_idx { ## no critic (RequireArgUnpacking)
my $self = shift;
-
my %args = @_ > 1 ? @_ : ( index => $_[0] );
+
my $idx = $args{index};
my $silent = $args{silent} || 0;
my $check = $args{check} || 'yes';
@@ -88,6 +89,7 @@ sub check_unused_licenses ($self,$error, $warn, $fix = 0, $silent = 0) {
my $msg = "Unused license: @unused";
push $warn->@*, $msg;
+ return;
}
sub prune_unused_licenses ($self, $silent = 0) {
@@ -100,5 +102,6 @@ sub prune_unused_licenses ($self, $silent = 0) {
foreach my $lic (@unused) {
$self->delete("$lic");
}
+ return;
}
1;
diff --git a/lib/Config/Model/Dpkg/Dependency.pm b/lib/Config/Model/Dpkg/Dependency.pm
index b04f023d..bbffa284 100644
--- a/lib/Config/Model/Dpkg/Dependency.pm
+++ b/lib/Config/Model/Dpkg/Dependency.pm
@@ -339,7 +339,7 @@ sub dep_parser {
# check_dep -> meta filter -> control maintainer -> create control class
# autoread started -> read all fileds -> read dependency -> check_dep ...
-sub check_value {
+sub check_value { ## no critic (RequireArgUnpacking)
my $self = shift ;
my %args = @_ > 1 ? @_ : (value => $_[0]) ;
@@ -349,10 +349,7 @@ sub check_value {
return $self->check_dependency(%args, value => $value, ok => $ok) ;
}
-sub check_dependency {
- my $self = shift;
- my %args = @_ ;
-
+sub check_dependency ($self, %args){
my ($value, $check, $silent, $notify_change, $ok, $apply_fix)
= @args{qw/value check silent notify_change ok fix/} ;
@@ -397,13 +394,13 @@ sub check_dependency {
my $new = $self->struct_to_dep(@dep_chain);
if ( $logger->is_debug ) {
- my $new //= '<undef>';
- no warnings 'uninitialized';
- $logger->debug( "'$old' done" . ( $apply_fix ? " changed to '$new'" : '' ) );
+ my $new_str = $new // '<undef>';
+ no warnings 'uninitialized'; ## no critic (ProhibitNoWarnings)
+ $logger->debug( "'$old' done" . ( $apply_fix ? " changed to '$new_str'" : '' ) );
}
{
- no warnings 'uninitialized';
+ no warnings 'uninitialized'; ## no critic (ProhibitNoWarnings)
my $msg = join('; ', @msgs);
$self->_store_fix( $old, $new, $msg ) if $apply_fix and @msgs and $new ne $old;
}
@@ -436,6 +433,7 @@ sub check_debhelper_compat_version {
$logger->info("will warn: $msg (fix++)");
}
}
+ return;
}
sub check_debhelper_version {
@@ -470,6 +468,7 @@ sub check_debhelper_version {
$logger->info("will warn: $msg (fix++)");
}
}
+ return;
}
sub check_compat_object ($self) {
@@ -501,6 +500,7 @@ sub check_compat_object_value ($self, $apply_fix, $msgs) {
$logger->info("will warn: $msg (fix++)");
}
}
+ return;
}
sub check_compat_value ($self, $compat_value, $apply_fix, $msgs) {
@@ -523,10 +523,7 @@ sub check_compat_value ($self, $compat_value, $apply_fix, $msgs) {
return $compat_value;
}
-sub struct_to_dep {
- my $self = shift ;
- my @input = @_ ;
-
+sub struct_to_dep ($self, @input) {
my @alternatives ;
foreach my $d (@input) {
my $line = '';
@@ -720,6 +717,7 @@ sub check_or_fix_essential_package {
$logger->info("will warn: $msg (fix++)");
}
}
+ return;
}
@@ -763,6 +761,7 @@ sub check_or_fix_pkg_name {
"package $pkg is unknown. Check for typos if not a virtual package.");
}
}
+ return;
}
sub check_or_fix_dep {
@@ -807,6 +806,7 @@ sub check_or_fix_dep {
$fix_sub = sub { delete $_[0]->{dep} };
}
$self->warn_or_fix_dep_info ($fix_sub, $apply_fix, $dep_info, $msgs, $warn_str, $log_str) ;
+ return;
}
@@ -823,6 +823,7 @@ sub warn_or_fix_dep_info {
$self->add_warning( $warn_msg );
$logger->info("will warn: $warn_msg (fix++)");
}
+ return;
}
use vars qw/%cache $use_test_cache/ ;
@@ -946,6 +947,7 @@ sub cache_info_from_madison {
else {
warn "cannot get data from madison. Check your proxy ?\n";
}
+ return;
}
# See https://ftp-master.debian.org/epydoc/dakweb.queries.madison-module.html
diff --git a/lib/Config/Model/Dpkg/Lintian/Overrides.pm b/lib/Config/Model/Dpkg/Lintian/Overrides.pm
new file mode 100644
index 00000000..ad9cfa62
--- /dev/null
+++ b/lib/Config/Model/Dpkg/Lintian/Overrides.pm
@@ -0,0 +1,147 @@
+package Config::Model::Dpkg::Lintian::Overrides;
+
+use strict;
+use warnings;
+use Mouse;
+use Path::Tiny;
+use Log::Log4perl qw(get_logger :levels);
+use 5.20.1;
+
+extends qw/Config::Model::Value/ ;
+
+use feature qw/postderef signatures/;
+no warnings qw/experimental::postderef experimental::signatures/;
+
+my $logger = get_logger("Backend::Dpkg::Lintian");
+my $user_logger = get_logger('User');
+
+# read all tag files and construct a list of valid tags
+# and a list of replacements tag
+
+my %tags;
+my %renames;
+
+my $tag_dir = path('/usr/share/lintian/tags');
+
+if ($tag_dir->is_dir) {
+ $tag_dir->visit(
+ sub {
+ my ($path, $state) = @_;
+ return unless $path->basename('.tag');
+ my $tag;
+ foreach my $line ($path->lines) {
+ if ($line =~ /^Tag:\s+([\w-]+)/) {
+ $tag = $1;
+ $tags{$1}=1;
+ }
+ if ($line =~ /^Renamed-From:\s+([\w-]+)/) {
+ warn "Got Renamed-From without tag in file $path" unless defined $tag;
+ $renames{$1}=$tag;
+ }
+ last if $line =~ /^Explanation:/;
+ }
+ },
+ { recurse => 1 }
+ )
+}
+
+sub _exists ($tag) {
+ return $tags{$tag};
+}
+
+sub _new_name ($tag) {
+ return $renames{$tag};
+}
+
+around _check_value => sub ( $orig, $self, %args ) {
+ my $quiet = $args{quiet} || 0;
+ my $check = $args{check} || 'yes';
+ my $apply_fix = $args{fix} || 0;
+ my $mode = $args{mode} || 'backend';
+
+ $logger->info("around _check_value called for ".$self->location, "apply_fix: ", $apply_fix );
+
+ my ($ok, $value, $error, $warn) = $self->$orig( %args );
+
+ return ($ok, $value, $error, $warn) unless $value;
+
+ my @lines = split /\n/, $value;
+ foreach my $line (@lines) {
+ next if $line =~ /^#/;
+ next unless $line =~ /:/;
+
+ # [<package>][ <archlist>][ <type>]: ]<lintian-tag>[ [*]<lintian-context>[*]]
+ my ($pkg_arch_type, $tag_context) = split /\s*:\s*/, $line, 2;
+ my ($tag, $context) = split /\s+/, $tag_context, 2;
+
+ if ($tag) {
+ next if _exists($tag);
+ if (my $new = _new_name($tag)) {
+ $logger->info("Found old tag $tag, new is $new.");
+ push @$warn, "Obsolete $tag tag. New tag is $new";
+ if ($apply_fix) {
+ $line =~ s/(:\s*)($tag)/$1$new/;
+ $self->notify_change(
+ old => $tag,
+ new => $new,
+ note => 'update obsolete lintian tag'
+ );
+ } else {
+ $self->{nb_of_fixes}++;
+ }
+ }
+ else {
+ $logger->info("Found unknown tag $tag.");
+ push @$warn, "Unknown $tag tag.";
+ }
+ }
+ }
+
+ my $new_overrides = $self->{data} = join("\n",@lines)."\n";
+ return ($ok, $new_overrides, $error, $warn);
+};
+
+1;
+
+__END__
+
+=head1 NAME
+
+Config::Model::Dpkg::Lintian::Overrides - Checks lintian-overrides file
+
+=head1 SYNOPSIS
+
+No synopsis. This class is to be used by Dpkg model.
+
+=head1 DESCRIPTION
+
+This class is derived from L<Config::Model::Value>. Its purpose is to
+check the content of C<debian/*lintian-overrides> and
+C<debian/source/lintian-overrides> files.
+
+Only the validity of the tags are checked. They are compared to the list of tags
+shipped in lintian package.
+
+Unknown or obsolete tags trigger a warning.
+
+Obsolete tags can be replaced with their new name with C<cme fix dpkg>.
+
+=head1 Limitations
+
+=over
+
+=item *
+
+Syntax of lintian-overrides is not checked.
+
+=back
+
+=head1 AUTHOR
+
+Dominique Dumont, ddumont [AT] cpan [DOT] org
+
+=head1 SEE ALSO
+
+L<Config::Model>,
+L<Config::Model::Value>,
+L<lintian>
diff --git a/lib/Config/Model/models/Dpkg.d/source-name/Dpkg/Copyright.pl b/lib/Config/Model/models/Dpkg.d/source-name/Dpkg/Copyright.pl
index 4a5d30e2..e9f73d0a 100644
--- a/lib/Config/Model/models/Dpkg.d/source-name/Dpkg/Copyright.pl
+++ b/lib/Config/Model/models/Dpkg.d/source-name/Dpkg/Copyright.pl
@@ -1,4 +1,7 @@
-[
+use strict;
+use warnings;
+
+return [
{
'element' => [
'Upstream-Name',
diff --git a/lib/Config/Model/models/Dpkg.pl b/lib/Config/Model/models/Dpkg.pl
index b31334e4..6d6e2d41 100644
--- a/lib/Config/Model/models/Dpkg.pl
+++ b/lib/Config/Model/models/Dpkg.pl
@@ -146,6 +146,20 @@ Here the mapping between the install files and the install key:
'index_type' => 'string',
'type' => 'hash'
},
+ 'examples',
+ {
+ 'cargo' => {
+ 'config_class_name' => 'Dpkg::Install',
+ 'type' => 'node'
+ },
+ 'description' => 'List of the examples files to install into
+C</usr/share/doc/package/examples>
+
+Use the package name as the key of the hash
+',
+ 'index_type' => 'string',
+ 'type' => 'hash'
+ },
'not-installed',
{
'cargo' => {
@@ -169,6 +183,28 @@ Please keep in mind that dh_install will not expand wildcards in this file.
'config_class_name' => 'Dpkg::Source',
'type' => 'node'
},
+ 'lintian-overrides',
+ {
+ 'cargo' => {
+ 'class' => 'Config::Model::Dpkg::Lintian::Overrides',
+ 'type' => 'leaf',
+ 'value_type' => 'string'
+ },
+ 'description' => 'Contains the lintian overrides parameters from all lintian overrides files contained in C<debian/*lintian-overrides>.
+
+plain C<lintian-overrides> is contained in "." element.
+
+Other files are contained in basename element.
+
+For instance, C<debian/foo.lintian-overrides> is contained in C<foo> element.
+
+Unknown L<lintian tags| https://lintian.debian.org/tags.html> trigger a warning.
+
+
+',
+ 'index_type' => 'string',
+ 'type' => 'hash'
+ },
'clean',
{
'cargo' => {
diff --git a/lib/Config/Model/models/Dpkg/Install.pl b/lib/Config/Model/models/Dpkg/Install.pl
index 3e219788..417eedd9 100644
--- a/lib/Config/Model/models/Dpkg/Install.pl
+++ b/lib/Config/Model/models/Dpkg/Install.pl
@@ -40,7 +40,7 @@ See L<debhelper(7)> and L<dh_install> for more details.
'auto_delete' => '1',
'backend' => 'Dpkg::DebHelperFile',
'config_dir' => 'debian',
- 'file' => 'install'
+ 'file' => '&element(-)'
}
}
]
diff --git a/lib/Config/Model/models/Dpkg/Source.pl b/lib/Config/Model/models/Dpkg/Source.pl
index f017310e..455c1bfa 100644
--- a/lib/Config/Model/models/Dpkg/Source.pl
+++ b/lib/Config/Model/models/Dpkg/Source.pl
@@ -46,6 +46,24 @@ There may also be a .git shallow file listing revisions for a shallow git clone.
'config_class_name' => 'Dpkg::Source::Options',
'description' => 'Source options as described in L<dpkg-source>',
'type' => 'node'
+ },
+ 'lintian-overrides',
+ {
+ 'class' => 'Config::Model::Dpkg::Lintian::Overrides',
+ 'description' => 'Contains the lintian overrides parameters from all lintian overrides files contained in C<debian/*lintian-overrides>.
+
+plain C<lintian-overrides> is contained in "." element.
+
+Other files are contained in basename element.
+
+For instance, C<debian/foo.lintian-overrides> is contained in C<foo> element.
+
+Unknown L<lintian tags| https://lintian.debian.org/tags.html> trigger a warning.
+
+
+',
+ 'type' => 'leaf',
+ 'value_type' => 'string'
}
],
'license' => 'LGPL2',
diff --git a/lib/Config/Model/models/Dpkg/Tests/Control.pl b/lib/Config/Model/models/Dpkg/Tests/Control.pl
index ebfdeed7..53bee550 100644
--- a/lib/Config/Model/models/Dpkg/Tests/Control.pl
+++ b/lib/Config/Model/models/Dpkg/Tests/Control.pl
@@ -64,8 +64,8 @@ The packages listed as Depends for this test are usually indirect dependencies,
There is currently no way to specify this hint on a per-test basis; but in any case the debian.org machinery is not able to think about triggering individual tests.',
'isolation-container' => 'The test wants to start services or open network TCP ports. This commonly fails in a simple chroot/schroot, so tests need to be run in their own container (e. g. autopkgtest-virt-lxc) or their own machine/VM (e. g. autopkgtest-virt-qemu or autopkgtest-virt-null). When running the test in a virtualization server which does not provide this (like autopkgtest-schroot) it will be skipped.',
'isolation-machine' => 'The test wants to interact with the kernel, reboot the machine, or other things which fail in a simple schroot and even a container. Those tests need to be run in their own machine/VM (e. g. autopkgtest-virt-qemu or autopkgtest-virt-null). When running the test in a virtualization server which does not provide this it will be skipped.',
- 'needs-reboot' => 'The test wants to reboot the machine using /tmp/autopkgtest-reboot. See L<https://salsa.debian.org/ci-team/autopkgtest/raw/master/doc/README.package-tests.rst>',
'needs-internet' => 'The test needs unrestricted internet access. See L<https://salsa.debian.org/ci-team/autopkgtest/raw/master/doc/README.package-tests.rst>',
+ 'needs-reboot' => 'The test wants to reboot the machine using /tmp/autopkgtest-reboot. See L<https://salsa.debian.org/ci-team/autopkgtest/raw/master/doc/README.package-tests.rst>',
'needs-recommends' => 'Enable installation of recommended packages in apt for the test dependencies. This does not affect build dependencies.',
'needs-root' => 'The test script must be run as root.',
'rw-build-tree' => 'The test(s) needs write access to the built source tree (so it may need to be copied first). Even with this restriction, the test is not allowed to make any change to the built source tree which (i) isn\'t cleaned up by debian/rules clean, (ii) affects the future results of any test, or (iii) affects binary packages produced by the build tree in the future.',
diff --git a/lib/Dpkg/Copyright/Scanner.pm b/lib/Dpkg/Copyright/Scanner.pm
index 100c0061..2d08d745 100644
--- a/lib/Dpkg/Copyright/Scanner.pm
+++ b/lib/Dpkg/Copyright/Scanner.pm
@@ -20,7 +20,11 @@ no warnings qw/experimental::postderef experimental::signatures/;
binmode STDOUT, ':encoding(utf8)';
-our @EXPORT = qw(scan_files print_copyright __from_copyright_structure __to_copyright_structure);
+our @EXPORT_OK = qw(scan_files print_copyright
+ __create_tree_leaf_from_paths
+ __from_copyright_structure __pack_files
+ __pack_copyright __squash_tree_of_copyright_ids
+ __to_copyright_structure);
my $whitespace_list_delimiter = $ENV{'whitespace_list_delimiter'} || "\n ";
@@ -56,7 +60,9 @@ sub print_copyright ( %args ) {
}
# regroup %files hash: all leaves have same id -> wild card
- __squash_tree_of_copyright_ids($split_files, $copyrights_by_id);
+ if ($args{long} != 1) {
+ __squash_tree_of_copyright_ids($split_files, $copyrights_by_id);
+ }
# pack files by copyright id
my @packed = __pack_files($split_files);
@@ -83,15 +89,17 @@ sub print_copyright ( %args ) {
$args{out}->spew_utf8( @out);
}
else {
- binmode(STDOUT, ":utf8");
+ binmode(STDOUT, ":encoding(UTF-8)");
print @out;
}
+ return;
}
my $quiet;
sub _warn ($msg) {
warn $msg unless $quiet;
+ return;
}
my %default ;
@@ -163,7 +171,7 @@ $default{check} = << 'EOR2' ;
EOR2
# cleanup the regexp
-map { s/#.*\n//g; s/[\s\n]+//g; } values %default;
+for (values %default) { s/#.*\n//g; s/[\s\n]+//g; };
sub _get_data_from_files ( %args ) {
my $current_dir = $args{from_dir} || path('.');
@@ -291,11 +299,39 @@ my $__extract_rust_info = sub ($file, $c, $l, $current_dir) {
return ($c, $l);
};
+my $__extract_nodejs_info = sub ($c_key, $l_key, $file, $c, $l, $current_dir) {
+ my $json_file = $current_dir->child($file);
+
+ if ($json_file->is_file) {
+ my $data = from_json($json_file->slurp_utf8);
+
+ my @c_data;
+ if (ref $data->{$c_key}) {
+ if (ref $data->{$c_key} eq 'HASH') {
+ if (exists($data->{$c_key}->{name})) {
+ @c_data = ($data->{$c_key}->{name});
+ }
+ }
+ else {
+ @c_data = ($data->{$c_key}->@*);
+ }
+ } else {
+ @c_data = ($data->{$c_key});
+ }
+
+ my @l_data
+ = ref $data->{$l_key} eq 'ARRAY' ? $data->{$l_key}->@*
+ : $data->{$l_key};
+ return (join("\n ", @c_data) || $c, join(" or ",@l_data) || $l);
+ }
+ return ($c, $l);
+};
+
my $__extract_json_info = sub ($c_key, $l_key, $file, $c, $l, $current_dir) {
my $json_file = $current_dir->child($file);
if ($json_file->is_file) {
- my $data = decode_json($json_file->slurp_utf8);
+ my $data = from_json($json_file->slurp_utf8);
my @c_data = ref $data->{$c_key} ? $data->{$c_key}->@* : $data->{$c_key};
my @l_data = ref $data->{$l_key} ? $data->{$l_key}->@* : $data->{$l_key};
return (join("\n ", @c_data) || $c, join(" or ",@l_data) || $l);
@@ -305,7 +341,7 @@ my $__extract_json_info = sub ($c_key, $l_key, $file, $c, $l, $current_dir) {
my %override = (
'Cargo.toml' => $__extract_rust_info,
- 'package.json' => sub {$__extract_json_info->('author','license',@_)},
+ 'package.json' => sub {$__extract_nodejs_info->('author','license',@_)},
'META.json' => sub {$__extract_json_info->('author','license',@_)},
'META6.json' => sub {$__extract_json_info->('authors','license',@_)},
);
@@ -403,7 +439,7 @@ sub _warn_user_about_problems ($files, $fill_blank_data, @no_info_list) {
_warn $msg;
}
- my @notused = grep { ! $fill_blank_data->{$_}{used} and $_; } sort keys %$fill_blank_data ;
+ my @notused = grep { not $fill_blank_data->{$_}{used} and $_; } sort keys %$fill_blank_data ;
if (@notused) {
_warn "Warning: the following entries from fill.copyright.blanks.yml were not used\n- '"
.join("'\n- '",@notused)."'\n";
@@ -411,8 +447,9 @@ sub _warn_user_about_problems ($files, $fill_blank_data, @no_info_list) {
warn "No copyright information found" unless keys %$files;
-
+ return;
}
+
sub __to_copyright_structure ($c, $l) {
return {
Copyright => $c,
@@ -440,6 +477,7 @@ sub __create_tree_leaf_from_paths ($h,$path,$value) {
my $last = pop @subpaths;
map { $h = $h->{$_} ||= {} } @subpaths ;
$h->{$last} = $value;
+ return;
}
sub __clean_copyright ($c) {
@@ -532,6 +570,7 @@ sub __pack_dir ($h, $pack, @path) {
}
push $pack->@*, map { [ $_, $pack_by_id{$_}->@* ]; } keys %pack_by_id ;
+ return;
}
# find ids that can be merged together
@@ -594,6 +633,7 @@ sub __swap_merged_ids ($files, $merged_c_info) {
$files->{$name} = "$new_id" ;
}
}
+ return;
}
sub __coalesce_copyright_years($entries, $owners) {
@@ -732,6 +772,7 @@ sub __prune_files_represented_by_main_license ($main_license_id, $tree_of_ids) {
# here's the '*' file representing the most used (c) info
$tree_of_ids->{'*'} //= $main_license_id;
}
+ return;
}
# $tree_of_ids is a tree of hash matching the directory structure. Each leaf is a
@@ -1009,6 +1050,10 @@ Parameters in C<%args>:
set to 1 to suppress progress messages. Should be used only in tests.
+=item long
+
+set to 1 to avoid squashing copyright ids. Useful to avoid output with wild cards.
+
=back
diff --git a/t/license-short-name.t b/t/license-short-name.t
index 99e0907c..7266c944 100644
--- a/t/license-short-name.t
+++ b/t/license-short-name.t
@@ -7,8 +7,6 @@ use Config::Model::Tester::Setup qw/init_test setup_test_dir/;
use Path::Tiny;
use 5.10.0;
-use warnings;
-use strict;
use Test::More;
use Test::Exception;
use Software::LicenseMoreUtils;
diff --git a/t/lintian.t b/t/lintian.t
new file mode 100644
index 00000000..5317f438
--- /dev/null
+++ b/t/lintian.t
@@ -0,0 +1,68 @@
+use strict;
+use warnings;
+
+use Config::Model;
+
+use Config::Model::Tester::Setup qw/init_test setup_test_dir/;
+use Path::Tiny;
+use 5.10.0;
+
+use Test::More;
+use Test::Exception;
+# use Test::LongString;
+use Test::Log::Log4perl;
+
+$::_use_log4perl_to_warn = 1;
+
+use lib "../lib";
+
+use Config::Model::Dpkg::Lintian::Overrides;
+
+subtest "load of tag data from lintian files" => sub {
+ ok(Config::Model::Dpkg::Lintian::Overrides::_exists('binary-in-etc'),
+ "check known tag");
+
+ ok(! Config::Model::Dpkg::Lintian::Overrides::_exists('shlib-calls-exit'),
+ "check unknown tag");
+
+ is(Config::Model::Dpkg::Lintian::Overrides::_new_name('shlib-calls-exit'),
+ 'exit-in-shared-library', "check renamed tag");
+};
+
+my $model = Config::Model->new ;
+$model ->create_config_class (
+ name => "TestClass",
+ element => [
+ 'lintian-overrides' => {
+ 'type' => 'leaf',
+ 'value_type' => 'string',
+ class => 'Config::Model::Dpkg::Lintian::Overrides',
+ },
+ ],
+) ;
+
+my $inst = $model->instance(root_class_name => 'TestClass' );
+
+my $root = $inst->config_root ;
+
+subtest "load tag with obsolete value" => sub {
+ my $xp = Test::Log::Log4perl->expect(
+ ignore_priority => "info",
+ ['User', warn => qr/Obsolete shlib-calls-exit tag/]
+ );
+ $root->load(q!lintian-overrides="libburn4 binary: shlib-calls-exit\n"!);
+};
+
+$inst->initial_load_stop;
+
+subtest "fix and check change notification" => sub {
+ $inst->apply_fixes;
+ is( $inst->needs_save, 1, "verify instance needs_save after tag fix" );
+ is(
+ $root->grab_value(q!lintian-overrides!),
+ "libburn4 binary: exit-in-shared-library\n",
+ "check tag replacement"
+ );
+};
+
+done_testing();
diff --git a/t/model_tests.d/dpkg-examples/lintian-overrides/debian/changelog b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/changelog
new file mode 100644
index 00000000..360df235
--- /dev/null
+++ b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/changelog
@@ -0,0 +1,6 @@
+libburn (1.5.2-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- Thomas Schmitt <scdbackup@gmx.net> Sun, 01 Dec 2019 18:11:05 +0100
+
diff --git a/t/model_tests.d/dpkg-examples/lintian-overrides/debian/control b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/control
new file mode 100644
index 00000000..64bb694f
--- /dev/null
+++ b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/control
@@ -0,0 +1,64 @@
+Source: libburn
+Maintainer: Debian Libburnia packagers <pkg-libburnia-devel@lists.alioth.debian.org>
+Uploaders: George Danchev <danchev@spnet.net>,
+ Mario Danic <mario.danic@gmail.com>,
+ Thomas Schmitt <scdbackup@gmx.net>
+Section: libs
+Priority: optional
+Build-Depends: pkg-config,
+ debhelper-compat (= 12),
+ libcam-dev [kfreebsd-any]
+Standards-Version: 4.4.1
+Vcs-Browser: https://salsa.debian.org/optical-media-team/libburn
+Vcs-Git: https://salsa.debian.org/optical-media-team/libburn.git
+Homepage: http://libburnia-project.org
+
+Package: libburn4
+Architecture: any
+Multi-Arch: same
+Depends: ${shlibs:Depends},
+ ${misc:Depends}
+Pre-Depends: ${misc:Pre-Depends}
+Description: library to provide CD/DVD/BD writing functions
+ libburn is a library for reading and writing optical discs.
+ Supported media are: CD-R, CD-RW, DVD-RAM, DVD+RW, DVD+R, DVD+R/DL,
+ DVD-RW, DVD-R, DVD-R/DL, BD-R, BD-RE.
+
+Package: cdrskin
+Architecture: any
+Section: otherosfs
+Depends: ${shlibs:Depends},
+ ${misc:Depends}
+Suggests: xorriso
+Description: command line CD/DVD/BD writing tool
+ cdrskin strives to be a second source for the services traditionally
+ provided by cdrecord. It writes data sessions to CD, DVD, or BD media.
+ To CD media it may also write audio sessions.
+ Multi-session is possible on all media types except DVD-R DL and
+ fastly blanked DVD-RW.
+ .
+ This is a burner-only application. If you want a burner and ISO 9660 image
+ manipulation application, please install the xorriso package.
+
+Package: libburn-dev
+Architecture: any
+Multi-Arch: same
+Section: libdevel
+Depends: ${misc:Depends},
+ libburn4 (= ${binary:Version})
+Suggests: libburn-doc (= ${source:Version})
+Description: development package for libburn4
+ This package contains the headers, pkgconfig data and static library for
+ libburn.
+ You need the headers if you want to develop or compile applications which
+ make use of the libburn4 API. Its definition is in <libburn/libburn.h>.
+
+Package: libburn-doc
+Architecture: all
+Multi-Arch: foreign
+Section: doc
+Depends: ${misc:Depends}
+Description: background documentation for libburn library
+ This package contains the background documentation for libburn. Not needed
+ for application development but rather describing the peculiarities of
+ optical media.
diff --git a/t/model_tests.d/dpkg-examples/lintian-overrides/debian/copyright b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/copyright
new file mode 100644
index 00000000..070b33bc
--- /dev/null
+++ b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/copyright
@@ -0,0 +1,38 @@
+Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
+Upstream-Name: libburn
+Upstream-Contact: libburn-hackers@pykix.org
+Source: http://files.libburnia-project.org/releases/
+
+Files: *
+Copyright: 2002-2006 Derek Foreman <derek@signalmarketing.com>
+ 2002-2006 Ben Jansens <xor@orodu.net>
+ 2006-2008 Mario Danic <mario.danic@gmail.com>
+ 2006-2016 Thomas Schmitt <scdbackup@gmx.net>
+License: GPL-2+
+
+Files: debian/*
+Copyright: 2006 Ante Karamatic <ivoks@ubuntu.com>
+ 2006-2008 Simon Huggins <huggie@earth.li>
+ 2008-2009 Matthew Rosewarne
+ 2008 Mario Danic <mario.danic@gmail.com>
+ 2011 Mats Erik Andersson <mats.andersson@gisladisker.se>
+ 2008-2012 George Danchev <danchev@spnet.net>
+ 2015-2016 Thomas Schmitt <scdbackup@gmx.net>
+License: GPL-2
+
+License: GPL-2
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; version 2 dated June, 1991.
+ .
+ On Debian systems, the complete text of version 2 of the GNU General
+ Public License can be found in '/usr/share/common-licenses/GPL-2'.
+
+License: GPL-2+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; version 2 dated June, 1991, or (at
+ your option) any later version.
+ .
+ On Debian systems, the complete text of version 2 of the GNU General
+ Public License can be found in '/usr/share/common-licenses/GPL-2'.
diff --git a/t/model_tests.d/dpkg-examples/lintian-overrides/debian/libburn4.lintian-overrides b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/libburn4.lintian-overrides
new file mode 100644
index 00000000..82c03407
--- /dev/null
+++ b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/libburn4.lintian-overrides
@@ -0,0 +1,9 @@
+
+# libburn offers signal handlers which care for proper shutdown of busy drives.
+# The users of the library decide whether they employ such a handler or whether
+# they prefer an own handler which then has to operate libburn to perform the
+# necessary drive shutdown.
+libburn4 binary: shlib-calls-exit
+
+# dummy tag
+libburn4 binary: dummy-tag
diff --git a/t/model_tests.d/dpkg-examples/lintian-overrides/debian/lintian-overrides b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/lintian-overrides
new file mode 100644
index 00000000..1a63ebdd
--- /dev/null
+++ b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/lintian-overrides
@@ -0,0 +1,4 @@
+
+# to test plain file
+libburn4 binary: exit-in-shared-library
+
diff --git a/t/model_tests.d/dpkg-examples/lintian-overrides/debian/rules b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/rules
new file mode 100755
index 00000000..1cd15eb5
--- /dev/null
+++ b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/rules
@@ -0,0 +1,26 @@
+#!/usr/bin/make -f
+# -*- mode: makefile; coding: utf-8 -*-
+
+# To enable PIE and ld -z "now".
+# Experimental 5 Feb 2016 to silence lintian hardening-no-pie and
+# hardening-no-bindnow
+# https://wiki.debian.org/HardeningWalkthrough#Selecting_security_hardening_options
+export DEB_BUILD_MAINT_OPTIONS = hardening=+all
+
+%:
+ dh $@ --with autoreconf
+
+override_dh_auto_build:
+ dh $@
+
+override_dh_installdocs:
+ dh_installdocs
+
+override_dh_makeshlibs:
+ dh_makeshlibs -V
+
+override_dh_clean:
+ $(RM) -f doc/doxygen.conf
+ $(RM) -r doc/html
+ if [ -f Makefile ]; then $(MAKE) clean; fi
+ dh_clean
diff --git a/t/model_tests.d/dpkg-examples/lintian-overrides/debian/source/format b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/source/format
new file mode 100644
index 00000000..163aaf8d
--- /dev/null
+++ b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/source/format
@@ -0,0 +1 @@
+3.0 (quilt)
diff --git a/t/model_tests.d/dpkg-examples/lintian-overrides/debian/source/lintian-overrides b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/source/lintian-overrides
new file mode 100644
index 00000000..55f02911
--- /dev/null
+++ b/t/model_tests.d/dpkg-examples/lintian-overrides/debian/source/lintian-overrides
@@ -0,0 +1,4 @@
+# Doxygen copies some javascript inside the generated documentation,
+# but the source of that is already in the Doxygen package.
+libburn source: source-is-missing doc/spot.html/*
+
diff --git a/t/model_tests.d/dpkg-examples/t0/debian/examples/ex1.pl b/t/model_tests.d/dpkg-examples/t0/debian/examples/ex1.pl
new file mode 100644
index 00000000..1c8f48a8
--- /dev/null
+++ b/t/model_tests.d/dpkg-examples/t0/debian/examples/ex1.pl
@@ -0,0 +1 @@
+# nothing interesting
diff --git a/t/model_tests.d/dpkg-examples/t0/debian/examples/ex2.pl b/t/model_tests.d/dpkg-examples/t0/debian/examples/ex2.pl
new file mode 100644
index 00000000..638430c1
--- /dev/null
+++ b/t/model_tests.d/dpkg-examples/t0/debian/examples/ex2.pl
@@ -0,0 +1 @@
+# nothing interesting either
diff --git a/t/model_tests.d/dpkg-examples/t0/debian/t0.examples b/t/model_tests.d/dpkg-examples/t0/debian/t0.examples
new file mode 100644
index 00000000..56bef8cb
--- /dev/null
+++ b/t/model_tests.d/dpkg-examples/t0/debian/t0.examples
@@ -0,0 +1 @@
+examples/ \ No newline at end of file
diff --git a/t/model_tests.d/dpkg-test-conf.pl b/t/model_tests.d/dpkg-test-conf.pl
index 00364cde..d5bf9f56 100644
--- a/t/model_tests.d/dpkg-test-conf.pl
+++ b/t/model_tests.d/dpkg-test-conf.pl
@@ -86,6 +86,7 @@ my @tests = (
'package-scripts:t0 prerm' => qr/dummy prerm/,
'package-scripts:t0/amd64 postrm' => qr/dummy postrm script for amd64/,
'package-scripts:./amd64 preinst' => qr/dummy preinst script for amd64/,
+ 'examples:t0 content:0' => 'examples/'
},
log4perl_load_warnings => [[
User => map {(warn => $_)} qr/source Standards-Version/, qr/compat/, (qr/debhelper/) x 2 , qr/Dual dependency/
@@ -352,6 +353,32 @@ my @tests = (
$tweak_map{config} => qw/joe@foo\.com/,
}
},
+
+ {
+ name => 'lintian-overrides',
+ apply_fix => 1,
+ check => {
+ 'lintian-overrides:libburn4' => [
+ # check that tag was renamed from shlib-calls-exit
+ qr/exit-in-shared-library/,
+ # check that comment is present
+ qr/decide whether/, qr/busy drives\.\n/,
+ ],
+ 'lintian-overrides:.' => [
+ # check that plain overrides file is handled
+ qr/exit-in-shared-library/,
+ ],
+ 'source lintian-overrides' => [
+ # check that source overrides file is handled
+ qr/libburn source: source-is-missing/,
+ ],
+ },
+ full_dump => {
+ log4perl_dump_warnings => [
+ [User => warn => qr/dummy-tag/],
+ ],
+ },
+ }
);
my $cache_file = path('t/model_tests.d/dependency-cache.txt');
diff --git a/t/perl-critic.t b/t/perl-critic.t
new file mode 100644
index 00000000..1ee564e2
--- /dev/null
+++ b/t/perl-critic.t
@@ -0,0 +1,21 @@
+ use strict;
+ use warnings;
+ use File::Spec;
+ use Test::More;
+ use English qw(-no_match_vars);
+
+ if ( not $ENV{TEST_AUTHOR} ) {
+ my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
+ plan( skip_all => $msg );
+ }
+
+ eval { require Test::Perl::Critic; };
+
+ if ( $EVAL_ERROR ) {
+ my $msg = 'Test::Perl::Critic required to criticise code';
+ plan( skip_all => $msg );
+ }
+
+ my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' );
+ Test::Perl::Critic->import( -profile => $rcfile );
+ all_critic_ok();
diff --git a/t/perlcriticrc b/t/perlcriticrc
new file mode 100644
index 00000000..bb7acf64
--- /dev/null
+++ b/t/perlcriticrc
@@ -0,0 +1,16 @@
+severity = 4
+
+# remove when https://github.com/Perl-Critic/PPI/issues/194 is fixed
+[-Subroutines::ProhibitSubroutinePrototypes]
+
+[TestingAndDebugging::ProhibitNoWarnings]
+allow = experimental::postderef experimental::signatures
+
+# model files are not modules
+[-Modules::RequireExplicitPackage]
+
+# model files finish with a data structure: the model
+[-Modules::RequireEndWithOne]
+
+[RegularExpressions::RequireExtendedFormatting]
+minimum_regex_length_to_complain_about = 25
diff --git a/t/scanner/README.md b/t/scanner/README.md
deleted file mode 100644
index 8c246f91..00000000
--- a/t/scanner/README.md
+++ /dev/null
@@ -1,27 +0,0 @@
-New examples are created in 2 steps.
-
-First create the .in file
-
-Say you want to create a test from package `foo`.
-
-set these variables:
-
- # create .in file
- # in libconfig-model-dpkg-perl repo
- export TEST=foo_test
- export repo_dir=$PWD
- cd path_to_foo
- licensecheck --encoding utf8 --copyright --machine --shortname-scheme=debian,spdx --recursive . > $repo_dir/t/scanner/examples/$TEST.in
-
- # create .out file
- cd - # back to libconfig-model-dpkg-perl repo
- perl -Ilib bin/scan-copyrights t/scanner/examples/$TEST.in > t/scanner/examples/$TEST.out
-
-The .out files may need to be regenated if lib/Dpkg/Copyright/Scanner.pm is changed.
-Use a similar command to do so:
-
- export TEST=bar
- perl -Ilib bin/scan-copyrights t/scanner/examples/$TEST.in > t/scanner/examples/$TEST.out
-
-Be sure to check that the updated output makes sense
-
diff --git a/t/scanner/README.org b/t/scanner/README.org
new file mode 100644
index 00000000..0617386b
--- /dev/null
+++ b/t/scanner/README.org
@@ -0,0 +1,69 @@
+* Test input
+
+** Structure
+
+New test cases for [[file:scan-copyright.t][scan_copyright.t]] are in 2 forms:
+- a =*.d= directory containing source files
+- a =*.in= file containing the output of =licensecheck= command
+
+** Creating a *.d directory
+
+You must use a =*.d= directory if copyright scanner extracts data from
+source file. This is currently the case for Rust, NodeJS, Perl and
+Raku modules.
+
+This directory must contain at least the file containing copyright data:
+
+| Language | file |
+|----------+--------------|
+| NodeJS | package.json |
+| Perl | META.json |
+| Raku | META6.json |
+| Rust | Cargo.toml |
+
+Then you can other source files to test copyright extracted from files using
+=licensecheck=
+
+** Creating a *.in file
+
+Say you want to create a =foo_test.in= file using data from package
+=foo=.
+
+You have to run a set of commands like:
+
+#+BEGIN_EXAMPLE
+ # create .in file
+ # in libconfig-model-dpkg-perl repo
+ export TEST=foo_test
+ export repo_dir=$PWD
+ cd path_to_foo
+ licensecheck --encoding utf8 --copyright --machine --deb-fmt --recursive . > $repo_dir/t/scanner/examples/$TEST.in
+#+END_EXAMPLE
+
+* Test output
+
+** Creating the *.out file
+
+This file contains the expected output of copyright scanner and must
+be created whether the test input is a =*.d= directory or a =*.in= file.
+
+#+BEGIN_EXAMPLE
+ # create .out file
+ cd - # back to libconfig-model-dpkg-perl repo
+ # use either $TEST.in or $TEST.d as scan-copyrights argument
+ perl -Ilib bin/scan-copyrights t/scanner/examples/$TEST.in > t/scanner/examples/$TEST.out
+#+END_EXAMPLE
+
+Be sure to check that the test output makes sense.
+
+** Updating the test case
+
+The =*.out= files may need to be regenerated if =lib/Dpkg/Copyright/Scanner.pm=
+is changed. To do so, use a command like:
+
+#+BEGIN_EXAMPLE
+ export TEST=bar
+ perl -Ilib bin/scan-copyrights t/scanner/examples/$TEST.in > t/scanner/examples/$TEST.out
+#+END_EXAMPLE
+
+Be sure to check that the updated output makes sense.
diff --git a/t/scanner/examples/less.js.d/package.json b/t/scanner/examples/less.js.d/package.json
new file mode 100644
index 00000000..b468baef
--- /dev/null
+++ b/t/scanner/examples/less.js.d/package.json
@@ -0,0 +1,33 @@
+{
+ "name": "@less/root",
+ "private": true,
+ "version": "3.12.2",
+ "description": "Less monorepo",
+ "homepage": "http://lesscss.org",
+ "scripts": {
+ "bootstrap": "lerna bootstrap",
+ "postinstall": "npm run bootstrap",
+ "changelog": "github-changes -o less -r less.js -a --only-pulls --use-commit-body -m \"(YYYY-MM-DD)\"",
+ "test": "cd packages/less && npm test"
+ },
+ "author": {
+ "name": "Alexis Sellier",
+ "email": "self@cloudhead.net"
+ },
+ "contributors": [
+ "The Core Less Team"
+ ],
+ "license": "Apache-2.0",
+ "bugs": {
+ "url": "https://github.com/less/less.js/issues"
+ },
+ "repository": {
+ "type": "git",
+ "url": "https://github.com/less/less.js.git"
+ },
+ "devDependencies": {
+ "github-changes": "^1.1.2",
+ "lerna": "^3.22.1",
+ "npm-run-all": "^4.1.5"
+ }
+}
diff --git a/t/scanner/examples/less.js.out b/t/scanner/examples/less.js.out
new file mode 100644
index 00000000..73c59592
--- /dev/null
+++ b/t/scanner/examples/less.js.out
@@ -0,0 +1,4 @@
+Files: *
+Copyright: Alexis Sellier
+License: Apache-2.0
+
diff --git a/t/scanner/examples/node-to-regex-range.d/package.json b/t/scanner/examples/node-to-regex-range.d/package.json
new file mode 100644
index 00000000..e08a4391
--- /dev/null
+++ b/t/scanner/examples/node-to-regex-range.d/package.json
@@ -0,0 +1,88 @@
+{
+ "name": "to-regex-range",
+ "description": "Pass two numbers, get a regex-compatible source string for matching ranges. Validated against more than 2.78 million test assertions.",
+ "version": "5.0.1",
+ "homepage": "https://github.com/micromatch/to-regex-range",
+ "author": "Jon Schlinkert (https://github.com/jonschlinkert) ßæø",
+ "contributors": [
+ "Jon Schlinkert (http://twitter.com/jonschlinkert)",
+ "Rouven Weßling (www.rouvenwessling.de)"
+ ],
+ "repository": "micromatch/to-regex-range",
+ "bugs": {
+ "url": "https://github.com/micromatch/to-regex-range/issues"
+ },
+ "license": "MIT",
+ "files": [
+ "index.js"
+ ],
+ "main": "index.js",
+ "engines": {
+ "node": ">=8.0"
+ },
+ "scripts": {
+ "test": "mocha"
+ },
+ "dependencies": {
+ "is-number": "^7.0.0"
+ },
+ "devDependencies": {
+ "fill-range": "^6.0.0",
+ "gulp-format-md": "^2.0.0",
+ "mocha": "^6.0.2",
+ "text-table": "^0.2.0",
+ "time-diff": "^0.3.1"
+ },
+ "keywords": [
+ "bash",
+ "date",
+ "expand",
+ "expansion",
+ "expression",
+ "glob",
+ "match",
+ "match date",
+ "match number",
+ "match numbers",
+ "match year",
+ "matches",
+ "matching",
+ "number",
+ "numbers",
+ "numerical",
+ "range",
+ "ranges",
+ "regex",
+ "regexp",
+ "regular",
+ "regular expression",
+ "sequence"
+ ],
+ "verb": {
+ "layout": "default",
+ "toc": false,
+ "tasks": [
+ "readme"
+ ],
+ "plugins": [
+ "gulp-format-md"
+ ],
+ "lint": {
+ "reflinks": true
+ },
+ "helpers": {
+ "examples": {
+ "displayName": "examples"
+ }
+ },
+ "related": {
+ "list": [
+ "expand-range",
+ "fill-range",
+ "micromatch",
+ "repeat-element",
+ "repeat-string"
+ ]
+ }
+ }
+}
diff --git a/t/scanner/examples/node-to-regex-range.out b/t/scanner/examples/node-to-regex-range.out
new file mode 100644
index 00000000..919b3749
--- /dev/null
+++ b/t/scanner/examples/node-to-regex-range.out
@@ -0,0 +1,4 @@
+Files: *
+Copyright: Jon Schlinkert (https://github.com/jonschlinkert) ßæø
+License: Expat
+
diff --git a/t/scanner/scan-copyright.t b/t/scanner/scan-copyright.t
index fe92995a..4b2be888 100644
--- a/t/scanner/scan-copyright.t
+++ b/t/scanner/scan-copyright.t
@@ -7,7 +7,7 @@ use Test::More; # see done_testing()
use Path::Tiny;
use Test::File::Contents;
-use Dpkg::Copyright::Scanner;
+use Dpkg::Copyright::Scanner qw/print_copyright/;
# global tests