New framework to hook vendor-specific logic

* scripts/Dpkg/Vendor/Default.pm: Generic vendor object that will
be used to hook vendor-specific behaviour in multiple places.
* scripts/Dpkg/Vendor/Debian.pm: Debian variant of that object.
* scripts/Dpkg/Vendor.pm (get_vendor_object, run_vendor_hook):
New functions to retrieve the current vendor object and run
vendor-specific code.
* scripts/dpkg-source.pl, scripts/dpkg-genchanges.pl: Add first
vendor hooks to be used by Ubuntu.
* scripts/Makefile.am (EXTRA_DIST): Add
'scripts/Dpkg/Vendor/Default.pm' and 'scripts/Dpkg/Vendor/Debian.pm'.

ChangeLog

@@ -1,3 +1,17 @@
+2009-02-04  Raphael Hertzog  <hertzog@debian.org>
+
+	* scripts/Dpkg/Vendor/Default.pm: Generic vendor object that will
+	be used to hook vendor-specific behaviour in multiple places.
+	* scripts/Dpkg/Vendor/Debian.pm: Debian variant of that object.
+	* scripts/Dpkg/Vendor.pm (get_vendor_object, run_vendor_hook):
+	New functions to retrieve the current vendor object and run
+	vendor-specific code.
+	* scripts/dpkg-source.pl, scripts/dpkg-genchanges.pl: Add first
+	vendor hooks to be used by Ubuntu.
+	* scripts/Makefile.am (EXTRA_DIST): Add
+	'scripts/Dpkg/Vendor/Default.pm' and
+	'scripts/Dpkg/Vendor/Debian.pm'.
+
 2009-01-29  Guillem Jover  <guillem@debian.org>
 
 	* lib/Makefile.am (libdpkg_a_SOURCES): Add 'dpkg-test.h'.

debian/changelog

@@ -107,6 +107,8 @@ dpkg (1.15.0) UNRELEASED; urgency=low
   * Optimize dpkg-shlibdeps by caching parsed symbols files and
     objdump objects. Thanks to Modestas Vainius <modestas@vainius.eu> for the
     patch. Closes: #503954
+  * Add new framework to hook vendor-specific logic (see
+    module Dpkg::Vendor::Default).
 
   [ Pierre Habouzit ]
   * Add a --query option to update-alternatives. Closes: #336091, #441904

scripts/Dpkg/Vendor.pm

@@ -1,4 +1,4 @@
-# Copyright © 2008 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2008-2009 Raphaël Hertzog <hertzog@debian.org>
 
 # 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
@@ -25,7 +25,8 @@ use Dpkg::Cdata;
 
 use Exporter;
 our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(get_vendor_info get_current_vendor get_vendor_file);
+our @EXPORT_OK = qw(get_vendor_info get_current_vendor get_vendor_file
+                    get_vendor_object run_vendor_hook);
 
 =head1 NAME
 
@@ -75,7 +76,7 @@ name.
 sub get_vendor_file(;$) {
     my $vendor = shift || "default";
     my $file;
-    foreach my $name ($vendor, lc($vendor), ucfirst($vendor)) {
+    foreach my $name ($vendor, lc($vendor), ucfirst($vendor), ucfirst(lc($vendor))) {
         $file = "/etc/dpkg/origins/$name" if -e "/etc/dpkg/origins/$name";
     }
     return $file;
@@ -99,4 +100,42 @@ sub get_current_vendor() {
     return undef;
 }
 
+=item $object = Dpkg::Vendor::get_vendor_object($name)
+
+Return the Dpkg::Vendor::* object of the corresponding vendor.
+If $name is omitted, return the object of the current vendor.
+If no vendor can be identified, then return the Dpkg::Vendor::Default
+object.
+
+=cut
+my %OBJECT_CACHE;
+sub get_vendor_object {
+    my $vendor = shift || get_current_vendor() || "Default";
+    return $OBJECT_CACHE{$vendor} if exists $OBJECT_CACHE{$vendor};
+
+    my ($obj, @names);
+    if ($vendor ne "Default") {
+        push @names, $vendor, lc($vendor), ucfirst($vendor), ucfirst(lc($vendor));
+    }
+    foreach my $name (@names, "Default") {
+        eval qq{
+            require Dpkg::Vendor::$name;
+            \$obj = Dpkg::Vendor::$name->new();
+        };
+        last unless $@;
+    }
+    $OBJECT_CACHE{$vendor} = $obj;
+    return $obj;
+}
+
+=item Dpkg::Vendor::run_vendor_hook($hookid, @params)
+
+Run a hook implemented by the current vendor object.
+
+=cut
+sub run_vendor_hook {
+    my $vendor_obj = get_vendor_object();
+    $vendor_obj->run_hook(@_);
+}
+
 1;

scripts/Dpkg/Vendor/Debian.pm

@@ -0,0 +1,37 @@
+# Copyright © 2009 Raphaël Hertzog <hertzog@debian.org>
+
+# 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; either version 2 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package Dpkg::Vendor::Debian;
+
+use strict;
+use warnings;
+
+use Dpkg::Vendor::Default;
+
+our @ISA = qw(Dpkg::Vendor::Default);
+
+=head1 NAME
+
+Dpkg::Vendor::Debian - Debian vendor object
+
+=head1 DESCRIPTION
+
+This object is empty. It inherits everything from
+Dpkg::Vendor::Default.
+
+=cut
+
+1;

scripts/Dpkg/Vendor/Default.pm

@@ -0,0 +1,97 @@
+# Copyright © 2009 Raphaël Hertzog <hertzog@debian.org>
+
+# 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; either version 2 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package Dpkg::Vendor::Default;
+
+use strict;
+use warnings;
+
+# If you use this file as template to create a new vendor object, please
+# uncomment the following lines
+#use Dpkg::Vendor::Default;
+#our @ISA = qw(Dpkg::Vendor::Default);
+
+=head1 NAME
+
+Dpkg::Vendor::Default - default vendor object
+
+=head1 DESCRIPTION
+
+A vendor object is used to provide vendor specific behaviour
+in various places. This is the default object used in case
+there's none for the current vendor or in case the vendor could
+not be identified (see Dpkg::Vendor documentation).
+
+It provides some hooks that are called by various dpkg-* tools.
+If you need a new hook, please file a bug against dpkg-dev and explain
+your need. Note that the hook API has no guaranty to be stable over an
+extended period. If you run an important distribution that makes use
+of vendor hooks, you'd better submit them for integration so that
+we avoid breaking your code.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $vendor_obj = Dpkg::Vendor::Default->new()
+
+Creates the default vendor object. Can be inherited by all vendor objects
+if they don't need any specific initialization at object creation time.
+
+=cut
+sub new {
+    my ($this) = @_;
+    my $class = ref($this) || $this;
+    my $self = {};
+    bless $self, $class;
+    return $self;
+}
+
+=item $vendor_obj->run_hook($id, @params)
+
+Run the corresponding hook. The parameters are hook-specific. The
+supported hooks are:
+
+=over 8
+
+=item before-source-build ($srcpkg)
+
+The first parameter is a Dpkg::Source::Package object. The hook is called
+just before the execution of $srcpkg->build().
+
+=item before-changes-creation ($fields)
+
+The hook is called just before the content of .changes file is output
+by dpkg-genchanges. The first parameter is a Dpkg::Fields::Object
+representing all the fields that are going to be output.
+
+=back
+
+=cut
+sub run_hook {
+    my ($self, $hook, @params) = @_;
+
+    if ($hook eq "before-source-build") {
+        my $srcpkg = shift @params;
+    } elsif ($hook eq "before-changes-creation") {
+        my $fields = shift @params;
+    }
+}
+
+=back
+
+=cut
+1;

scripts/Makefile.am

@@ -120,6 +120,8 @@ nobase_dist_perllib_DATA = \
 	Dpkg/Substvars.pm \
 	Dpkg/Vars.pm \
 	Dpkg/Vendor.pm \
+	Dpkg/Vendor/Debian.pm \
+	Dpkg/Vendor/Default.pm \
 	Dpkg/Version.pm \
 	Dpkg.pm
 

scripts/dpkg-genchanges.pl

@@ -19,6 +19,7 @@ use Dpkg::Substvars;
 use Dpkg::Vars;
 use Dpkg::Changelog qw(parse_changelog);
 use Dpkg::Version qw(parseversion compare_versions);
+use Dpkg::Vendor qw(run_vendor_hook);
 
 textdomain("dpkg-dev");
 
@@ -535,5 +536,6 @@ for my $f (keys %remove) {
 }
 
 tied(%{$fields})->set_field_importance(@changes_fields);
+run_vendor_hook('before-changes-creation', $fields);
 tied(%{$fields})->output(\*STDOUT); # Note: no substitution of variables
 

scripts/dpkg-source.pl

@@ -18,6 +18,7 @@ use Dpkg::Vars;
 use Dpkg::Changelog qw(parse_changelog);
 use Dpkg::Source::Compressor;
 use Dpkg::Source::Package;
+use Dpkg::Vendor qw(run_vendor_hook);
 
 use English;
 use File::Spec;
@@ -277,6 +278,7 @@ if ($options{'opmode'} eq 'build') {
     $srcpkg->init_options();
     $srcpkg->parse_cmdline_options(@cmdline_options);
 
+    run_vendor_hook("before-source-build", $srcpkg);
     # Build the files (.tar.gz, .diff.gz, etc)
     $srcpkg->build($dir);