scripts/dpkg-vendor.pl

   1 #!/usr/bin/perl
   2 #
   3 # dpkg-vendor
   4 #
   5 # Copyright © 2009 Raphaël Hertzog <hertzog@debian.org>
   6 # Copyright © 2009,2012 Guillem Jover <guillem@debian.org>
   7 #
   8 # This program is free software; you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 2 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  20
  21 use strict;
  22 use warnings;
  23
  24 use Dpkg ();
  25 use Dpkg::Gettext;
  26 use Dpkg::ErrorHandling;
  27 use Dpkg::Vendor qw(get_vendor_dir get_vendor_info get_current_vendor);
  28
  29 textdomain('dpkg-dev');
  30
  31 sub version {
  32     printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION;
  33
  34     printf g_('
  35 This is free software; see the GNU General Public License version 2 or
  36 later for copying conditions. There is NO warranty.
  37 ');
  38 }
  39
  40 sub usage {
  41     printf g_(
  42 'Usage: %s [<option>...] [<command>]')
  43     . "\n\n" . g_(
  44 'Commands:
  45   --is <vendor>           returns true if current vendor is <vendor>.
  46   --derives-from <vendor> returns true if current vendor derives from <vendor>.
  47   --query <field>         print the content of the vendor-specific field.
  48   --help                  show this help message.
  49   --version               show the version.')
  50     . "\n\n" . g_(
  51 'Options:
  52   --vendor <vendor>       assume <vendor> is the current vendor.')
  53     . "\n", $Dpkg::PROGNAME;
  54 }
  55
  56 my ($vendor, $param, $action);
  57
  58 while (@ARGV) {
  59     $_ = shift(@ARGV);
  60     if (m/^--vendor$/) {
  61         $vendor = shift(@ARGV);
  62         usageerr(g_('%s needs a parameter'), $_) unless defined $vendor;
  63     } elsif (m/^--(is|derives-from|query)$/) {
  64         usageerr(g_('two commands specified: --%s and --%s'), $1, $action)
  65             if defined($action);
  66         $action = $1;
  67         $param = shift(@ARGV);
  68         usageerr(g_('%s needs a parameter'), $_) unless defined $param;
  69     } elsif (m/^-(?:\?|-help)$/) {
  70         usage();
  71         exit 0;
  72     } elsif (m/^--version$/) {
  73         version();
  74         exit 0;
  75     } else {
  76         usageerr(g_("unknown option '%s'"), $_);
  77     }
  78 }
  79
  80 usageerr(g_('need an action option')) unless defined($action);
  81
  82 # Uses $ENV{DEB_VENDOR} if set
  83 $vendor //= get_current_vendor();
  84
  85 my $info = get_vendor_info($vendor);
  86 unless (defined($info)) {
  87     error(g_("vendor %s doesn't exist in %s"), $vendor || 'default',
  88           get_vendor_dir());
  89 }
  90
  91 if ($action eq 'is') {
  92     exit(0) if lc($param) eq lc($info->{'Vendor'});
  93     exit(1);
  94 } elsif ($action eq 'derives-from') {
  95     exit(0) if lc($param) eq lc($info->{'Vendor'});
  96     while (defined($info) && exists $info->{'Parent'}) {
  97         $info = get_vendor_info($info->{'Parent'});
  98         exit(0) if lc($param) eq lc($info->{'Vendor'});
  99     }
 100     exit(1);
 101 } elsif ($action eq 'query') {
 102     if (exists $info->{$param}) {
 103         print $info->{$param} . "\n";
 104         exit(0);
 105     } else {
 106         exit(1);
 107     }
 108 }