Copy code from controllib.pl and dpkg-gettext.pl to proper modules

When trying to use proper perl modules together with stuff like
controllib.pl, all kind of "interesting" scoping issues arise.
Code that is already converted to modules should not use these
"old-style" modules. Create Dpkg::Gettext as a near verbatim copy
of dpkg-gettext.pl and a Dpkg::ErrorHandling as a container for some
error reporting functions from controllib.pl that are used by Raphael's
modules.

Note that this (at least Dpkg::ErrorHandling) should be only an interim
solution until a proper API gets defined.

diff --git a/scripts/Dpkg/ErrorHandling.pm b/scripts/Dpkg/ErrorHandling.pm
new file mode 100644 (file)
index 0000000..d2cf3c6
--- /dev/null
+++ b/scripts/Dpkg/ErrorHandling.pm
@@ -0,0 +1,48 @@
+package Dpkg::ErrorHandling;
+
+use base qw(Exporter);
+our @EXPORT_OK = qw( failure syserr error internerr warning
+                     warnerror subprocerr );
+
+our $warnable_error = 0;
+our $quiet_warnings = 0;
+our $progname = "unknown";
+
+sub failure { die sprintf(_g("%s: failure: %s"), $progname, $_[0])."\n"; }
+sub syserr { die sprintf(_g("%s: failure: %s: %s"), $progname, $_[0], $!)."\n"; }
+sub error { die sprintf(_g("%s: error: %s"), $progname, $_[0])."\n"; }
+sub internerr { die sprintf(_g("%s: internal error: %s"), $progname, $_[0])."\n"; }
+
+sub warning
+{
+    if (!$quiet_warnings) {
+       warn sprintf(_g("%s: warning: %s"), $progname, $_[0])."\n";
+    }
+}
+
+sub warnerror
+{
+    if ($warnable_error) {
+       warning(@_);
+    } else {
+       error(@_);
+    }
+}
+
+sub subprocerr {
+    my ($p) = @_;
+    require POSIX;
+    if (POSIX::WIFEXITED($?)) {
+       die sprintf(_g("%s: failure: %s gave error exit status %s"),
+                   $progname, $p, POSIX::WEXITSTATUS($?))."\n";
+    } elsif (POSIX::WIFSIGNALED($?)) {
+       die sprintf(_g("%s: failure: %s died from signal %s"),
+                   $progname, $p, POSIX::WTERMSIG($?))."\n";
+    } else {
+       die sprintf(_g("%s: failure: %s failed with unknown exit code %d"),
+                   $progname, $p, $?)."\n";
+    }
+}
+
+
+1;

diff --git a/scripts/Dpkg/Gettext.pm b/scripts/Dpkg/Gettext.pm
new file mode 100644 (file)
index 0000000..99bba38
--- /dev/null
+++ b/scripts/Dpkg/Gettext.pm
@@ -0,0 +1,38 @@
+#!/usr/bin/perl -w
+# Copied from /usr/share/perl5/Debconf/Gettext.pm
+
+package Dpkg::Gettext;
+
+use strict;
+use warnings;
+
+BEGIN {
+       eval 'use Locale::gettext';
+       if ($@) {
+               eval q{
+                       sub _g {
+                               return shift;
+                       }
+                       sub textdomain {
+                       }
+                       sub ngettext {
+                               if ($_[2] == 1) {
+                                       return $_[0];
+                               } else {
+                                       return $_[1];
+                               }
+                       }
+               };
+       } else {
+               eval q{
+                       sub _g {
+                               return gettext(shift);
+                       }
+               };
+       }
+}
+
+use base qw(Exporter);
+our @EXPORT=qw(_g textdomain ngettext);
+
+1;

diff --git a/scripts/Dpkg/Makefile.am b/scripts/Dpkg/Makefile.am
index c83ba250b40c9a640918e607a93f6119c3550c0c..abbccf32ab8a2dc6cdd84bbed824bdaebef12029 100644 (file)
--- a/scripts/Dpkg/Makefile.am
+++ b/scripts/Dpkg/Makefile.am
@@ -3,5 +3,5 @@ shlibsmodulesdir=$(pkglibdir)/Dpkg/Shlibs
 dpkgmodulesdir=$(pkglibdir)/Dpkg
 
 dist_shlibsmodules_DATA = Shlibs/Objdump.pm Shlibs/SymbolFile.pm
-dist_dpkgmodules_DATA = Shlibs.pm Version.pm
+dist_dpkgmodules_DATA = ErrorHandling.pm Gettext.pm Shlibs.pm Version.pm