Explorar o código

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
Guillem Jover %!s(int64=13) %!d(string=hai) anos
pai
achega
8c314d6c4c

+ 5 - 3
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;

+ 10 - 6
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 {

+ 4 - 2
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;
 }
 

+ 3 - 1
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";
     }
 }
 

+ 7 - 3
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;

+ 1 - 6
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);

+ 13 - 11
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});

+ 5 - 3
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();
 }

+ 5 - 3
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);
 }

+ 6 - 5
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},

+ 3 - 2
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'";
     }
 }