diff options
author | Guillem Jover <guillem@debian.org> | 2013-01-27 15:27:02 +0100 |
---|---|---|
committer | Guillem Jover <guillem@debian.org> | 2013-12-04 07:09:42 +0100 |
commit | 8c314d6c4cee9b2c5acf078958243fb72af4e3d2 (patch) | |
tree | 3b1fa61a55cd4a9da30bfca3899379e0d1c5f231 /scripts/Dpkg | |
parent | 4b35d5045ad062a8ac61250df685f8b3178e8e9e (diff) | |
download | dpkg-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.pm | 8 | ||||
-rw-r--r-- | scripts/Dpkg/Compression/FileHandle.pm | 16 | ||||
-rw-r--r-- | scripts/Dpkg/Compression/Process.pm | 6 | ||||
-rw-r--r-- | scripts/Dpkg/Control/Fields.pm | 4 | ||||
-rw-r--r-- | scripts/Dpkg/Deps.pm | 10 | ||||
-rw-r--r-- | scripts/Dpkg/ErrorHandling.pm | 7 | ||||
-rw-r--r-- | scripts/Dpkg/IPC.pm | 24 | ||||
-rw-r--r-- | scripts/Dpkg/Interface/Storable.pm | 8 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Archive.pm | 8 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Package.pm | 11 | ||||
-rw-r--r-- | scripts/Dpkg/Version.pm | 5 |
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'"; } } |