summaryrefslogtreecommitdiff
path: root/scripts/Dpkg
diff options
context:
space:
mode:
authorGuillem Jover <guillem@debian.org>2013-01-27 15:27:02 +0100
committerGuillem Jover <guillem@debian.org>2013-12-04 07:09:42 +0100
commit8c314d6c4cee9b2c5acf078958243fb72af4e3d2 (patch)
tree3b1fa61a55cd4a9da30bfca3899379e0d1c5f231 /scripts/Dpkg
parent4b35d5045ad062a8ac61250df685f8b3178e8e9e (diff)
downloaddpkg-8c314d6c4cee9b2c5acf078958243fb72af4e3d2.tar.gz
scripts: Use croak instead of internerr on programming errors in modules
Remove now unused internerr() function, replaced by croak which does a way better job. Addresses ErrorHandling::RequireCarping. Warned-by: perlcritic
Diffstat (limited to 'scripts/Dpkg')
-rw-r--r--scripts/Dpkg/Changelog/Entry.pm8
-rw-r--r--scripts/Dpkg/Compression/FileHandle.pm16
-rw-r--r--scripts/Dpkg/Compression/Process.pm6
-rw-r--r--scripts/Dpkg/Control/Fields.pm4
-rw-r--r--scripts/Dpkg/Deps.pm10
-rw-r--r--scripts/Dpkg/ErrorHandling.pm7
-rw-r--r--scripts/Dpkg/IPC.pm24
-rw-r--r--scripts/Dpkg/Interface/Storable.pm8
-rw-r--r--scripts/Dpkg/Source/Archive.pm8
-rw-r--r--scripts/Dpkg/Source/Package.pm11
-rw-r--r--scripts/Dpkg/Version.pm5
11 files changed, 62 insertions, 45 deletions
diff --git a/scripts/Dpkg/Changelog/Entry.pm b/scripts/Dpkg/Changelog/Entry.pm
index f41444de7..95a0fce75 100644
--- a/scripts/Dpkg/Changelog/Entry.pm
+++ b/scripts/Dpkg/Changelog/Entry.pm
@@ -20,6 +20,8 @@ use warnings;
our $VERSION = '1.00';
+use Carp;
+
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
use Dpkg::Control::Changelog;
@@ -110,7 +112,7 @@ lines) corresponding to the requested part. $part can be
sub get_part {
my ($self, $part) = @_;
- internerr('invalid part of changelog entry: %s') unless exists $self->{$part};
+ croak "invalid part of changelog entry: $part" unless exists $self->{$part};
return $self->{$part};
}
@@ -123,7 +125,7 @@ or an array ref.
sub set_part {
my ($self, $part, $value) = @_;
- internerr('invalid part of changelog entry: %s') unless exists $self->{$part};
+ croak "invalid part of changelog entry: $part" unless exists $self->{$part};
if (ref($self->{$part})) {
if (ref($value)) {
$self->{$part} = $value;
@@ -145,7 +147,7 @@ concatenated at the end of the current line.
sub extend_part {
my ($self, $part, $value, @rest) = @_;
- internerr('invalid part of changelog entry: %s') unless exists $self->{$part};
+ croak "invalid part of changelog entry: $part" unless exists $self->{$part};
if (ref($self->{$part})) {
if (ref($value)) {
push @{$self->{$part}}, @$value;
diff --git a/scripts/Dpkg/Compression/FileHandle.pm b/scripts/Dpkg/Compression/FileHandle.pm
index 7b649659e..0c4f7b12b 100644
--- a/scripts/Dpkg/Compression/FileHandle.pm
+++ b/scripts/Dpkg/Compression/FileHandle.pm
@@ -24,6 +24,8 @@ use Dpkg::Compression;
use Dpkg::Compression::Process;
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
+
+use Carp;
use POSIX qw(:signal_h :sys_wait_h);
use parent qw(FileHandle Tie::Handle);
@@ -156,14 +158,14 @@ sub ensure_open {
my ($self, $mode) = @_;
if (exists *$self->{mode}) {
return if *$self->{mode} eq $mode;
- internerr("ensure_open requested incompatible mode: $mode");
+ croak "ensure_open requested incompatible mode: $mode";
} else {
if ($mode eq 'w') {
$self->open_for_write();
} elsif ($mode eq 'r') {
$self->open_for_read();
} else {
- internerr("invalid mode in ensure_open: $mode");
+ croak "invalid mode in ensure_open: $mode";
}
}
}
@@ -205,10 +207,12 @@ sub OPEN {
} elsif ($mode eq '<') {
$self->open_for_read();
} else {
- internerr("Unsupported open mode on Dpkg::Compression::FileHandle: $mode");
+ croak 'Dpkg::Compression::FileHandle does not support ' .
+ "open() mode $mode";
}
} else {
- internerr('Dpkg::Compression::FileHandle only supports open() with 3 parameters');
+ croak 'Dpkg::Compression::FileHandle only supports open() ' .
+ 'with 3 parameters';
}
return 1; # Always works (otherwise errors out)
}
@@ -328,8 +332,8 @@ sub get_filename {
my $comp = *$self->{compression};
if (*$self->{add_comp_ext}) {
if ($comp eq 'auto') {
- internerr('automatic detection of compression is ' .
- 'incompatible with add_comp_ext');
+ croak 'automatic detection of compression is ' .
+ 'incompatible with add_comp_ext';
} elsif ($comp eq 'none') {
return *$self->{filename};
} else {
diff --git a/scripts/Dpkg/Compression/Process.pm b/scripts/Dpkg/Compression/Process.pm
index a7dd97690..a962574c6 100644
--- a/scripts/Dpkg/Compression/Process.pm
+++ b/scripts/Dpkg/Compression/Process.pm
@@ -20,6 +20,8 @@ use warnings;
our $VERSION = '1.00';
+use Carp;
+
use Dpkg::Compression;
use Dpkg::ErrorHandling;
use Dpkg::Gettext;
@@ -127,8 +129,8 @@ sub _sanity_check {
$to++ if $opts{"to_$_"};
$from++ if $opts{"from_$_"};
}
- internerr('exactly one to_* parameter is needed') if $to != 1;
- internerr('exactly one from_* parameter is needed') if $from != 1;
+ croak 'exactly one to_* parameter is needed' if $to != 1;
+ croak 'exactly one from_* parameter is needed' if $from != 1;
return %opts;
}
diff --git a/scripts/Dpkg/Control/Fields.pm b/scripts/Dpkg/Control/Fields.pm
index a3d9b74fe..9d9e1ede2 100644
--- a/scripts/Dpkg/Control/Fields.pm
+++ b/scripts/Dpkg/Control/Fields.pm
@@ -20,7 +20,9 @@ use warnings;
our $VERSION = '1.00';
+use Carp;
use Exporter qw(import);
+
use Dpkg::Control::FieldsCore;
use Dpkg::Vendor qw(run_vendor_hook);
@@ -37,7 +39,7 @@ foreach my $op (run_vendor_hook('register-custom-fields')) {
} elsif ($func eq 'insert_after') {
&field_insert_after(@$op);
} else {
- internerr("vendor hook register-custom-fields sent bad data: @$op");
+ croak "vendor hook register-custom-fields sent bad data: @$op";
}
}
diff --git a/scripts/Dpkg/Deps.pm b/scripts/Dpkg/Deps.pm
index 7cca06a74..bb0689968 100644
--- a/scripts/Dpkg/Deps.pm
+++ b/scripts/Dpkg/Deps.pm
@@ -464,6 +464,8 @@ both dependencies. Otherwise returns false.
use strict;
use warnings;
+use Carp;
+
use Dpkg::Arch qw(debarch_is);
use Dpkg::Version;
use Dpkg::ErrorHandling;
@@ -700,8 +702,8 @@ sub implies {
}
return $res;
} else {
- internerr("Dpkg::Deps::Simple can't evaluate implication with a %s!",
- ref($o));
+ croak 'Dpkg::Deps::Simple cannot evaluate implication with a ' .
+ ref($o);
}
}
@@ -835,6 +837,8 @@ Adds a new dependency object at the end of the list.
use strict;
use warnings;
+use Carp;
+
use Dpkg::ErrorHandling;
use parent qw(Dpkg::Interface::Storable);
@@ -904,7 +908,7 @@ sub is_empty {
}
sub merge_union {
- internerr('The method merge_union() is only valid for Dpkg::Deps::Simple');
+ croak 'method merge_union() is only valid for Dpkg::Deps::Simple';
}
package Dpkg::Deps::AND;
diff --git a/scripts/Dpkg/ErrorHandling.pm b/scripts/Dpkg/ErrorHandling.pm
index 62b5be2dc..2a622ae7d 100644
--- a/scripts/Dpkg/ErrorHandling.pm
+++ b/scripts/Dpkg/ErrorHandling.pm
@@ -23,7 +23,7 @@ use Dpkg::Gettext;
use Exporter qw(import);
our @EXPORT = qw(report_options info warning error errormsg
- syserr internerr subprocerr usageerr);
+ syserr subprocerr usageerr);
our @EXPORT_OK = qw(report);
my $quiet_warnings = 0;
@@ -75,11 +75,6 @@ sub errormsg($;@)
print STDERR report(_g('error'), @_);
}
-sub internerr($;@)
-{
- die report(_g('internal error'), @_);
-}
-
sub subprocerr(@)
{
my ($p) = (shift);
diff --git a/scripts/Dpkg/IPC.pm b/scripts/Dpkg/IPC.pm
index d3472a459..9d18ab22c 100644
--- a/scripts/Dpkg/IPC.pm
+++ b/scripts/Dpkg/IPC.pm
@@ -24,6 +24,7 @@ our $VERSION = '1.00';
use Dpkg::ErrorHandling;
use Dpkg::Gettext;
+use Carp;
use Exporter qw(import);
our @EXPORT = qw(spawn wait_child);
@@ -133,7 +134,7 @@ listed in the array before calling exec.
sub _sanity_check_opts {
my (%opts) = @_;
- internerr('exec parameter is mandatory in spawn()')
+ croak 'exec parameter is mandatory in spawn()'
unless $opts{exec};
my $to = my $error_to = my $from = 0;
@@ -142,17 +143,17 @@ sub _sanity_check_opts {
$error_to++ if $opts{"error_to_$_"};
$from++ if $opts{"from_$_"};
}
- internerr('not more than one of to_* parameters is allowed')
+ croak 'not more than one of to_* parameters is allowed'
if $to > 1;
- internerr('not more than one of error_to_* parameters is allowed')
+ croak 'not more than one of error_to_* parameters is allowed'
if $error_to > 1;
- internerr('not more than one of from_* parameters is allowed')
+ croak 'not more than one of from_* parameters is allowed'
if $from > 1;
foreach (qw(to_string error_to_string from_string)) {
if (exists $opts{$_} and
(not ref($opts{$_}) or ref($opts{$_}) ne 'SCALAR')) {
- internerr("parameter $_ must be a scalar reference");
+ croak "parameter $_ must be a scalar reference";
}
}
@@ -160,21 +161,22 @@ sub _sanity_check_opts {
if (exists $opts{$_} and
(not ref($opts{$_}) or (ref($opts{$_}) ne 'SCALAR' and
not $opts{$_}->isa('IO::Handle')))) {
- internerr("parameter $_ must be a scalar reference or an IO::Handle object");
+ croak "parameter $_ must be a scalar reference or " .
+ 'an IO::Handle object';
}
}
if (exists $opts{timeout} and defined($opts{timeout}) and
$opts{timeout} !~ /^\d+$/) {
- internerr('parameter timeout must be an integer');
+ croak 'parameter timeout must be an integer';
}
if (exists $opts{env} and ref($opts{env}) ne 'HASH') {
- internerr('parameter env must be a hash reference');
+ croak 'parameter env must be a hash reference';
}
if (exists $opts{delete_env} and ref($opts{delete_env}) ne 'ARRAY') {
- internerr('parameter delete_env must be an array reference');
+ croak 'parameter delete_env must be an array reference';
}
return %opts;
@@ -189,7 +191,7 @@ sub spawn {
} elsif (not ref($opts{exec})) {
push @prog, $opts{exec};
} else {
- internerr('invalid exec parameter in spawn()');
+ croak 'invalid exec parameter in spawn()';
}
my ($from_string_pipe, $to_string_pipe, $error_to_string_pipe);
if ($opts{to_string}) {
@@ -339,7 +341,7 @@ with an error message.
sub wait_child {
my ($pid, %opts) = @_;
$opts{cmdline} ||= _g('child process');
- internerr('no PID set, cannot wait end of process') unless $pid;
+ croak 'no PID set, cannot wait end of process' unless $pid;
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
alarm($opts{timeout}) if defined($opts{timeout});
diff --git a/scripts/Dpkg/Interface/Storable.pm b/scripts/Dpkg/Interface/Storable.pm
index 1846301f4..c02549131 100644
--- a/scripts/Dpkg/Interface/Storable.pm
+++ b/scripts/Dpkg/Interface/Storable.pm
@@ -20,6 +20,8 @@ use warnings;
our $VERSION = '1.00';
+use Carp;
+
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
use Dpkg::Compression::FileHandle;
@@ -76,7 +78,7 @@ standard input is read (no compression is allowed in that case).
sub load {
my ($self, $file, @options) = @_;
unless ($self->can('parse')) {
- internerr('%s cannot be loaded, it lacks the parse method', ref($self));
+ croak ref($self) . ' cannot be loaded, it lacks the parse method';
}
my ($desc, $fh) = ($file, undef);
if ($file eq '-') {
@@ -105,7 +107,7 @@ standard output is used (data are written uncompressed in that case).
sub save {
my ($self, $file, @options) = @_;
unless ($self->can('output')) {
- internerr('%s cannot be saved, it lacks the output method', ref($self));
+ croak ref($self) . ' cannot be saved, it lacks the output method';
}
my $fh;
if ($file eq '-') {
@@ -129,7 +131,7 @@ Return a string representation of the object.
sub _stringify {
my ($self) = @_;
unless ($self->can('output')) {
- internerr('%s cannot be stringified, it lacks the output method', ref($self));
+ croak ref($self) . ' cannot be stringified, it lacks the output method';
}
return $self->output();
}
diff --git a/scripts/Dpkg/Source/Archive.pm b/scripts/Dpkg/Source/Archive.pm
index dc470c165..30ca1a217 100644
--- a/scripts/Dpkg/Source/Archive.pm
+++ b/scripts/Dpkg/Source/Archive.pm
@@ -25,6 +25,7 @@ use Dpkg::Gettext;
use Dpkg::IPC;
use Dpkg::ErrorHandling;
+use Carp;
use File::Temp qw(tempdir);
use File::Basename qw(basename);
use File::Spec;
@@ -57,7 +58,7 @@ sub create {
sub _add_entry {
my ($self, $file) = @_;
my $cwd = *$self->{cwd};
- internerr('call create() first') unless *$self->{tar_input};
+ croak 'call create() first' unless *$self->{tar_input};
$file = $2 if ($file =~ /^\Q$cwd\E\/(.+)$/); # Relative names
print({ *$self->{tar_input} } "$file\0")
or syserr(_g('write on tar input'));
@@ -69,7 +70,8 @@ sub add_file {
if (*$self->{chdir}) {
$testfile = File::Spec->catfile(*$self->{chdir}, $file);
}
- internerr("add_file() doesn't handle directories") if not -l $testfile and -d _;
+ croak 'add_file() does not handle directories'
+ if not -l $testfile and -d _;
$self->_add_entry($file);
}
@@ -79,7 +81,7 @@ sub add_directory {
if (*$self->{chdir}) {
$testfile = File::Spec->catdir(*$self->{chdir}, $file);
}
- internerr('add_directory() only handles directories')
+ croak 'add_directory() only handles directories'
if -l $testfile or not -d _;
$self->_add_entry($file);
}
diff --git a/scripts/Dpkg/Source/Package.pm b/scripts/Dpkg/Source/Package.pm
index b8d817d3c..3f740678f 100644
--- a/scripts/Dpkg/Source/Package.pm
+++ b/scripts/Dpkg/Source/Package.pm
@@ -48,6 +48,7 @@ use Dpkg::Path qw(check_files_are_the_same find_command);
use Dpkg::IPC;
use Dpkg::Vendor qw(run_vendor_hook);
+use Carp;
use POSIX qw(:errno_h :sys_wait_h);
use File::Basename;
@@ -496,8 +497,8 @@ sub extract {
}
sub do_extract {
- internerr("Dpkg::Source::Package doesn't know how to unpack a " .
- 'source package. Use one of the subclasses.');
+ croak 'Dpkg::Source::Package does not know how to unpack a ' .
+ 'source package; use one of the subclasses';
}
# Function used specifically during creation of a source package
@@ -520,8 +521,8 @@ sub after_build {
}
sub do_build {
- internerr("Dpkg::Source::Package doesn't know how to build a " .
- 'source package. Use one of the subclasses.');
+ croak 'Dpkg::Source::Package does not know how to build a ' .
+ 'source package; use one of the subclasses';
}
sub can_build {
@@ -533,7 +534,7 @@ sub add_file {
my ($self, $filename) = @_;
my ($fn, $dir) = fileparse($filename);
if ($self->{checksums}->has_file($fn)) {
- internerr("tried to add file '%s' twice", $fn);
+ croak "tried to add file '$fn' twice";
}
$self->{checksums}->add_from_file($filename, key => $fn);
$self->{checksums}->export_to_control($self->{fields},
diff --git a/scripts/Dpkg/Version.pm b/scripts/Dpkg/Version.pm
index 8ee196426..95d9a8414 100644
--- a/scripts/Dpkg/Version.pm
+++ b/scripts/Dpkg/Version.pm
@@ -26,6 +26,7 @@ our $VERSION = '1.01';
use Dpkg::ErrorHandling;
use Dpkg::Gettext;
+use Carp;
use Exporter qw(import);
our @EXPORT = qw(version_compare version_compare_relation
version_normalize_relation version_compare_string
@@ -263,7 +264,7 @@ sub version_compare_relation($$$) {
} elsif ($op eq REL_LT) {
return $res < 0;
} else {
- internerr("unsupported relation for version_compare_relation(): '$op'");
+ croak "unsupported relation for version_compare_relation(): '$op'";
}
}
@@ -294,7 +295,7 @@ sub version_normalize_relation($) {
} elsif ($op eq '<<' or $op eq 'lt') {
return REL_LT;
} else {
- internerr("bad relation '$op'");
+ croak "bad relation '$op'";
}
}