Index: third_party/dpkg-dev/scripts/Dpkg/Vendor.pm |
diff --git a/third_party/dpkg-dev/scripts/Dpkg/Vendor.pm b/third_party/dpkg-dev/scripts/Dpkg/Vendor.pm |
new file mode 100644 |
index 0000000000000000000000000000000000000000..96d09764df4f82aea5638b68d06488383dc4f6ab |
--- /dev/null |
+++ b/third_party/dpkg-dev/scripts/Dpkg/Vendor.pm |
@@ -0,0 +1,182 @@ |
+# 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 |
+# 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, see <https://www.gnu.org/licenses/>. |
+ |
+package Dpkg::Vendor; |
+ |
+use strict; |
+use warnings; |
+ |
+our $VERSION = '1.01'; |
+ |
+use Dpkg (); |
+use Dpkg::ErrorHandling; |
+use Dpkg::Gettext; |
+use Dpkg::BuildEnv; |
+use Dpkg::Control::HashCore; |
+ |
+use Exporter qw(import); |
+our @EXPORT_OK = qw(get_vendor_info get_current_vendor get_vendor_file |
+ get_vendor_dir get_vendor_object run_vendor_hook); |
+ |
+my $origins = "$Dpkg::CONFDIR/origins"; |
+$origins = $ENV{DPKG_ORIGINS_DIR} if $ENV{DPKG_ORIGINS_DIR}; |
+ |
+=encoding utf8 |
+ |
+=head1 NAME |
+ |
+Dpkg::Vendor - get access to some vendor specific information |
+ |
+=head1 DESCRIPTION |
+ |
+The files in $Dpkg::CONFDIR/origins/ can provide information about various |
+vendors who are providing Debian packages. Currently those files look like |
+this: |
+ |
+ Vendor: Debian |
+ Vendor-URL: http://www.debian.org/ |
+ Bugs: debbugs://bugs.debian.org |
+ |
+If the vendor derives from another vendor, the file should document |
+the relationship by listing the base distribution in the Parent field: |
+ |
+ Parent: Debian |
+ |
+The file should be named according to the vendor name. |
+ |
+=head1 FUNCTIONS |
+ |
+=over 4 |
+ |
+=item $dir = Dpkg::Vendor::get_vendor_dir() |
+ |
+Returns the current dpkg origins directory name, where the vendor files |
+are stored. |
+ |
+=cut |
+ |
+sub get_vendor_dir { |
+ return $origins; |
+} |
+ |
+=item $fields = Dpkg::Vendor::get_vendor_info($name) |
+ |
+Returns a Dpkg::Control object with the information parsed from the |
+corresponding vendor file in $Dpkg::CONFDIR/origins/. If $name is omitted, |
+it will use $Dpkg::CONFDIR/origins/default which is supposed to be a symlink |
+to the vendor of the currently installed operating system. Returns undef |
+if there's no file for the given vendor. |
+ |
+=cut |
+ |
+sub get_vendor_info(;$) { |
+ my $vendor = shift || 'default'; |
+ my $file = get_vendor_file($vendor); |
+ return unless $file; |
+ my $fields = Dpkg::Control::HashCore->new(); |
+ $fields->load($file) or error(_g('%s is empty'), $file); |
+ return $fields; |
+} |
+ |
+=item $name = Dpkg::Vendor::get_vendor_file($name) |
+ |
+Check if there's a file for the given vendor and returns its |
+name. |
+ |
+=cut |
+ |
+sub get_vendor_file(;$) { |
+ my $vendor = shift || 'default'; |
+ my $file; |
+ my @tries = ($vendor, lc($vendor), ucfirst($vendor), ucfirst(lc($vendor))); |
+ if ($vendor =~ s/\s+/-/) { |
+ push @tries, $vendor, lc($vendor), ucfirst($vendor), ucfirst(lc($vendor)); |
+ } |
+ foreach my $name (@tries) { |
+ $file = "$origins/$name" if -e "$origins/$name"; |
+ } |
+ return $file; |
+} |
+ |
+=item $name = Dpkg::Vendor::get_current_vendor() |
+ |
+Returns the name of the current vendor. If DEB_VENDOR is set, it uses |
+that first, otherwise it falls back to parsing $Dpkg::CONFDIR/origins/default. |
+If that file doesn't exist, it returns undef. |
+ |
+=cut |
+ |
+sub get_current_vendor() { |
+ my $f; |
+ if (Dpkg::BuildEnv::has('DEB_VENDOR')) { |
+ $f = get_vendor_info(Dpkg::BuildEnv::get('DEB_VENDOR')); |
+ return $f->{'Vendor'} if defined $f; |
+ } |
+ $f = get_vendor_info(); |
+ return $f->{'Vendor'} if defined $f; |
+ return; |
+} |
+ |
+=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(@_); |
+} |
+ |
+=back |
+ |
+=head1 CHANGES |
+ |
+=head2 Version 1.01 |
+ |
+New function: get_vendor_dir(). |
+ |
+=cut |
+ |
+1; |