#!/usr/bin/perl -w
# debbuild script
# Shamelessly steals interface from rpm's "rpmbuild" to create
# Debian packages.  Please note that such packages are highly
# unlikely to conform to "Debian Policy".
#
# Copyright (C) 2005-2015 Kris Deugau <kdeugau@deepnet.cx>
# Copyright (C) 2015-2019 Andreas Scherer <https://ascherer.github.io/>
# Copyright (C) 2015-2019 Neal Gompa <ngompa13@gmail.com>
# Copyright (C) 2017-2019 Datto, Inc. <https://datto.com>
# Copyright (C) 2020-2021 Victor Zhestkov <vzhestkov@suse.com>
#
#    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 St, Fifth Floor, Boston, MA  02110-1301  USA

use strict;
use warnings;

use Cwd qw(abs_path);	# for finding where files really are
use Fcntl;		# for sysopen flags
use File::Basename;
use Getopt::Long qw(:config no_ignore_case bundling);
use Getopt::Std;
use IPC::Open2;
use Locale::gettext;
use POSIX;		# for setlocale()
use Pod::Usage;
use Text::Balanced qw(extract_bracketed extract_multiple);

# Switch on i18n and t10n.
setlocale(LC_MESSAGES, "");
bindtextdomain("debbuild", '/usr/share/locale');
textdomain("debbuild");

sub _ { return gettext(shift) }

# Behavioural compatibility FTW!  Yes, rpmbuild does this too.
die _("No .spec file to work with!  Exiting.\n") unless @ARGV;

# Initialized globals
my $NoAutoReq = 0;
my %cmdopts = (type => '',
		stage => 'a',
		short => undef);
my %defattr = (filemode => '-',
		owner => '-',
		group => '-',
		dirmode => '-');

my %static_config = load_static_config();

# Scriptlets
my %script = (prep => '',
		build => '',
		install => '',
		check => '',
		clean => qq([ "\$RPM_BUILD_ROOT" != "/" ] && %{__rm} -rf \$RPM_BUILD_ROOT\n) );
my $check_status = "\nSTATUS=\$?\nif [ \$STATUS -ne 0 ]; then\n  exit \$STATUS\nfi\n";

my $finalmessages = ''; # A place to stuff messages that I want printed at the *very* end of any processing.

# For %define's in specfile, among many other things.
my %specglobals = (vendor => 'debbuild'); # this can be changed by the Vendor: header in the spec file
my %macroopts; # For macro options
my @macropsstk = ();
# Ah, the joys of multiple architectures.  :(  Feh.
# Compiler options will be loaded from 'debrc' file(s).
my %optflags = (all => '');

# Package data
# This is the form of $pkgdata{pkgname}{meta}
# meta includes Summary, Name, Version, Release, Group, Copyright,
#	Source, URL, Packager, BuildRoot, Description, BuildRequires,
#	Requires, Provides
# 10/31/2005 Maybe this should be flatter?  -kgd
my %pkgdata = (main => {source => ''});
my @pkglist = ('main');	#sigh
# Files listing.  Embedding this in %pkgdata would be, um, messy.
my %doclist;
my @buildrequires;
my @buildconflicts;

# "Constants"
my %targets = (p => 'Prep',
		c => 'Compile',
		i => 'Install',
		l => 'Verify %files',
		a => 'Build binary and source',
		b => 'Build binary',
		s => 'Build source');

# Global file handle for multiline macro definitions
my $fh;

# Store filelist files from "%files -f <filename>"
my %files_files=();

my $debug_level = 0;

my $lua_present;
my $lua_ver;

$lua_present = eval {
    require Lua::API;
    $lua_ver = lua_get('Lua::API::RELEASE');
    1;
};
$lua_present //= 0;

my $gL;
my @lstk = ();

#### main ####

# Program flow:
# -> Parse/execute "system" config/macros (if any - should be rare)
# -> Parse/execute "user" config/macros (if any - *my* requirement is %_topdir)
# -> Parse command line for options, spec file/tarball/.src.deb (NB - also accept .src.rpm)

load_config();
config_debrc();
lsb_detection();
parse_cmd();

my $build_shell = expandmacros('%{___build_shell}');

print version() if defined $specglobals{verbose};
$specglobals{_debbuild} = $static_config{version};
$specglobals{_debbuild_lua} = $lua_ver if defined($lua_ver);
print "Lua: ".($lua_present ? $lua_ver : 'No Lua module loaded')."\n"
      if $specglobals{verbose};

if ($cmdopts{type} eq 's') {
  install_sdeb($specglobals{srcpkg});
  goto FINAL;
}

# output stage of --showpkgs
if ($cmdopts{type} eq 'd') {
  parse_spec($specglobals{specfile});
  foreach my $pkg (@pkglist) {
    $finalmessages .= format_debfile($pkg)."\n" if $pkgdata{$pkg}{files};
  }
  # Source package
  $finalmessages .= format_sdebfile()."\n";
  goto FINAL;
}

# Stick --rebuild handling in here - basically install_sdeb()
# followed by tweaking options to run with -ba
# --recompile is the same, except it reconfigures -bi
if ($cmdopts{type} eq 'r') {
  my $specfile;
  if ($specglobals{srcpkg} =~ /\.src\.rpm$/) {
    ($specfile) = grep { /\.spec/ } qx ( $specglobals{__rpm} -qlp $specglobals{srcpkg} );
    qx ( $specglobals{__rpm} -i $specglobals{srcpkg} );
  } elsif ($specglobals{srcpkg} =~ /\.sdeb$/) {
    install_sdeb($specglobals{srcpkg});
    $specfile = basename( qx ( $specglobals{__pax} -f $specglobals{srcpkg} *.spec ) );
  } else {
    die _('Can\'t --rebuild with ').$specglobals{srcpkg}."\n";
  }
  chomp( $specglobals{_specfile} = $specglobals{specfile} = expandmacros("%{_specdir}/$specfile") );
  $cmdopts{type} = 'b'; # fall through
}

if ($cmdopts{type} eq 't') {
  # Need to inspect the tarball to find the spec file.
  # Note that rpmbuild doesn't seem to support this operation from a
  # .zip file properly, but we try our best.
  die _("No tarfile specified!  Exiting.\n")
    unless defined $specglobals{tarball};
  my $tarball = $specglobals{tarball};
  my $cmdline = expandmacros(lookup_specfile($tarball));
  chomp( $specglobals{_specfile} = $specglobals{specfile} = expandmacros("%{_specdir}/").
    basename( qx { $cmdline } ) );

  $tarball = abs_path($tarball);
  system expandmacros(extract_specfile($tarball));

  $cmdopts{type} = 'b'; # fall through
}

if ($cmdopts{type} eq 'b') {
  # Make a copy of spec lowercased and `_` replaced with `-` to do some magic
  (my $spec_lc = lc(basename($specglobals{specfile}))) =~ tr/_/-/;
  $spec_lc = dirname($specglobals{specfile})."/".$spec_lc;
  qx ( $specglobals{__cp} -a $specglobals{specfile} $spec_lc ) if ( $specglobals{specfile} ne $spec_lc );
  # Need to read the spec file to find the tarball.  Note that
  # this also generates most of the shell script required.
  parse_spec($specglobals{specfile});
  die _('Can\'t build ').$pkgdata{main}{name}.
      _(":  build requirements not met.\n")
      unless $cmdopts{nodeps} or checkbuildreq();
  exit 0 if $cmdopts{nobuild};

  # Expand macros as necessary.
  $specglobals{buildroot} = $cmdopts{buildroot} if defined $cmdopts{buildroot};
  $specglobals{buildroot} = expandmacros($specglobals{buildroot});
}

# work out the [pcilabs] stages
if ($cmdopts{stage} eq 'p' or ($cmdopts{stage} =~ /[cilab]/ and not $cmdopts{short})) {
  execute_script('prep');
}
if ($cmdopts{stage} eq 'c' or ($cmdopts{stage} =~ /[ilab]/ and not $cmdopts{short})) {
  execute_script('build');
}
if ($cmdopts{stage} =~ /[ilab]/) {
  install();
}
if ($cmdopts{stage} =~ /[as]/) {
  srcpackage();
}
if ($cmdopts{stage} =~ /[ab]/) {
  binpackage();
  execute_script('clean');
}

# Spit out any closing remarks
FINAL: print expandmacros($finalmessages) if defined $specglobals{verbose};

# Just in case.
exit 0;

#### end main ####

sub vdebug {
  my ($msg, $dl, $tag) = @_;
  print(STDERR "DEBUG".(defined($tag) ? "[".$tag."]" : "").": ".$msg."\n")
    if $debug_level && ((not defined($dl)) || $debug_level >= $dl);
}

## load_static_config()
# Load build-time configuration for debbuild itself.
# The Makefile stores this configuration as a debrc-format
# file in the __DATA__ section of this file to avoid relying
# on external file paths.
#
# Values are given defaults so that debbuild still runs without
# having to be passed through the Makefile.
#
# If multiple entries exist for a name, the last is used.
sub load_static_config {
  my %static_config_arrays = read_debrc_from_handle(*DATA);

  my %static_config = (
    version => '0.0',
    debconfigdir => '/usr/lib/debbuild',
    sysconfdir => '/etc'
  );

  while (my ($name, $values) = each(%static_config_arrays)) {
    $static_config{$name} = $values->[-1] if defined($values);
  }

  return %static_config;
}


sub read_multiline {
  my ($value, $fh) = @_;
  my $is_sub = ref($fh) eq 'CODE';
  if ($value =~ /\\\n\z/) { # multi-line macro
    while (my $l = $is_sub ? &$fh() : <$fh>) {
      $value .= $l;
      last unless $l =~ /\\\n\z/s;
    }
    # multiline macros workaround.
    $value =~ s/\s?\\\n/\n/g;
    $value =~ s/\\\\\n/\\\n/g;
    $value =~ s/\\"/"/g;
    $value =~ s/\n\z//;
  }
  if ($value =~ s/%\{lua:\s*$/\{lua:\n/) { # multi-line LUA macro
    while (my $l = $is_sub ? &$fh() : <$fh>) {
      $value .= $l;
      my $t = $value;
      last if extract_bracketed($t, '{}');
    }
    $value =~ s/\n\z//;
    $value = '%'.$value;
  }
  $value =~ s/\\\\/\\/g if $value =~ /\A%\{lua:/;
  return $value;
}


## load_config()
# Load system macros similar to RPM which digests
# /usr/lib/rpm/macros /usr/lib/rpm/redhat/macros /etc/rpm/macros
# and user configuration (if any) ~/.rpmmacros a.k.a. ~/.debmacros
sub load_config {
  # Load user configuration, permitting local override
  my $homedir = $ENV{HOME} // $ENV{LOGDIR} // (getpwuid($<))[7];
  vdebug("Loading ...", 3, "load_config");
  my @cfgs = ("$static_config{debconfigdir}/macros",
              glob("$static_config{debconfigdir}/macros.d/macros.*"),
              "$static_config{sysconfdir}/rpm/macros",
              glob("$static_config{sysconfdir}/rpm/macros.*"),
              "$static_config{sysconfdir}/debbuild/macros",
              glob("$static_config{sysconfdir}/debbuild/macros.*"),
              "$homedir/.rpmmacros",
              "$homedir/.debmacros");
  my %cfl = ();
  my %ercd = ();
  while ( my $macros = shift @cfgs ) {
    next if $cfl{$macros} and not ( $macros eq "$homedir/.debmacros" or $macros eq "$homedir/.rpmmacros" );
    open my $MACROS,$macros or next; # should we warn about missing macro files?
    vdebug("Loading $macros ...", 3, "load_config");
    while (<$MACROS>) {
      next unless my ($macro,$eq,$value) = /^%(\w+(?:\([^)]*\))?)(=|\s*)(.+)$/s;
      $value = read_multiline($value, $MACROS);
      chomp($value);
      vdebug("($macros): $macro = $value", 5, "load_config");
      store_value('define', $macro, $eq eq '=' ? $specglobals{$value} : $value);
      if ( $macro eq '_rpmconfigdir' and not $ercd{$macros} ) {
        $ercd{$macros} = 1;
        unshift @cfgs, expandmacros($value)."/macros",
                       glob(expandmacros($value)."/macros.d/macros.*");
        push @cfgs, "$homedir/.rpmmacros", "$homedir/.debmacros"
           if $macros eq "$homedir/.debmacros" or $macros eq "$homedir/.rpmmacros";
      }
    }
    $cfl{$macros} = 1;
    close $MACROS;
  }
} # end load_config()


## config_debrc()
# Load default configuration similar to RPM which digests global configuration
# /usr/lib/rpm/rpmrc, per-system configuration /etc/rpmrc and per-user
# configuration ~/.rpmrc. ATTOW, only 'optflags' are loaded.
sub config_debrc {
  # Load default configuration, permitting local override
  my $homedir = $ENV{HOME} // $ENV{LOGDIR} // (getpwuid($<))[7];
  foreach my $macros ( ("$static_config{debconfigdir}/debrc",
                        "$static_config{sysconfdir}/debrc",
                        "$homedir/.debrc") ) {
    open(my $macros_handle, $macros) or next; # should we warn about missing macro files?
    my %entries = read_debrc_from_handle($macros_handle);

    if (exists $entries{optflags}) {
      foreach my $optflags_entry (@{$entries{optflags}}) {
        next unless $optflags_entry =~ /^\s+(\w+)\s+(.+)$/;
        my ($flag,$value) = ($1,$2);
        $optflags{$flag} = $value;
      }
    }
    close $macros_handle;
  }
} # end config_debrc()

## read_debrc_from_handle()
# Take a filehandle of a debrc-format file and parse entries out of it
# Returns a hash of arrayrefs of entries. Keys are the lowercased names of
# entries (to normalize them). Values are arrayrefs of entries since multiple
# entries may have the same name. Order from the original lines of the file
# is preserved. Ignores lines it doesn't understand
sub read_debrc_from_handle {
  my ($debrc_fh) = shift;

  my %entries;

  while(my $line = <$debrc_fh>) {
    chomp($line);
    next unless $line =~ /^(\w+):(.+)$/;
    my $name = lc($1); # Names are case-insensitive; normalize by lowercasing
    my $value = $2;

    $entries{$name} = [] unless exists $entries{$name};
    push(@{$entries{$name}}, $value);
  }

  return %entries;
}
# end read_debrc_from_handle()

## lsb_detection()
# Setup for OS detection
sub lsb_detection {
  my ($basever, $baseos, $basecodename);

  # Funny thing how files like this have become useful...
  # Check for /etc/os-release.  If that doesn't exist, try calling lsb_release.
  # If neither exist, then die, as we don't really care anymore...
  if (open OSREL, '/etc/os-release') {
    # Look for ID, VERSION_ID, and VERSION_CODENAME lines.
    while (<OSREL>) {
      $baseos = lc $1 if /^ID="?(\w+)"?/;
      $basever = $1 if /^VERSION_ID="?([\d.]+)"?/;
      $basecodename =  $1 if ( /^(?:VERSION|UBUNTU)_CODENAME="?(\w+)"?/ );
    }
    close OSREL;

  } elsif (open LSBREL, '-|', $specglobals{__lsb_release}, '-s', '-i', '-r', '-c') {
    # Retrive dist name, version, and codename from lsb_release
    chomp( $baseos = lc <LSBREL> );
    chomp( $basever = <LSBREL> );
    chomp( $basecodename = <LSBREL> );
    close LSBREL

  } else {
    die _("No 'os-release' file or 'lsb_release' program found.\n").
        _("Sorry, I quit.\n");
  }

  # if our OS does not have a version, set it to some "unreleased" value
  $basever //= "9999";

  # rpmbuild expects either integers or strings, and some distros (*cough*Ubuntu*cough*)
  # have versions that get interpreted as strings, which creates comparison problems.
  # This will make sure it's an integer to remain compatible.
  (my $specbasever = $basever) =~ s/\.//;

  # Set some legacy globals & the standard generic OS-class globals;
  $specglobals{debdist} = $basecodename;
  $specglobals{debver} = $specbasever;
  # the OS-class globals shall be overridable from .debmacros, so only set them if they are not yet
  $specglobals{$baseos} //= $specbasever;
  # if the basever does not have a sub-version, it needs to be multiplied by 100
  $specglobals{$baseos.'_version'} //= $basever =~ /\./ || $basever eq "9999" ? $specbasever : $basever * 100;

  # Default %{dist} to something marginally sane.  Note this should be overrideable by --define.
  # This has been chosen to most closely follow the usage in RHEL/CentOS and Fedora, ie "el5" or "fc20".
  $specglobals{dist} = $baseos.$basever;
} # end lsb_detection()


## parse_cmd()
# Parses command line into global hash %cmdopts, other globals
# Options based on rpmbuild's options
sub parse_cmd {
  # Set default verbosity; may be overridden with -q and -v(v).
  $specglobals{verbose} //= expandmacros('%{?_default_verbosity}'.
    '%{!?_default_verbosity:0}');
  $specglobals{verbose} = undef unless 0 < $specglobals{verbose};

  # Don't feel like coding my own option parser...
  Getopt::Long::GetOptions(
    'buildroot=s'   => \$cmdopts{buildroot},
    'eval|E=s'      => sub { print expandmacros($_[1])."\n" },
    'short-circuit' => \$cmdopts{short},
    'showpkgs'      => sub { $cmdopts{type} = 'd' },
    'showrc'        => \&dump_macros,
    'debug'         => \$cmdopts{debug},
    'sign'          => \$cmdopts{sign},
    'nodeps'        => \$cmdopts{nodeps},
    'noprep'        => \$cmdopts{noprep},
    'nobuild'       => \$cmdopts{nobuild},
    'nocheck'       => \$cmdopts{nocheck},
    'noclean'       => \$cmdopts{noclean},
    'verbose|v+'    => \$specglobals{verbose}, # bump verbosity.
    'quiet|q'       => sub { $specglobals{verbose} = undef }, # dump verbosity.
    'rebuild=s'     => \&srcpkg_handler,
    'recompile=s'   => \&srcpkg_handler,
    'install|i=s'   => \&srcpkg_handler,
    'b=s'           => \&build_handler, # do NOT use 'b|t=s' here!
    't=s'           => \&build_handler, # see 'build_handler' for details
    'r=s'           => \&build_handler,
    'with=s'        => \&define_handler, # dito for 'with|without=s'
    'without=s'     => \&define_handler,
    'define|D=s'    => \&define_handler,
    'scm|S=s'       => sub { define_handler('define',"__scm $_[1]") },
    'help|?'        => \&help_handler,
    'version'       => sub { print version() },
    '<>'            => \&catchall # process non-option arguments
  ); # Getopt::Long::Getoptions()
  ## catchall()
  # --buildroot, --define|-D, --rebuild, --recompile, and --install|-i are the
  # only options that take an argument.  Therefore, any *other* bare arguments
  # are the spec file or the tarball we're operating on - depending on which
  # one we meet.
  sub catchall {
    my $opt_arg = shift;
    if ($cmdopts{type} eq 'b' or $cmdopts{type} eq 'd') {
      # Spec file
      $specglobals{_specfile} = $specglobals{specfile} = $opt_arg;
    } elsif ($cmdopts{type} eq 't') {
      # Tarball build.  Need to extract tarball to find spec file.  Whee.
      $specglobals{tarball} = $opt_arg;
    } else {
      # Source package
      $specglobals{srcpkg} = $opt_arg;
    }
  }
  ## srcpkg_handler()
  # prepare $specglobals{srcpkg} in dependence of the calling option
  sub srcpkg_handler {
    (my $opt_name, $specglobals{srcpkg}) = @_;
    $cmdopts{type} = 'r';
    if ($opt_name eq 'rebuild') {
      $cmdopts{stage} = 'b';
    } elsif ($opt_name eq 'recompile') {
      $cmdopts{stage} = 'i';
    } else { # $opt_name eq 'install'?!
      $cmdopts{type} = 's';
    }
  }
  ## build_handler()
  # You can't use 'b|t=s' in Getopt::Long::GetOptions(), because 't' will be
  # treated as an 'alias' to the 'primary' option 'b' and will NOT receive its
  # own $opt_name.  We have to factor-out the handler and use _two_ options.
  sub build_handler {
    my ($opt_name, $opt_value) = @_;
    die _('Unknown stage ').$opt_value.
        _(' for option \'-').$opt_name."'.\n"
      unless grep { $opt_value eq $_ } keys %targets;
    if ($cmdopts{type} eq 'r') {
      # Mutually exclusive options.
      die _('Can\'t use -').$opt_name.$opt_value.
          _(" with --rebuild\n");
    } else {
      ($cmdopts{type},$cmdopts{stage}) = ($opt_name,$opt_value);
    }
  }
  ## define_handler()
  sub define_handler {
    my ($opt_name, $opt_value) = @_;
    if ($opt_name =~ /with/) {
      # create 'configure' options from '--with <flag>' and '--without <flag>':
      # 'with/without <flag>' are 'aliases' for 'define _with_<flag>'.
      $opt_value = "\_$opt_name\_$opt_value --$opt_name-$opt_value";
      $opt_name = 'define'; # fall through with generic name
    }
    my ($macro,$value) = $opt_value =~ m/(\S+)(?:\s+(.+))?/i;
    if (defined $value) {
      store_value($opt_name,$macro,$value);
    } else {
      warn _('WARNING:  Missing value for macro ').$macro.
           _(' in ')."--$opt_name"._("!  Ignoring.\n");
    }
  }
  ## help_handler()
  sub help_handler {
    open(my $pipe, '|-', $ENV{PAGER} || 'less -e') or exit 1;
    pod2usage(-message => version(), -output => $pipe,
      -verbose => 99, -sections => "COPYRIGHT|SHORT DESCRIPTION|OPTIONS");
    close $pipe;
    exit 0;
  }
  ## version()
  sub version {
    return _('This is debbuild, version ').$static_config{version}."\n";
  }
  ## dump_macros()
  sub dump_macros {
    print join "\n", map { "%$_ ==> $specglobals{$_}" } sort keys %specglobals;
  }

  # Some cross-checks.  rpmbuild limits --short-circuit to just
  # the "compile" and "install" targets - with good reason IMO.
  # Note that --short-circuit with -.p is not really an error, just redundant.
  # NB - this is NOT fatal, just ignored!
  if ($cmdopts{short} and $cmdopts{stage} =~ /[labs]/) {
    warn _('Can\'t use --short-circuit for ').$targets{$cmdopts{stage}}.
         _(" stage.  Ignoring.\n");
    $cmdopts{short} = undef;
  }

  # Did we catch an action option?
  # rpmbuild quits silently.
  exit 0 unless $cmdopts{type};
} # end parse_cmd()


## parse_spec()
# Parse the .spec file. This is a single loop, where we scan for '%commands'
# and '%{macros}'. The latter are usually treated in 'expandmacros()', with
# a little overlap here and there.
sub parse_spec {
  my ($specfile, $stage, $subname, $scriptlet) = @_;
  $stage //= 'preamble';
  $subname //= 'main';
  $pkgdata{main}{arch} //= expandmacros('%{_arch}');

  die _("No .spec file specified!  Exiting.\n") unless $specfile;
  open $fh, $specfile or die _('specfile (').$specfile.
    _(') barfed:  ')."$!\n";

  my @ifexpr = (); # Nested %if..%else..%endif conditionals

# Basic algorithm:
# For each line
#   if it's a member of an %if construct, branch and see which segment of the
#	spec file we need to parse and which one gets discarded, then
#	short-circuit back to the top of the loop.
#   if it's a %section, bump the stage.  Preparse addons to the %section line
#	(eg subpackage) and stuff them in suitable loop-global variables, then
#	short-circuit back to the top of the loop.
#   Otherwise, parse the line according to which section we're supposedly
#	parsing right now

  our @rbuf = ();
  sub spec_readline {
    if ( @rbuf ) {
      $_ = shift @rbuf;
      $_ .= "\n";
    } else {
      $_ = <$fh>;
    }
  }
LINE: while ( spec_readline() ) {
    next if /^\s*#/ and $stage =~ /\A(preamble|files)\z/; # Ignore comments...
    next if /^\s*$/ and $stage =~ /\A(preamble|files)\z/; # ... and blank lines.

    # need to deal with these someday
    next if /^%verify/;

# no sense in continuing if we find something we don't grok
    # Yes, this is really horribly fugly.  But it's a cheap crosscheck against invalid
    # %-tags which also make rpmbuild barf.  In theory.
# notes:  some of these are not *entirely* case-sensitive (%ifxxx), but most are.
    # Extracted from the Maximum RPM online doc via:
    # grep -h %[a-z] *|perl -e 'while (<>) { /%([a-z0-9]+)\b/; print "$1|\n"; }'|sort -u
    # First a set of %-tags that are required to be used flush-left:
    if ((/^%([a-z_]\w*)/ and not (grep { $1 eq $_ } qw(build changelog check
        clean config copyrightdata description files ghost install package
        post posttrans postun pre prep pretrans preun setup verify) or /patch\d*/))
        and # then a set of %-tags that are permitted in more liberal layouts:
        (/^\s*%([a-z_]\w*)/ and not grep { $1 eq $_ } qw(attr autopatch
        autosetup bcond_with bcond_without configure defattr define dir
        doc docdir dump else endif exclude global if ifarch ifnarch ifnos
        ifos include license make_build make_install makeinstall readme
        triggerin triggerpostun triggerun undefine verifyscript))) {
      if (defined $specglobals{$1}) {
        # This looks like a user-defined macro, possibly with arguments.
        # Wrap the whole thing in curly braces for easier processing.
        # And avoid removing trailing new line symbol.
        s/^\s*%(.+)\s*?(\n?)$/%{$1}$2/ if defined $macroopts{$1};
        my $e = expandmacros($_);
        $e =~ s/\s+\z//;
        my @a = split(/\n/, $e);
        if ( scalar(@a) > 1 ) {
          unshift(@rbuf, @a) if scalar(@a);
          next LINE;
        }
        $_ = shift(@a) or next LINE;
        $_ .= "\n";
      } else {
        die _('Unknown tag \'%').$1._('\' at line ').$..
            _(' of ').$specfile."\n";
      }
    }

    # RPM conditionals - transform to generic form
    if (s/^\s*%if(n|)(arch|os)\s+//) {
      my $expanded_conditional = lc(expandmacros($_));
      my @args = map { "'%{_$2}' ".($1 eq 'n' ? '!=' : '==')." '$_'" } split(/[\s,]+/, $expanded_conditional);
      $_ = '%if ' . join(($1 eq 'n' ? ' && ' : ' || '), @args);
    }

    # Generic %if..%else..%endif construct
    if (s/^\s*%if//) {
      chomp( my $expr = expandmacros($_) );

      if ($expr =~ /^[\d\s<=>&|\(\)+-]+$/) {
        # "plain" numeric expressions are evaluated as-is, except
        $expr =~ s/(\D)0(\d+)/$1$2/g; # shortcut 0%{?ubuntu} == 1204
      } else {
        # Done in this order so we don't cascade incorrectly.
        # Yes, those spaces ARE correct in the replacements!
        $expr =~ s/==/ eq /g;
        $expr =~ s/!=/ ne /g;
        $expr =~ s/<=>/ cmp /g;
        $expr =~ s/<=/ le /g;
        $expr =~ s/>=/ ge /g;
        $expr =~ s/</ lt /g;
        $expr =~ s/>/ gt /g;
      }

      # http://www.donath.org/Quotes/AllTruthIsOne/
      push @ifexpr, (eval $expr or 0);

      next LINE if $ifexpr[-1]; # This appears to be the only case we call false.
      my $iflevel = @ifexpr;
      while ( spec_readline() ) { # Skip %if-block, inluding nested %if..%else..%endif
        if (/^\s*%if/) {
          $iflevel++;
        } elsif (/^\s*%else/) {
          goto ELSE if $iflevel == @ifexpr;
        } elsif (/^\s*%endif/) {
          goto ENDIF if $iflevel == @ifexpr;
          $iflevel--;
        }
      }
      die _("Unmatched %if at end of file.  Missing %else/%endif.\n");
    }
ELSE: if (/^\s*%else/) {
      chomp;
      die _('Unmatched %else in line ').$_.
          _(".  Missing %if.\n") unless @ifexpr;
      next LINE unless $ifexpr[-1];
      my $iflevel = @ifexpr;
      while ( spec_readline() ) { # Skip %else-block, inluding nested %if..%else..%endif
        if (/^\s*%if/) {
          $iflevel++;
        } elsif (/^\s*%else/) {
          goto ELSE if $iflevel == @ifexpr;
        } elsif (/^\s*%endif/) {
          goto ENDIF if $iflevel == @ifexpr;
          $iflevel--;
        }
      }
      die _("Unmatched %else at end of file.  Missing %endif.\n");
    }
ENDIF: if (/^\s*%endif/) {
      chomp;
      die _('Unmatched %endif in line ').$_.
          _(".  Missing %if/%else.\n") unless @ifexpr;
      pop @ifexpr;
    } # %if..%else..%endif

### Diagnostics '%{macros}'; react immediately to these items
    elsif (/^\s*%\{echo:(.+)}/) {
      print expandmacros($1)."\n";
    } elsif (/^\s*%\{warn:(.+)}/) {
      warn expandmacros($1)."\n";
    } elsif (/^\s*%\{error:(.+)}/) {
      die expandmacros($1)."\n";
    }

### Single-line %commands
    # Multi-level submodules
    elsif (/^\s*%include\s+(.+)/) {
      parse_spec(expandmacros($1),$stage,$subname,$scriptlet);
    }

    # %{perl:interpreter}
    elsif (/^\s*%\{perl:(.+)}/) {
      my $perl = expandmacros('%{_tmppath}/deb-tmp.perl.').int(rand(99998)+1);
      do {
        local *STDOUT;
        if (open(STDOUT, '>', $perl)) {
          eval($1);
        }
      };
      parse_spec($perl,$stage,$subname,$scriptlet);
      unlink $perl;
    }

    # Preprocess %define's and Conditional Build Stuff
    elsif (/^\s*%(?:(?:un)?define|dump|global|bcond_with(?:out)?)\s/) {
      $_ = read_multiline($_, \&spec_readline);
      expandmacros($_);
    }

### Multi-line sectioning %commands
# Now we pick out the sections and set "state" to parse that section.
# Fugly but I can't see a better way.  >:(
    elsif (/^%(description|copyrightdata|files)(?:\s+(?:-n\s+)?(.+))?/) {
      ($stage,$subname) = ($1,'main');
      my $f;
      my $n = $2;
      if ( $stage eq 'files' ) {
        vdebug($_, 5, 'parse_spec/files/'.$subname);
      }
      if ($n and $n =~ s/\s*-f\s+(.*)\s*//) {
        $f = expandmacros("%{_builddir}/%{buildsubdir}/$1");
      }
      if ($n) {       # Magic to add entries to the right package
        my $tmp = expandmacros($n);
        if ( $stage eq 'files' ) {
          vdebug($subname." / ".$tmp, 5, 'parse_spec/files/tmp');
        }
        if ( $tmp =~ /\A\s*-n\s+/ ) {
          $subname = $';
        } else {
          $subname = /\s-n\s/ ? $tmp : "$pkgdata{main}{name}-$tmp";
        }
        $subname = 'main' if $pkgdata{main}{name} eq $subname;
        if ( $stage eq 'files' ) {
          vdebug($subname, 5, 'parse_spec/files/new');
        }
      }
      if ($f) {
        $files_files{$subname} = $f;
      }
      $pkgdata{$subname}{files} //= [] if $stage eq 'files';
    } # %description, %copyrightdata, %files

    elsif (/^%(package)\s+(?:-n\s+)?(.+)/) {
      $stage = $1;
      # Magic to add entries to the right package
      my $tmp = expandmacros($2);
      $subname = /\s-n\s/ ? $tmp : "$pkgdata{main}{name}-$tmp";
      push @pkglist, $subname;
      # Hack the filename for the package into a Debian-tool-compatible format.  GRRRRRR!!!!!
      # Have I mentioned I hate Debian Policy?
      # Package names are lower case only!
      ($pkgdata{$subname}{name} = lc($subname)) =~ tr/_/-/;
      $pkgdata{$subname}{version} = $pkgdata{main}{version};
  # Build "same arch as previous package found" by default.  Where rpm just picks the
  # *very* last one, we want to allow arch<native>+arch-all
  # (eg, Apache is i386, but apache-manual is all)
      $pkgdata{$subname}{arch} = $pkgdata{main}{arch};  # Since it's likely subpackages will NOT have a BuildArch line...
    } # %package

    elsif (/^%(prep)/) {
      $stage = $1;
    } # %prep

    elsif (/^%(build|install|check|clean)/) {
      $stage = $1;
      $script{$stage} .= "cd '%{buildsubdir}'\n" if $pkgdata{main}{hassetup};
    } # %build,install,check,clean

    elsif (s/^%((?:pre|post)(?:un|trans)?)//i) {
      $scriptlet = lc $1;
      ($stage,$subname) = ('prepost','main');
      Getopt::Long::GetOptionsFromString($_,
        # Rudimentary support for '-p <command>'
        'p=s' => sub { $pkgdata{$subname}{$scriptlet} .= $_[1]."\n" },
        # Magic to add entries to the right package
        'n=s' => sub { $subname = expandmacros($_[1]) },
        '<>'  => sub { $subname =
          $pkgdata{main}{name}.'-'.expandmacros( $_[0] ) } );
    } # %pre/%post/%preun/%postun

    elsif (/^%(changelog)/) {
      $stage = $1;
      if ($pkgdata{main}{$stage}) { # Multi-part changelog
        $pkgdata{main}{$stage} =~ s/\s+$/\n\n/g; # Trim trailing blanks
      } else {
        $pkgdata{main}{$stage} = '';
      }
    }

### Actual section contents
# now we handle individual lines from the various sections
    elsif ($stage eq 'description') {
      $pkgdata{$subname}{$stage} .= " $_";
    } # description

    elsif ($stage eq 'copyrightdata') {
      $pkgdata{$subname}{$stage} .= $_;
    } # copyrightdata

    elsif ($stage eq 'package') {
      # gotta expand %defines here.  Whee.
# Note that we look for the Debian-specific Breaks and Replaces,
# although they will have to be wrapped in '%if %{_vendor} == "debbuild"' for
# an rpmbuild-compatible .spec file
      if (my ($dname,$dvalue) = /^(Summary|Group|Version|Conflicts|Provides|
          BuildArch(?:itecture)?|BuildRequires|BuildConflicts|
          Recommends|Supplements|Suggests|Enhances|Obsoletes|Breaks|Replaces|
          PreReq|Requires(?:\((?:pre|post)(?:un)?\))?|Pre-Depends):\s+(.+)$/ix) {
        my $dname_orig = $dname;
        $dname =~ tr/[A-Z]/[a-z]/;
        $dvalue =~ s/^noarch/all/i if $dname =~ s/^BuildArch(?:itecture)?/arch/i;
        if (grep { $dname eq $_ } qw(recommends suggests enhances breaks
            replaces requires conflicts provides pre-depends)) {
          push @{$pkgdata{$subname}{$dname}}, splitreqs($dvalue);
        } elsif (grep { $dname eq $_ } qw(supplements)) {
          push @{$pkgdata{$subname}{enhances}}, splitreqs($dvalue);
          warn _('Warning:  \'').'Supplements'.
               _(":' is not natively supported by .deb packages.\n").
               _("Downgrading relationship to Enhances:.\n");
        } elsif (grep { $dname eq $_ } qw{prereq requires(pre) requires(preun)}) {
          push @{$pkgdata{$subname}{'pre-depends'}}, splitreqs($dvalue);
        } elsif (grep { $dname eq $_ } qw{requires(post) requires(postun)}) {
          push @{$pkgdata{$subname}{requires}}, splitreqs($dvalue);
          warn _('Warning:  \'').$dname_orig.
               _(":' is not natively supported by .deb packages.\n").
               _("Upgrading relationship to Requires:.\n");
        } elsif (grep { $dname eq $_ } qw(obsoletes)) {
          push @{$pkgdata{$subname}{replaces}}, splitreqs($dvalue);
        } elsif (grep { $dname eq $_ } qw(buildrequires)) {
          push @buildrequires, splitreqs($dvalue);
        } elsif (grep { $dname eq $_ } qw(buildconflicts)) {
          push @buildconflicts, splitreqs($dvalue);
        } else {
          $pkgdata{$subname}{$dname} = expandmacros($dvalue);
        }
      }
    } # package

    elsif ($stage eq 'prep') {
      # Actual handling for %prep section.  May have %setup macro, may include
      # %patch tags, may be just a bare shell script.
      # %autosetup and %autopatch are supported, too.
      if (s/^%((?:setup|patch))// or s/^\s*%((?:auto)(?:setup|patch))//) {
        no strict qw(refs); # we use strings as function refs
        $script{$stage} .= "process_$1"->();
      } else {
        $script{$stage} .= $_;
      }
    } # prep

    elsif ($stage =~ /build|install|check|clean/) {
      $script{$stage} .= $_;
    } # build,install,check,clean

    elsif ($stage eq 'prepost') {
      $pkgdata{$subname}{$scriptlet} .= $_;
    } # prepost

    elsif ($stage eq 'files') {
      if (/^\s*%defattr      # lot of formatting whitespace permitted
          \s*\(\s*           # opening and closing parentheses; required
            (-|\d+)          # (1) file mode, numeric (octal) or '-'
          [\s,]+             # field separator, comma or space
            (-|(['"]?)\w+\3) # (2) default owner, (3) quotes permitted, or '-'
          [\s,]+             # field separator, comma or space
            (-|(['"]?)\w+\5) # (4) default group, (5) quotes permitted, or '-'
            (?:[\s,]+        # field separator, comma or space
               (-|\d+))?     # (6) directory mode; optional, then eq file mode
          \s*\)/x) {
        ($defattr{filemode}, $defattr{owner}, $defattr{group}) = ($1, $2, $4);
         $defattr{dirmode} = ($6 or $defattr{filemode}); # default directory setting is optional
      } elsif (/^\s*%exclude\s+(.*)/) {
        my $efl = $1;
        $efl =~ s/\s+$//;
        vdebug($efl, 5, "parse_spec/exclude/$subname");
        $pkgdata{$subname}{files} //= [];
        push @{$pkgdata{$subname}{files}}, { f => $efl, ex => 1 };
      } else {
        my $p = $_;
        my $e = expandmacros($p);
        $e =~ s/\\(\n|\z)/$1/g;
        $e =~ s/\s+\z//;
        my @a = split(/\n/, $e);
        if ( scalar @a > 1 ) {
          unshift @rbuf, @a;
          next LINE;
        } else {
          process_filesline($subname, $p);
        }
      }
    } # files

    elsif ($stage eq 'changelog') {
      # this is one of the few places we do NOT generally want to replace macros...
      $pkgdata{main}{$stage} .= $_;
    }

    elsif ($stage eq 'preamble') {
      if (/^(summary|name|epoch|version|release|
             group|copyright|url|packager|license):\s*(.+)/ix) {
        my $_v = lc($1);
        $pkgdata{main}{$_v} //= expandmacros($2);
        if ( $_v eq 'name' ) {
          $pkgdata{main}{$_v} = lc($pkgdata{main}{$_v});
          $pkgdata{main}{$_v} =~ tr/_/-/;
        }
      } elsif (/^(vendor|buildroot):\s*(.+)\s*/i) {
        $specglobals{lc $1} = $2;
      } elsif (my ($srcnum, $src) = /^source(\d*):\s*(.+)\s*$/i) {
        $srcnum ||= 0;
        $pkgdata{sources}{$srcnum} = basename($src);
        $pkgdata{main}{source} = $pkgdata{sources}{0} if 0 == $srcnum;
      } elsif (my ($patchnum, $patch) = /^(patch\d*):\s*(.+)\s*$/i) {
        $pkgdata{main}{lc $patchnum} = basename($patch);
      } elsif (/^buildarch(?:itecture)?:\s*(.+)\s*$/i) {
        ($pkgdata{main}{arch} = $1) =~ s/^noarch$/all/;
      } elsif (/^buildrequires:\s*(.+)/i) {
        push @buildrequires, splitreqs($1);
      } elsif (/^buildconflicts:\s*(.+)/i) {
        push @buildconflicts, splitreqs($1);
      } elsif (/^(requires|provides|conflicts):\s*(.+)/i) {
        push @{$pkgdata{main}{lc $1}}, splitreqs($2);
      } elsif (/^(?:prereq|requires\((?:pre|preun)\)):\s*(.+)/i) {
        push @{$pkgdata{main}{'pre-depends'}}, splitreqs($1);
      } elsif (/^(requires\((?:post|postun)\)):\s*(.+)/i) {
        push @{$pkgdata{main}{requires}}, splitreqs($2);
        warn _('Warning:  \'').$1.
             _(":' is not natively supported by .deb packages.\n").
             _("Upgrading relationship to Requires:.\n");
      } elsif (/^(suggests|enhances|recommends):\s*(.+)/i) {
        push @{$pkgdata{main}{lc $1}}, splitreqs($2);
# As of sometime between RHEL 6 and RHEL 7 or so, support was added for Recommends: and Enhances:,
# along with shiny new tag Supplements:.  We'll continue to warn about them for a while.
        warn _('Warning:  \'').$1.
             _(":' outside %if wrapper\n") unless @ifexpr;
      } elsif (/^(breaks|replaces|pre-depends):\s*(.+)/i) {
        push @{$pkgdata{main}{lc $1}}, splitreqs($2);
        warn _('Warning:  Debian-specific \'').$1.
             _(":' outside %if wrapper\n") unless @ifexpr;
      } elsif (/^supplements:\s*(.+)/i) {
        push @{$pkgdata{main}{enhances}}, splitreqs($1);
        warn _('Warning:  \'').'Supplemets'.
             _(":' is not natively supported by .deb packages.\n").
             _("Downgrading relationship to Enhances:.\n");
      } elsif (/^obsoletes:\s*(.+)/i) {
        push @{$pkgdata{main}{replaces}}, splitreqs($1);
      } elsif (/^autoreq(?:prov)?:\s*(.+)/i) {
        # we don't handle auto-provides (yet)
        $NoAutoReq = 1 if $1 =~ /(?:no|0)/i;
      } else { # Other lines may contain '%{?!conditional:macros}' as well
        my $pp = $_;
        $_ = expandmacros($_);
        next LINE if $pp eq $_;
        s/\s+\z//;
        my @a = split /\n/;
        unshift(@rbuf, @a) if scalar(@a);
      }
    } # preamble

  } # while <$fh>

  close $fh;

  die _("Unmatched %if at end of file.  Missing %endif.\n") if @ifexpr;
} # end parse_spec()


## splitreqs()
# Split string at 'comma' and return list of trimmed entries
sub splitreqs {
  return map { /^\s*(.+)\s*$/ } split /,/, expandmacros(shift);
} # end splitreqs()


## process_autosetup()
# Convert the current '$_' line from '%autosetup' to '%setup' and call
# 'process_setup()', then create an '%autopatch' line and invoke
# 'process_autopatch()'.
sub process_autosetup {
  my $plevel = $1 if s/\s+-p\s*(\d+)//;
  my $verbose = s/\s+-v//; $_ .= ($verbose ? '': ' -q');
  my $noautopatch = s/\s+-N//; # Eat '-N', which is unknown to %setup
  $specglobals{__scm} = $1 if s/\s+\-S\s+(\w+)//; # dito '-S'
  my $scm = $specglobals{__scm};
  die _('%autosetup:  option \'-S ').$scm.
      _('\' currently not supported at line ').$..".\n"
    unless $specglobals{"__scm_setup_$scm"};
  # Generic %setup invocation
  my $script = process_setup(); # hmm, how to fall to '%setup'?
  # Do SCM stuff
  $script .= "%{__scm_setup_$scm".($verbose ? '' : ' -q')."}\n";
  unless ($noautopatch) {
    $_ = ($plevel ? " -p $plevel" : '').($verbose ? ' -v' : '');
    $script .= process_autopatch();
  }
  return $script;
} # process_autosetup()


## process_autopatch()
# Apply all available patches in ascending numerical order as specified in the
# specfile. The '%autopatch' command only knows the options '-v' ('verbose) and
# '-p[N]' ('path strip level').
sub process_autopatch {
  my $verbose = /-v/;
  my ($plevel) = /-p\s*(\d+)/;
  my $k = 1;
  return join '', map { apply_patch($verbose,$plevel,$_,$k++) } patches();
} # process_autopatch()


## sources()
sub sources {
  return map { "%{_sourcedir}/$pkgdata{sources}{$_}" }
         sort keys %{$pkgdata{sources}};
} # sources()


## patches()
sub patches {
  my @patches = grep {/^patch/} keys %{$pkgdata{main}};
  my @result;
  if (1 == @patches) { # won't enter 'sort BLOCK' and strip 'patch' prefix
    push @result, "%{_sourcedir}/$pkgdata{main}{$patches[0]}";
  } else { # now you're talkin', brother!
    for (sort {$a =~ s/patch//; $b =~ s/patch//; $a <=> $b} @patches) {
      push @result, qq(%{_sourcedir}/$pkgdata{main}{"patch$_"});
    }
  }
  return @result;
} # patches()


## apply_patch()
# Hard-coded variant of RPM's macro of the same name.
sub apply_patch {
  my ($verbose, $plevel, $patchfile, $ordinal) = @_;
  return "%{__test} -r $patchfile || { %{__echo} 'Cannot read $patchfile'; exit 1; }\n".
    "%{uncompress:$patchfile} | %{__scm_apply_$specglobals{__scm}".
      ($verbose ? '' : ' -q').($plevel ? " -p$plevel" : '').
      " -m %{basename:$patchfile} $patchfile $ordinal}$check_status";
} # apply_patch()


## process_setup()
sub process_setup {
  $pkgdata{main}{hassetup} = 1;  # flag the fact that we've got %setup
  # Parse out the %setup macro.  rpmbuild doesn't complain about
  # gibberish immediately following %setup, but we will
  unless (/^(?:\s|$)/) {
    chomp;
    warn _('Suspect %setup tag \'%setup').$_.
         _("', continuing\n");
    s/^\S+//;
  }

  # Prepare some flags
  my ($createdir, $leavedirs, $quietunpack, $skipdefault) = (0) x 4;
  my (@sbefore, @safter);

  Getopt::Long::GetOptionsFromString($_,
    'n=s' => \$specglobals{buildsubdir},
    'c'   => \$createdir,   # flag, create and change directory before unpack
    'D'   => \$leavedirs,   # flag, do not delete directory before unpack
    'T'   => \$skipdefault, # flag, do not unpack first source
    'q'   => \$quietunpack, # SSH!  Unpack quietly
    'b=i' => \@sbefore,
    'a=i' => \@safter);

# Note that this is an incomplete match to rpmbuild's full %setup expression.
# Known differences
# - rpmbuild requires -n on all %setup macros, but carries the first down to
#   %install etc, debbuild sets the global on the first call, and keeps using
#   it for further %setup calls
  my $setupscript = "%{__rm} -rf '%{buildsubdir}'\n" unless $leavedirs;

  foreach (@sbefore) {
    $setupscript .= unpackcmd($pkgdata{sources}{$_},$quietunpack);
  }

  if ($createdir) {
    $setupscript .= "%{__mkdir_p} %{buildsubdir}\ncd '%{buildsubdir}'\n";
  }
  elsif (not $skipdefault) {
    $setupscript .= unpackcmd($pkgdata{main}{source},$quietunpack);
  }

  if (not $createdir) {
    $setupscript .= "cd '%{buildsubdir}'\n";
  }
  elsif (not $skipdefault) {
    $setupscript .= unpackcmd($pkgdata{main}{source},$quietunpack);
  }

  foreach (@safter) {
    $setupscript .= unpackcmd($pkgdata{sources}{$_},$quietunpack);
  }

  return $setupscript .= "%{__chmod} -Rf a+rX,u+w,go-w .\n";
} # end process_setup()


## unpackcmd()
# Prepare the necessary commands for uncompressing and extracting the content
# of the source drop according to the file extension.
sub unpackcmd {
   my ($sourcedrop, $quietunpack) = @_;
   return (
      $sourcedrop =~ /\.zip$/ ? # .zip files are not really tarballs
         '%{__unzip}'.( $quietunpack ? ' -qq ' : ' ' ).
         "'%{_sourcedir}/$sourcedrop'" :
      $sourcedrop =~ /\.tar$/ ? # plain .tar files don't need to be uncompressed
         '%{__tar} -x'.( $quietunpack ? '' : 'vv' ).'f '.
         "'%{_sourcedir}/$sourcedrop'" :
      # .gem files are unpacked with different flags and need a gemspec generated
      $sourcedrop =~ /\.gem$/ ?
         '%{__gem} unpack '.( $quietunpack ? '--quiet ' : '-V ' ).
         "'%{_sourcedir}/$sourcedrop'\n".
         "%{__gem} spec '%{_sourcedir}/$sourcedrop' --ruby > ".
         "'./${sourcedrop}spec'" :
      decompress("%{_sourcedir}/$sourcedrop").
          ' | %{__tar} -x'.( $quietunpack ? '' : 'vv' ).'f -' ).$check_status;
} # end unpackcmd()


## decompress()
# Determine the suitable decompressor according to the file extension.
sub decompress {
   my $filename = shift;
   return (
      $filename =~ /\.(?:t?gz|Z)$/  ? '%{__gzip}'  :
      $filename =~ /\.(?:t?bz?2?)$/ ? '%{__bzip2}' :
      $filename =~ /\.xz$/          ? '%{__xz}'    :
      $filename =~ /\.zst$/         ? '%{__zstd}'  :
      die _('Can\'t handle unknown file type \'').$filename."'.\n" ).
      " -dc '$filename'";
} # end decompress()


## lookup_specfile()
# Used for '-t[pcilabs]'.
sub lookup_specfile {
  my $tarball = shift;
  return (
     $tarball =~ /\.zip$/ ? # .zip files are not really tarballs
        q(%{__unzip} -Z1 %{tarball} '*.spec') :
     $tarball =~ /\.tar$/ ? # plain .tar files don't need to be uncompressed
        q(%{__tar} -tf %{tarball} --wildcards '*.spec') :
     decompress($tarball).q( | %{__tar} -tf - --wildcards '*.spec') ).
     $check_status;
} # end lookup_specfile()


## extract_specfile()
# Used for '-t[pcilabs]'.
sub extract_specfile {
  my $tarball = shift;
  return (
     $tarball =~ /\.zip$/ ? # .zip files are not really tarballs
        q(%{__unzip} -p %{tarball} '*.spec') :
     $tarball =~ /\.tar$/ ? # plain .tar files don't need to be uncompressed
        q(%{__tar} -xOf %{tarball} --wildcards '*.spec') :
     decompress($tarball).q( | %{__tar} -xOf - --wildcards '*.spec') ).
     ' > %{specfile}'.$check_status.'%{__cp} -f %{tarball} %{_sourcedir}';
} # end extract_specfile()


## process_patch()
sub process_patch {
  # Things rpmbuild Does
  # -> blindly follows Patch(.*):  ==>  %patch$1
  # %patch0 does not in fact equal %patch without -P
  # spaces optional between flag and argument
  # multiple -P options actually trigger multiple patch events.  >_<
  # can we emulate this?
  # yes we can!
  my @patchlist;

  # add patch{nn} to the list
  if (s/^(\d+)//) {
    push @patchlist, $1;
  }
  # add the "null" patch to the list unless we've got a -P flag
  elsif (not /-P/) {
    push @patchlist, '';
  }

  # %patch options:
  my ($fuzz, $plev) = ($specglobals{_default_patch_fuzz}, 0);
  my ($psuff, $noempty, $reverse, $altdir, $output) = ('') x 5;

  Getopt::Long::GetOptionsFromString($_,
    'P=i'   => \@patchlist, # patch number(s)
    'p=i'   => \$plev,      # path strip.  Passed to patch as-is
    'F=i'   => \$fuzz,      # fuzz factor.  Passed to patch as-is
    'd=s'   => \$altdir,    # alternative directory.  Passed to patch as-is
    'o=s'   => \$output,    # redirect output.  Passed to patch as-is
    'E'     => \$noempty,   # remove empty files.  Passed to patch as-is
    'R'     => \$reverse,   # reverse patch.  Passed to patch as-is
    'b|z=s' => \$psuff,     # backup file postfix.
      # Literal, if e.g. "bkfile", backup files will be "filebkfile",
      # not "file.bkfile".  Passed as-is, with a minor flag adjustment
    '<>' => sub {
      push @patchlist, @_; # all other arguments are patch numbers
    }
  );

  my $patchopts = $specglobals{_default_patch_flags};
  $patchopts .= " -F $fuzz -p$plev";
  $patchopts .= " -b -z $psuff" if $psuff;
  $patchopts .= " -d $altdir" if $altdir;
  $patchopts .= " -o $output" if $output;
  $patchopts .= ' -E' if $noempty;
  $patchopts .= ' -R' if $reverse;

  my $patchscript;
  foreach my $pnum (@patchlist) {
    $patchscript .= q(%{__echo} "Patch ).($pnum eq '' ? '' : "#$pnum ");
    $pnum = expandmacros("%{patch$pnum}");
    $patchscript .= q|(|.basename($pnum).qq|):"\n|.
      "test -f $pnum && %{uncompress:$pnum} | %{__patch} $patchopts".$check_status;
  }
  return $patchscript;
} # end process_patch()


## uncompress()
# Prepare the necessary commands for uncompressing the content of a patch file
# for piping to 'patch' in the next step according to the file extension.
sub uncompress {
  my $patchfile = shift;
  return (
    # Compressed patch.  You weirdo.
    $patchfile =~ /\.(?:Z|gz|bz2?|xz|zst)$/ ? decompress($patchfile) :
    # .zip'ed patch.  *backs away slowly*
    $patchfile =~ /\.zip$/ ? "%{__unzip} -p $patchfile" :
    # else uncompressed patch
    "%{__cat} $patchfile" );
} # uncompress()


## process_filesline()
sub process_filesline {
  my ($subname, $l) = @_;

  # create and initialize flags
  my ($perms, $owner, $group, $conf) =
    ($defattr{filemode}, $defattr{owner}, $defattr{group}, '-');

  vdebug("$subname: $l", 3, "process_filesline/in");
  return if $l =~ /%ghost\s+/;

  my $dir_only = $l =~ s/^\s*%dir\s*//;
  $l =~ s/^\s*%docdir\s*//;

  # strip and flag %attr constructs ... and wipe it when we're done.
  if ($l =~ s/\s*%attr         # lot of formatting whitespace permitted
      \s*\(\s*                 # opening and closing parentheses; required
        (-|\d+)                # (1) file mode, numeric (octal) or '-'
      [\s,]+                   # field separator, comma or space
        (-|(['"]?)\w+\3)       # (2) default owner, (3) quotes permitted, or '-'
      [\s,]+                   # field separator, comma or space
        (-|(['"]?)\w+\5)       # (4) default group, (5) quotes permitted, or '-'
      \s*\)\s*//x) {
    ($perms,$owner,$group) = ($1,$2,$4);
  }

  # Conffiles.  Note that Debian and RH have similar, but not
  # *quite* identical ideas of what constitutes a conffile.  Nrgh.
  # Note that dpkg will always ask if you want to replace the file - noreplace
  # is more or less permanently enabled.
##fixme
# also need to handle missingok (file that doesn't exist, but should be removed on uninstall)
# hmm.  not sure if such is **POSSIBLE** with Debian...  maybe an addition to %post?
  if ($l =~ s/%config\b(?:\s*\(\s*noreplace\s*\)\s*)?//) {
    $pkgdata{$subname}{conffiles} = 1;  # Flag it for later
    $conf = 'y';
  }

  # %doc needs extra processing, because it can be a space-separated list, and may
  # include both full and partial pathnames.  The partial pathnames must be fiddled
  # into place in the %install script, because Debian doesn't really have the concept
  # of "documentation file" that rpm does.  (Debian "documentation files" are files
  # in /usr/share/doc/<packagename>.)
  # Note: %license in RPM behaves in the same manner as %doc, but on RPM systems,
  # it does not mark the file as a documentation file and will install it to
  # /usr/share/licenses/<packagename>. Debian has no concept of this, so we just
  # reuse the %doc handling and put it there. That's where these things used to go
  # anyway...
  if ($l =~ s/(%doc|%license)\s+//) {
    # have to extract the partial pathnames that %doc installs automagically
    foreach my $pp (split(/\s+/, $l)) {
      if (not $pp =~ m|^[%/]|) {
        $doclist{$subname} .= " $pp";
        my ($element) = $pp =~ m|([^/\s]+/?)$|;
        $pp =~ s/\*/\\*/g;
        $pp =~ s/\./\\./g;
        $l =~ s|$pp|%{_docdir}/$pkgdata{$subname}{name}/$element|;
      }
    }
  } # $filesline =~ /%doc\b/

  $l =~ s/^\s*//; chomp $l;	# Just In Case.  For, uh, neatness.

##fixme
# need hackery to assure only one filespec per %config.  NB:  "*" is one filespec.  <g>
  push @{$pkgdata{$subname}{conflist}}, $l if $conf ne '-';

  # now that we've got the specials out of the way, we can add things to the appropriate list of files.
  # ... and finally everything else

  # Save file and permissions to process in binpackage
  $pkgdata{$subname}{files} //= [];
  push @{$pkgdata{$subname}{files}}, { f => $l, u => $owner, g => $group,
                                       fm => $perms, dm => $defattr{dirmode},
                                       od => $dir_only };
} # end process_filesline()


## execute_script()
# Writes and executes a %script (mostly) built while reading the spec file.
sub execute_script {
  my ($stage, $what, $for) = @_;

  # anything to do?
  return if $cmdopts{"no$stage"} or not $script{$stage};

  # create script filename
  my $scriptfile = expandmacros('%{_tmppath}')."/deb-tmp.$stage.".int(rand(99998)+1);
  sysopen(SCRIPT, $scriptfile, O_RDWR | O_CREAT | O_EXCL | O_NOFOLLOW, 0777)
    or die _('Can\'t open/create ').($what or $stage).
           _(' script file ')."$scriptfile: $!\n";
  $specglobals{___build_body} = $script{$stage}; # Inject stage script from specfile
  vdebug($specglobals{___build_body}, 5, "execute_script/$stage");
  print SCRIPT expandmacros('%{___build_template}');
  close SCRIPT;

  # execute
  my $cmdline = expandmacros('%{___build_cmd}').' '. $scriptfile;
  print _('Executing (').($what or "%$stage").'): '.$cmdline.($for or '')."\n"
    if defined $specglobals{verbose};
  system($cmdline . ((defined $specglobals{verbose} and
      $specglobals{verbose} > 1) ? '' : ' >/dev/null 2>&1'))
    and die _('Exec of ').$scriptfile._(' failed (%')."$stage): $?\n";

  # and clean up
  unlink $scriptfile unless $cmdopts{debug};
} # end execute_script()


## install()
# Writes and executes the %install script (mostly) built while reading the spec file.
sub install {
  # munge %doc entries into place
  # rpm handles this with a separate executed %doc script, we're not going to bother.
  foreach my $docpkg (keys %doclist) {
    $script{install} .= "DOCDIR=\$RPM_BUILD_ROOT%{_docdir}/".
      $pkgdata{$docpkg}{name}."\nexport DOCDIR\n%{__mkdir_p} \$DOCDIR\n";
    $doclist{$docpkg} =~ s/^\s*//;
    foreach (split ' ', $doclist{$docpkg}) {
      $script{install} .= "%{__cp} -pr $_ \$DOCDIR/\n";
    }
  }

  execute_script('install');

  # final bit: compress manpages if present
  # done here cuz I don't grok shell well
  # should probably error-check all kinds of things.  <g>
  foreach my $manpage (glob("$specglobals{buildroot}/usr/share/man/man*/*")) {
    if (-f $manpage) {
      if (my ($newpage) = $manpage =~ /^(.+)\.(?:Z|gz|bz2?|xz|zst)\n?$/) {
       my $cmdline = expandmacros("%{uncompress:$manpage} > $newpage");
       qx($cmdline); unlink $manpage; $manpage = $newpage;
      }
      qx($specglobals{__gzip} -f9n $manpage);
    } elsif (-l $manpage) {
      (my $linkdest = readlink $manpage) =~ s/\.(?:Z|gz|bz2)//;
      unlink $manpage;
      $manpage =~ s/\.(?:Z|gz|bz2)//;
      symlink "$linkdest.gz", "$manpage.gz" or
        warn _('Warning:  symlinking manpage failed:  ')."$!\n";
    }
  }

  execute_script('check');
} # end install()


## binpackage()
# Creates the binary .deb package from the installed tree in $specglobals{buildroot}.
# Writes and executes a shell script to do so.
# Creates miscellaneous files required by dpkg-deb to actually build the package file.
# Should handle simple subpackages
sub binpackage {
  foreach my $pkg (@pkglist) {

    # Just In Case.
    foreach my $entry (qw(arch copyrightdata changelog group)) {
      $pkgdata{$pkg}{$entry} //= $pkgdata{main}{$entry};
    }

    # Make sure we have somewhere to write the .deb file
    my $debdir = expandmacros('%{_debdir}');
    mkdir "$debdir/$pkgdata{$pkg}{arch}" unless -e "$debdir/$pkgdata{$pkg}{arch}";

    vdebug("$pkg(".$pkgdata{$pkg}{name}.") - [".(defined($pkgdata{$pkg}{files}) ? 1 : 0)."]", 3, "binpackage");
    # Skip building a package that doesn't have any files or dependencies.  True
    # metapackages don't have any files, but they depend on a bunch of things.
    # Packages with neither have, essentially, no content.
    next if
        (not defined($pkgdata{$pkg}{files})) or (
        (
            not scalar @{$pkgdata{$pkg}{files}}
            and not $files_files{$pkg}
        ) and (not $pkgdata{$pkg}{requires}));

    $pkgdata{$pkg}{files} //= [];
    vdebug("$pkg(".$pkgdata{$pkg}{name}.") - building...", 3, "binpackage/build");

    # Gotta do this first, otherwise we don't have a place to move files from %files
    mkdir "$specglobals{buildroot}/$pkg";

    if ($files_files{$pkg}) {
      if (-e $files_files{$pkg}) {
        open(FILES, "<", $files_files{$pkg}) || die _('Could not open: ').$files_files{$pkg}."\n";
        while(<FILES>) {
          chomp($_);
          process_filesline($pkg, $_);
        }
        close FILES;
      } else {
        die _('File not found: ').$files_files{$pkg}."\n";
      }
    }

    my $fmo = '';
    foreach my $i ( @{$pkgdata{$pkg}{files}} ) {
      vdebug($i->{f}, 5, "binpackage/files/pre/$pkg");
      my $fr = expandmacros($i->{f});
      $fr =~ s/\\(\n|\z)/\n/g;
      # Not sure what should we do with %ghost
      $fr =~ s/(?:\A|\s+)%ghost\s+.*(\n|\z)//mg;
      #$fr =~ s/(?:\A|\s+)%ghost\s+(.*)(\n|\z)/$1$2/mg;
      $fr =~ s/\n+/\n/g;
      $fr =~ s/\A\s+//;
      $fr =~ s/\s+\z//;
      vdebug($fr, 5, "binpackage/files/post/$pkg");
      foreach my $j ( split /\s+/, $fr ) {
        if ( $i->{ex} ) {
          # Perform %exclude from binpackage
          vdebug($j, 5, "binpackage/exclude/$pkg");
          qx ( $specglobals{__rm} -rf $specglobals{buildroot}/$pkg$j );
          next;
        }
        vdebug($j, 5, "binpackage/include/$pkg");
        my $brl = length($specglobals{buildroot});
        foreach my $pkgfile ( glob $specglobals{buildroot}.$j ) {
          $pkgfile = substr($pkgfile, $brl);
          # Feh.  Manpages don't **NEED** to be gzipped, but rpmbuild does, and so shall we.
          # ... and your little info page too!
          if ($pkgfile =~ m{/usr/share/(?:man/man|info)}) {
            # need to check to see if manpage is gzipped
            if (-e "$specglobals{buildroot}$pkgfile") {
              # if we've just been pointed to a manpage section with "many" pages,
              # we need to gzip them all.
              # fortunately, we do NOT need to explicitly track each file for the
              # purpose of stuffing them in the package...  the original %files
              # entry will do just fine.
              if ( -d "$specglobals{buildroot}$pkgfile") {
                foreach my $globfile (glob("$specglobals{buildroot}$pkgfile/*")) {
                  qx ( $specglobals{__gzip} $globfile ) if $globfile !~ m|\.gz$|;
                }
              } else {
                if ($pkgfile !~ m|\.gz$|) {
                  qx ( $specglobals{__gzip} $specglobals{buildroot}$pkgfile );
                  $pkgfile .= '.gz';
                }
              }
            } else {
              if ($pkgfile !~ m|\.gz$|) {
                $pkgfile .= '.gz' unless $pkgfile =~ /\*$/;
              } else {
                $pkgfile =~ s/\.gz$//;
                qx ( $specglobals{__gzip} $specglobals{buildroot}$pkgfile );
                $pkgfile .= '.gz';
              }
            }
          }

          my ($fpath,$fname) = $pkgfile =~ m|(.+?/?)?([^/]+/?)$|;	# We don't need $fname now, but we might.
          if ( -d "$specglobals{buildroot}$pkgfile" ) {
            vdebug($pkgfile, 5, "binpackage/add/dir/$pkg");
            qx ( $specglobals{__mkdir_p} $specglobals{buildroot}/$pkg$pkgfile );
            qx ( $specglobals{__cp} -ar $specglobals{buildroot}$pkgfile $specglobals{buildroot}/$pkg$fpath ) unless $i->{od};
          } else {
            vdebug($pkgfile, 5, "binpackage/add/file/$pkg");
            qx ( $specglobals{__mkdir_p} $specglobals{buildroot}/$pkg$fpath ) if $fpath;
            qx ( $specglobals{__cp} -a $specglobals{buildroot}$pkgfile $specglobals{buildroot}/$pkg$fpath );
          }

          # due to Debian's total lack of real permissions-processing in its actual package
          # handling component (dpkg-deb), this can't really be done "properly".  We'll have
          # to add chown/chmod commands to the postinst instead.  Feh.
          $fmo .= $specglobals{__chown}." -Rh ".$i->{u}." $pkgfile\n" if $i->{u} ne '-';
          $fmo .= $specglobals{__chgrp}." -Rh ".$i->{g}." $pkgfile\n" if $i->{g} ne '-';
          if ( -d "$specglobals{buildroot}$pkgfile" ) {
            $fmo .= $specglobals{__chmod}." ".$i->{dm}." $pkgfile\n" if $i->{dm} ne '-';
          } else {
            $fmo .= $specglobals{__chmod}." ".$i->{fm}." $pkgfile\n" if $i->{fm} ne '-';
          }
        }
      }
    }

    # Add 'changelog' and 'copyrightdata' sections as 'doc' files.
    if ($pkgdata{$pkg}{changelog}) {
      $pkgdata{$pkg}{changelog} =~ s/\s+$//g; # Trim trailing blanks
      my $clpath = expandmacros("%{buildroot}/$pkg%{_docdir}/$pkgdata{$pkg}{name}");
      qx ( $specglobals{__mkdir_p} $clpath );
      if (open CHANGELOG, "| $specglobals{__gzip} -cf9n >$clpath/changelog.gz") {
        print CHANGELOG $pkgdata{$pkg}{changelog};
        close CHANGELOG;
      }
    }
    if ($pkgdata{$pkg}{copyrightdata}) {
      $pkgdata{$pkg}{copyrightdata} =~ s/\s+$//g; # Trim trailing blanks
      my $crpath = expandmacros("%{buildroot}/$pkg%{_docdir}/$pkgdata{$pkg}{name}");
      qx ( $specglobals{__mkdir_p} $crpath );
      if (open COPYRIGHT, "| $specglobals{__gzip} -cf9n >$crpath/copyright.gz") {
        print COPYRIGHT $pkgdata{$pkg}{copyrightdata};
        close COPYRIGHT;
      }
    }

    # Get the "Depends" (Requires) a la RPM.  Ish.  In case there were
    # "Requires" specified in the spec file, those would precede these.
    push @{$pkgdata{$pkg}{requires}}, getreqs("$specglobals{buildroot}/$pkg") unless $NoAutoReq;

    # Gotta do this next, otherwise the control file has nowhere to go.  >:(
    mkdir "$specglobals{buildroot}/$pkg/DEBIAN";

    # Munge things so that Debian tools don't choke on errant blank lines
    $pkgdata{$pkg}{description} =~ s/\s+$//g;	# Trim trailing blanks
    $pkgdata{$pkg}{description} =~ s/^\s+$/ ./mg;	# Replace lines consisting of " \n" with " .\n"

    # Give an estimate of the installation size
    my ($installedsize) =
      qx($specglobals{__du} -s --apparent-size $specglobals{buildroot}/$pkg) =~
        /(\d+)/;

    my $maintainer = defined $pkgdata{main}{packager} ? $pkgdata{main}{packager} : expandmacros('%{_deb_maintainer}');
    my $control = "Package: $pkgdata{$pkg}{name}\n".
                  'Version: '.format_version($pkg)."\n".
                ( defined $pkgdata{$pkg}{group} ?
                  "Section: $pkgdata{$pkg}{group}\n" : '' ).
                  "Priority: optional\n".
                  "Architecture: $pkgdata{$pkg}{arch}\n".
                  "Installed-Size: $installedsize\n".
                ( $maintainer ?
                  "Maintainer: $maintainer\n" : '' ).
                  "Description: $pkgdata{$pkg}{summary}\n$pkgdata{$pkg}{description}\n".
                ( defined $pkgdata{main}{url} ?
                  "Homepage: $pkgdata{main}{url}\n" : '' );
    foreach my $deplist (qw(recommends suggests enhances breaks replaces
                            requires conflicts provides pre-depends)) {
      if (defined $pkgdata{$pkg}{$deplist} and @{$pkgdata{$pkg}{$deplist}}) {
        my $tag = $deplist eq 'requires' ? 'depends' : $deplist;
        $tag =~ s/-depends/-Depends/;
        $control .= "\u$tag: ".join(',', do {
          my %seen; grep { !$seen{$_}++ } # uniq
          map { my ($name,$rel,$ver) = splitver($_);
            $name = lc($name);
            $name =~ tr/_/-/;
            # magic needed to properly version dependencies...
            $ver eq '0' ? $name : "$name ($rel $ver)" }
              @{$pkgdata{$pkg}{$deplist}} })."\n";
      }
    }

    open CONTROL, ">$specglobals{buildroot}/$pkg/DEBIAN/control" or die;
    print CONTROL expandmacros($control);
    close CONTROL;

    # Iff there are conffiles (as specified in the %files list(s), add'em
    # in so dpkg-deb can tag them.
    if ($pkgdata{$pkg}{conffiles}) {
      open CONFLIST, ">$specglobals{buildroot}/$pkg/DEBIAN/conffiles" or die;
      foreach my $conffile (@{$pkgdata{$pkg}{conflist}}) {
        $conffile = expandmacros($conffile);
        foreach (glob "$specglobals{buildroot}/$pkg/$conffile") {
          (my $buildroot = $specglobals{buildroot}) =~ s/([+])/\\$1/g;
          s|$buildroot/$pkg/||g;	# nrgl.  gotta be a better way to do this...
          s/\s+/\n/g;	# Not gonna support spaces in filenames.  Ewww.
          print CONFLIST "$_\n";
        }
      }
      close CONFLIST;
    }

    # found the point of scripts on subpackages.
    foreach my $scr (qw(pre post preun postun)) {
      my $scrfile = $scr;
      $scrfile .= 'inst' unless $scrfile =~ s/un/rm/;
      if ($pkgdata{$pkg}{$scr} || (($scr eq 'pre') && defined($pkgdata{$pkg}{pretrans})) ||
                                  (($scr eq 'post') && defined($pkgdata{$pkg}{posttrans}))) {
        my $content = defined($pkgdata{$pkg}{$scr}) ? expandmacros($pkgdata{$pkg}{$scr}) : '';
        if ($scr eq 'pre' and defined($pkgdata{$pkg}{pretrans})) {
          $content = expandmacros($pkgdata{$pkg}{pretrans})."\n".$content;
          warn _('Warning:  \'').'pretrans'.
               _("' is not natively supported by .deb packages.\n").
               _("Merging with 'pre' script.\n");
        }
        if ($scr eq 'post' and defined($pkgdata{$pkg}{posttrans})) {
          $content .= "\n".expandmacros($pkgdata{$pkg}{posttrans});
          warn _('Warning:  \'').'posttrans'.
               _("' is not natively supported by .deb packages.\n").
               _("Merging with 'post' script.\n");
        }
        $content =~ s/^[\s]*$//mg;
        $content = $fmo.($content ? $content : '') if $scr eq 'post' and $fmo ne '';
        next unless $content;

        # glob all %files lines if necessary
        # attow, only a rightmost '*' glob is recognized
        # more complicated replacements would require 'bsd_glob()'
        foreach my $inline (split /^/, $content) {
          next unless $inline =~ m/\*$/;
          my ($pre,$glob) = $inline =~ m/(.*\s)(\S+)/;
          my @globbed = glob("$specglobals{buildroot}$glob");
          (my $savebuildroot = $specglobals{buildroot}) =~ s/([+])/\\$1/g;
          (my $outline = $pre . join("\n$pre", @globbed) . "\n") =~
            s/$savebuildroot//mg;
          $inline =~ s/([*])/\\$1/g;
          $content =~ s/$inline/$outline/m;
        }

        open SCRIPT, ">$specglobals{buildroot}/$pkg/DEBIAN/$scrfile" or die;
        print SCRIPT expandmacros("#!%{___build_shell} %{___build_args}\n");
        print SCRIPT $content;
        close SCRIPT;
        chmod 0755, "$specglobals{buildroot}/$pkg/DEBIAN/$scrfile";
      }
    }

    $script{pkg} = "%{__fakeroot} -- %{__dpkg_deb} -b %{buildroot}/$pkg ".
        "%{_debdir}/$pkgdata{$pkg}{arch}/".format_debfile($pkg)."\n";

    execute_script('pkg', 'package-creation', _(' for ').$pkgdata{$pkg}{name});

    $finalmessages .= _('Wrote binary package ').format_debfile($pkg).
                      _(' in ')."%{_debdir}/$pkgdata{$pkg}{arch}\n";

    if ($cmdopts{sign}) {
      $script{pkg} = "%{__fakeroot} -- %{__dpkg_sig} ".
        "-s builder -k %{_gpg_key_full} ".
        "%{_debdir}/$pkgdata{$pkg}{arch}/".format_debfile($pkg)."\n";

      execute_script('pkg', 'package-signature', _(' for ').$pkgdata{$pkg}{name});

      $finalmessages .= _('Signed binary package ').format_debfile($pkg).
                        _(' in ')."%{_debdir}/$pkgdata{$pkg}{arch}\n";
    }

  } # subpackage loop
} # end binpackage()


## format_version()
# Glue together epoch/version/release in a common format
sub format_version {
  my $pkg = shift;
  return (defined $pkgdata{main}{epoch} ? "$pkgdata{main}{epoch}:" : '').
    "$pkgdata{$pkg}{version}-$pkgdata{main}{release}";
} # end format_version()


## format_debfile()
# %$&$%@#@@#%@@@ Debian and their horrible ugly package names.  >:(
sub format_debfile {
  my $pkg = shift;
  return "$pkgdata{$pkg}{name}_".format_version($pkg)."_$pkgdata{$pkg}{arch}.deb";
} # format_debfile()


## format_sdebfile()
sub format_sdebfile {
  return "$pkgdata{main}{name}-".format_version('main').'.sdeb';
} # format_sdebfile()


## splitver()
# Split un/versioned requirement
sub splitver {
  my $req = shift;
  # from rpmbuild error message
  # Dependency tokens must begin with alpha-numeric, '_' or '/'
##fixme:  check for suitable whitespace around $rel
  # We have two classes of requirements - versioned and unversioned.
  $req .= ' >= 0' unless $req =~ /[><=]/; # unversioned build requirement
  # Hack up the perl(Class::SubClass) deps into something dpkg can understand.
  # May or may not be versioned.
  # We do this first so the version rewriter can do its magic next.
  if (my ($mod,$ver) = $req =~ /^perl\(([\w:+-]+)\)\s*([><=]+.+)?/) {
    ($req = lc "lib$mod-perl") =~ s/::/-/g;
     $req .= $ver if $ver;
  }
  # Pick up the details of versioned build requirements
  my ($pkg,$rel,$ver) = $req =~ /([\w.+\-()]+)\s*([><=]+)\s*([\w:.~+-]+)/;
  $pkg =~ s/\(([^\)]+)\)/-$1/g;
  $rel =~ s/^([><])$/$1$1/;

  # We need this workaround as _ is forbidden in the package name
  #  and probably was changed to - on building such packages.
  $pkg =~ tr/_/-/;

  # Fix strict version checking by including release and epoch in case of specifying the packages currently building
  if ( $rel eq '=' ) {
    foreach my $p ( keys(%pkgdata) ) {
      if ( $ver eq $pkgdata{main}{version} ) {
        $ver = (defined $pkgdata{main}{epoch} ? "$pkgdata{main}{epoch}:" : '').$ver."-".$pkgdata{main}{release};
        last;
      }
    }
  }

  return ($pkg,$rel,$ver);
} # end splitver()


## srcpackage()
# Builds a .src.deb source package.  Note that Debian's idea of
# a "source package" is seriously flawed IMO, because you can't
# easily copy it as-is.
# Not quite identical to RPM, but Good Enough (TM).
sub srcpackage {
  my $pkgsrcname = format_sdebfile();

  # We'll definitely need this later, and *may* need it sooner.
  my $barespec = basename($specglobals{specfile});

  my $paxcmd;

  # Copy the specfile to the build tree, but only if it's not there already.
  if (abs_path($specglobals{specfile}) ne abs_path(
      expandmacros("%{_specdir}/$barespec"))) {
    $paxcmd .= "%{__cp} %{specfile} %{_specdir};\n"
  }

  # use pax -w [file] [file] ... -f outfile.sdeb
  $paxcmd .= '(cd %{_topdir}; %{__pax} -L -w ';

  # create file list:  Source[nn], Patch[nn]
  $paxcmd .= join(' ', map { s/\%\{_sourcedir}/SOURCES/; $_ } sources(),
                       map { s/\%\{_sourcedir}/SOURCES/; $_ } patches()).' ';

  # add the spec file and write to source package destination.
  $paxcmd .= "SPECS/$barespec -f %{_srcdebdir}/$pkgsrcname)";

  system(expandmacros($paxcmd)) == 0 and
  $finalmessages .= _('Wrote source package ').$pkgsrcname._(' in ')."%{_srcdebdir}.\n";
} # end srcpackage()


## checkbuildreq()
# Checks the build requirements (if any)
# Spits out a rude warning and returns a true-false error if any
# requirements are not met.
sub checkbuildreq {
  return 1 unless @buildrequires or @buildconflicts; # No use doing extra work.

  # expand macros
  my @reqlist = map { expandmacros($_) } @buildrequires;
  my @cnflist = map { expandmacros($_) } @buildconflicts;

  unless ( -e $specglobals{__dpkg_query} ) {
    warn _('**WARNING**  ').$specglobals{__dpkg_query}.
      _(" not found.  Can't check build-deps.\n").
      _("  Required for successful build:\n").join(', ', @reqlist)."\n".
      _("  Continuing anyway.\n");
    return 1;
  }

  my @missinglist;
  foreach my $req (@reqlist) {
    my ($pkg,$rel,$ver) = splitver($req);

## Apparently a package that has been installed, then uninstalled, has a "known" dpkg status of
## "unknown ok not-installed" vs a package that has never been installed which returns nothing.  O_o
## Virtual packages, of course, *also* show as "not installed" like this (WTF?)
## This causes real packages to be misdetected as installed "possible virtual packages" instead of "missing
## packages".  I don't think there's really a solution until/unless Debian's tools properly register virtual
## packages as installed.
    my ($pkgdep) = qx ( $specglobals{__dpkg_query} --showformat '\${status}\t\${version}\n' -W $pkg );
    unless ($pkgdep) {
      warn _(' * Missing build-dependency ')."$pkg!\n";
      push @missinglist, $pkg;
    } else {
# real package, installed
#kdeugau:~$ dpkg-query --showformat '${status}\t${version}\n' -W libc-client2007e-dev 2>&1
#install ok installed    8:2007f~dfsg-1
# virtual package, provided by ???
#kdeugau:~$ dpkg-query --showformat '${status}\t${version}\n' -W libc-client-dev 2>&1
#unknown ok not-installed
# real package or virtual package not installed or provided
#kdeugau:~$ dpkg-query --showformat '${status}\t${version}\n' -W libdb4.8-dbg 2>&1
#dpkg-query: no packages found matching libdb4.8-dbg

      my ($reqstat,undef,undef,$reqver) = split ' ', $pkgdep;
      if ($reqstat =~ /^unknown/) {
	# this seems to be a virtual package.
	warn _(' * Warning:  ').$pkg.
          _(" is probably installed but seems to be a virtual package.\n");
      } elsif ($reqstat =~ /^install/) {
	my ($resp) = qx ( $specglobals{__dpkg} --compare-versions $reqver '$rel' $ver && $specglobals{__echo} "ok" );
	if ($resp !~ /^ok/) {
	  warn _(' * Required build-dependency ').$pkg.
            _(' is installed, but wrong version (').$reqver.
            _('):  Need ').$ver."\n";
        }
      } else {
	# whatever state it's in, it's not completely installed, therefore it's missing.
	warn _(' * Missing build-dependency ')."$pkg!\n  $pkgdep";
        push @missinglist, $pkg;
      } # end not installed/installed check
    }
  } # end req loop

  print _(q(To install all missing dependencies, run 'apt install )).
    join(' ', @missinglist)."'.\n" if @missinglist;

  my @conflicting;
  foreach my $cnf (@cnflist) {
    my ($pkg,$rel,$ver) = splitver($cnf);

    my ($pkgdep) = qx ( $specglobals{__dpkg_query} --showformat '\${status}\t\${version}\n' -W $pkg );
    if ($pkgdep) {
      warn _(' * Conflicting build-dependency ')."$pkg!\n";
      push @conflicting, $pkg;
    }
  }

  print _(q(To remove all conflicting dependencies, run 'apt remove )).
    join(' ', @conflicting)."'.\n" if @conflicting;

  return 0 == @missinglist + @conflicting;
} # end checkbuildreq()


## getreqs()
# Find out which libraries/packages are required for any
# executables and libs in a given file tree.
# (Debian doesn't have soname-level deps;  just package-level)
# Returns an empty list if the tree contains no binaries.
# Doesn't work well on shell scripts. but those *should* be
# fine anyway.  (Yeah, right...)
sub getreqs {
  my $pkgtree = shift;

  print _("Checking library requirements...\n") if defined $specglobals{verbose};
  return () if 'all' eq $pkgdata{main}{arch}; # noarch package
  chomp( my @binlist = qx ( $specglobals{__find} $pkgtree -type f -perm /ugo=x ) );
  return () unless @binlist;

  my @reqlist;
  my $pid = open2(\*IN,\*OUT,"LANG=C $specglobals{__xargs} $specglobals{__ldd}");
  print OUT join ' ', @binlist;
  close OUT;
  @reqlist = grep { not m|^/| } <IN>;
  close IN;
  waitpid($pid,0);

  # Get the list of libs provided by this package.  Still doesn't
  # handle the case where the lib gets stuffed into a subpackage.  :/
  my @intprovlist = qx ( $specglobals{__find} $pkgtree -type f -name "*.so*" -printf "%P\n" );

  my $reqliblist;
  foreach (@reqlist) {
    next if /not a dynamic executable/;
    next if /statically linked/;
    next if m|/lib(?:64)?/ld-linux|;	# Hack! Hack!  PTHBTT!  (libc suxx0rz)
    next if /linux-(gate|vdso).so/;	# Kernel hackery for teh W1n!!1!1eleventy-one!1  (Don't ask.  Feh.)

    # Whee!  more hackery to detect provided-here libs.  Some apparently return from ldd as "not found".
    my ($a,$b) = split / => /;
    $a =~ s/\s//g;
    if ($b =~ /not found/) {
      next if qx ( $specglobals{__find} $specglobals{buildroot} -name "*$a" );
    }

    my ($req) = m|=\>\s+([\w./+-]+)|; # dig out the actual library (so)name.
    # And feh, we need the *path*, since I've discovered a new edge case where
    # the same libnnn.1.2.3 *file*name is found across *several* lib dirs.  >:(

    # Ignore libs provided by this package.  Note that we don't match
    # on word-boundary at the *end* of the lib we're looking for, as the
    # looked-for lib may not have the full soname version. (ie, it may
    # "just" point to one of the symlinks that get created somewhere.)
    next if grep { /\b$req/ } @intprovlist;

    $reqliblist .= " $req";
  }

# For now, we're done.  We're not going to meddle with versions yet.
# Among other things, it's messier than handling "simple" yes/no "do
# we have this lib?" deps.  >:(

  return unless $reqliblist; # possibly empty
  return map { m/^([\w+-.]+?):/ } qx($specglobals{__dpkg_query} -S$reqliblist);
} # end getreqs()


## install_sdeb()
# Extracts .sdeb contents to %_topdir as appropriate
sub install_sdeb {
  my $srcpkg = shift;
  die _('Can\'t install ').$srcpkg."\n" unless $srcpkg =~ /\.sdeb$/;
  $srcpkg = abs_path($srcpkg);
  system(expandmacros("cd %{_topdir}; %{__pax} -r -f $srcpkg)")) == 0 and
  $finalmessages .= _('Extracted source package ').$srcpkg.
    _(" to %{_topdir}.\n");
} # end install_sdeb()


## store_value()
# Helper function for writing to the %macro storage(s)
sub store_value {
  my ($caller, $key, $value) = @_;

  $debug_level = $value if $key eq "_debbuild_debug_level";
  vdebug("$caller: $key = $value", 5, "store_value");

  # Strip and store '%macro(options)'
  $macroopts{$key} = $1 if $key =~ s/\((.*)\)//;
  my $recipient = ( grep { lc $key eq $_ } qw(summary name version
      release epoch group copyright url packager) ) ?
    \$pkgdata{main}{$key} : \$specglobals{$key};
  if (defined $value) {
    chomp $value; # strip newline from 'macros' input
    # strip asymmetrical closing braces
    my $unmatched = (() = $value =~ m/}/g) - (() = $value =~ m/{/g);
    $value =~ s/}{$unmatched}$// if 0 < $unmatched;
    # fast vs. lazy expansion
    $$recipient = $caller eq 'global' ? expandmacros($value) : $value;
  } else { # delete table entry
    $$recipient = undef;
  }
} # end store_value()


## expandmacros()
# Expands all %{blah} macros in the passed string
sub expandmacros {
  my $s = shift;
  my $r = '';
  my $orig = $s;
  vdebug($s, 1, "expandmacros/input");
  return '' unless defined($s);
  sub expd_tocomplex {
    my ($macro, $params) = @_;
    return "%$macro $params" if $macro =~ /\A(description|dir|doc|exclude|ghost|package|if(?:n?arch|)|else|endif|post(?:un)?|pre(?:un)?)\z/
                                          or not defined($macroopts{$macro});
    return "%{$macro $params}";
  }
  $s =~ s/(?:\A|\R)\s*?%(define|undefine|global)\s+(\S+)\s+(.*)/store_value($1,$2,$3);''/eg;
  $s =~ s/(\A|\R[ \t]*)%([a-zA-Z_]\w+)[ \t]+(.*)/$1.expd_tocomplex($2, $3)/eg;
  my $l = length $s;
  sub expd_simple {
    my $m = shift;
    my $o = $m;
    my $macroparms = {'#' => 0};
    foreach my $ms ( @macropsstk ) {
      $macroparms = $ms;
      last if $macroparms->{'#'};
    }
    if ( $m =~ /\A(\d+|#|\*{1,2})\z/ ) {
      $m = defined($macroparms->{$1}) ? $macroparms->{$1} : '';
    } elsif ( $m eq 'dump' ) {
      $m = dump_macros();
    } elsif ( $m eq 'optflags' ) {
      $m = ($pkgdata{main}{arch} and $optflags{$pkgdata{main}{arch}}) ?
           $optflags{$pkgdata{main}{arch}} : '';
    } elsif ( $m eq 'getconfdir' ) {
      $m = $specglobals{_prefix}."/lib/debbuild";
    } elsif ( $m eq 'sources' ) {
      $m = join ' ', sources();
    } elsif ( $m eq 'patches' ) {
      $m = join ' ', sources();
    } elsif ( $m eq 'source' ) {
      $m = "%{_sourcedir}/".$pkgdata{main}{source};
    } elsif ( $m =~ /^source(\d+)/i ) {
      $m = defined($pkgdata{sources}{$1}) ? "%{_sourcedir}/".$pkgdata{sources}{$1} : '';
    } elsif ( $m =~ /^(patch\d+)/i ) {
      $m = defined($pkgdata{main}{$1}) ? "%{_sourcedir}/".$pkgdata{main}{$1} : '';
    } elsif ( defined($specglobals{$m}) ) {
      my $macro = $m;
      $m = $specglobals{$m};
      if ( $m =~ /\A%\{lua:/ ) {
        my $tst = $m;
        $tst =~ s/\A%//;
        if ( defined(extract_bracketed($tst, '{}')) ) {
          $m =~ s/\A%\{lua:\s+//;
          $m =~ s/\}\s*\z//;
          my %macroparms = ();
          $macroparms{0} = $macro;
          $macroparms{'#'} = 0;
          $macroparms{'**'} = $macroparms{'*'} = '';
          unshift @macropsstk, \%macroparms;
          $m = lua_macro($m);
          shift @macropsstk;
        }
      }
    } elsif ( defined($pkgdata{main}{$m}) ) {
      $m = $pkgdata{main}{$m};
    } else {
      $m = '%'.$m;
    }
    vdebug($o, 5, "expandmacros/simple/in");
    my $i = scalar @macropsstk;
    vdebug("Parameterized macro stack: [".($i)."]", 7, "expandmacros/simple/stack");
    foreach my $ms ( @macropsstk ) {
      vdebug("[$i] ".$ms->{'0'}." / ".$ms->{'#'}.": ".$ms->{'**'}, 7, "expandmacros/simple/stack");
      $i--;
    }
    vdebug($m, 5, "expandmacros/simple/out");
    return ($m eq $o or $m eq '%'.$o) ? $m : expandmacros($m);
  }
  sub expd_complex {
    my $m = shift;
    my $o = $m;
    my ($qex, $macro, $value);
    my $macroparms = {'#' => 0};
    foreach my $ms ( @macropsstk ) {
      $macroparms = $ms;
      last if $macroparms->{'#'};
    }
    if ( ($macro,$qex) = $m =~ /\A\{\??(\d+|#|\*{1,2}|\-\w)(\*?)\}\z/ ) {
      $m = defined($macroparms->{$macro}) ? (($macro =~ /\A\-/ and $qex ne '*') ? $macro : $macroparms->{$macro}) : '';
    } elsif ( ($qex,$macro,$value) = $m =~ /\A\{([?!]*)(\d+|#|\*{1,2}|\-\w\*?)(?::(.+))\}\z/ ) {
      $value //= (defined($macroparms->{$macro}) ? $macroparms->{$macro} : '');
      $value = '' unless defined($macroparms->{$macro}) xor $qex =~ /!/; # equivalence
      $m = expandmacros($value);
    } elsif ( ($qex,$macro,$value) = $m =~ /\A\{([?!]+)(\w+)(?::(.+))?\}\z/m ) {
      $value //= ($specglobals{$macro} or '');
      $value = '' unless $specglobals{$macro} xor $qex =~ /!/; # equivalence
      $value = '' if $macro eq 'verbose' and defined $specglobals{$macro}; # shut up!
      $m = expandmacros($value);
    } elsif ( my ($prefix,$arg) = $m =~ /\A\{(\w+):(.*)\}\z/s ) {
      if ( $prefix eq 'lua' ) {
        my %macroparms = ();
        $macroparms{0} = '_ANONYMOUS_MACRO_';
        $macroparms{'#'} = 0;
        $macroparms{'**'} = $macroparms{'*'} = '';
        unshift @macropsstk, \%macroparms;
        $m = lua_macro($arg);
        shift @macropsstk;
      } elsif ( $prefix eq 'url2path' or $prefix eq 'u2p' ) {
        $arg = expandmacros($arg);
        $arg =~ s|\w+://[\w.:-]+||;
        $m = $arg;
      } elsif (grep {$prefix eq $_} qw(basename dirname uncompress)) {
        no strict qw(refs); # we use strings as function refs
        $m =  expandmacros(&$prefix($arg));
      } elsif ($prefix eq 'suffix') {
        my (undef,undef,$suffix) = fileparse($arg,qr/\.[^.]*/);
        $m = $suffix;
      } elsif ($prefix eq 'getenv') {
        # support '%{getenv:HOME}' alongside '%(echo $HOME)'.
        $m = defined($ENV{$arg}) ? $ENV{$arg} : '';
      } elsif (grep { $prefix eq $_ } qw(expand quote)) {
        # helper for parametrized macros and quoted macro arguments
        $m = expandmacros($arg);
      } elsif ($prefix eq 'shrink') {
        # trim leading, trailing, and intermediate whitespace
        $arg =~ s/^\s+|\s+//g; $arg =~ s/\s+/ /g;
        $m = $arg;
      } elsif ($prefix eq 'verbose') {
        # 'positive verbosity'
        $m = defined $specglobals{$prefix} ? $arg : '';
      } elsif ($prefix eq 'S') {
        $m = expd_simple('source'.$arg);
      } elsif ($prefix eq 'P') {
        $m = expd_simple('patch'.$arg);
      }
    } elsif ( my ($macra,$spc,$args) = $m =~ /\A\{(\w+)(\s+)(.+)\}\z/s ) {
      $m = expandmacros(handle_macro_options("%$macra $args"));
    } elsif ( my ($smpl) = $m =~ /\A\{\$?([a-z_]\w*)\s*\}\z/i ) {
      $m = expd_simple($smpl);
    }
    vdebug($o, 5, "expandmacros/complex/in");
    my $i = scalar @macropsstk;
    vdebug("Parameterized macro stack: [".($i)."]", 7, "expandmacros/complex/stack");
    foreach my $ms ( @macropsstk ) {
      vdebug("[$i] ".$ms->{'0'}." / ".$ms->{'#'}.": ".$ms->{'**'}, 7, "expandmacros/complex/stack");
      $i--;
    }
    vdebug($m, 5, "expandmacros/complex/out");
    return ($m eq $o) ? '%'.$m : $m;
  }
  sub expd_exec {
    my ($c) = @_;
    my $r = '';
    $c =~ s/\\\$/\$/g;
    $c =~ s/\\\\n/\\n/g;
    open(my $ch, '-|', $build_shell, '-c', $c) or return $r;
    while ( <$ch> ) {
      $r .= $_;
    }
    close($ch);
    chomp($r);
    return $r;
  }
  while ( $l ) {
    if ( $s =~ /%+/ ) {
      $r .= $`;
      $s = $';
      my $qs = $&;
      my $ql = length $qs;
      $l -= length($`) + $ql;
      $r .= '%' x ($ql-1);
      next if $ql > 1;
      if ( $s =~ /\A[\w\*\#]+/ ) {
        my $m = $&;
        $s = $';
        $l -= length $m;
        if ( $m =~ /\A(description|dir|doc|exclude|ghost|package|if(?:n?arch|)|else|endif|post(?:un)?|pre(?:un)?)\z/ ) {
          $r .= "%".$m;
        } else {
          $r .= expd_simple($m);
        }
      } elsif ( $s =~ /\A\{/ ) {
        my $m = '{';
        $s = $';
        my $tr;
        do {
          if ( $s =~ /\}/ ) {
            $m .= $`.$&;
            $s = $';
            my $tst = $m;
            $tr = defined(extract_bracketed($tst, '{}'));
            if ( $tr ) {
              $r .= expd_complex($m);
              $l -= length $m;
            }
          } else {
            $r .= '%'.$m;
            $l -= length $m;
            $tr = 1;
          }
        } until $tr;
      } elsif ( $s =~ /\A\(/ ) {
        my $m = '(';
        $s = $';
        my $tr;
        do {
          if ( $s =~ /\)/ ) {
            $m .= $`.$&;
            $s = $';
            my $tst = $m;
            $tr = defined(extract_bracketed($tst, '()'));
            if ( $tr ) {
              $m =~ s/\A\(//;
              $m =~ s/\)\z//;
              $r .= expd_exec(expandmacros($m));
              $l -= length $m;
            }
          } else {
            $r .= '%'.$m;
            $l -= length $m;
            $tr = 1;
          }
        } until $tr;
      } else {
        $r .= '%';
      }
    } else {
      $r .= $s;
      $l = 0;
      $s = '';
    }
  }
  vdebug($orig, 5, "expandmacros/in");
  vdebug($r, 5, "expandmacros/out");
  return $r;
} # end expandmacros()


## handle_macro_options()
# Option handling for '%macro(ino:pts)'.
# Note that 'getopts()' normally works on '@ARGV', so we have to pull some
# tricks to make it work with 'string input'.
sub handle_macro_options {
  my $inline = shift;
  my ($macro,$argv) = $inline =~ /%(\w+)(?:\s+(.+))?/s;
  if ( not defined($macroopts{$macro}) ) {
    return expandmacros("%{$macro} $argv");
  }
  $argv = expandmacros($argv);
  vdebug("$macro | $argv / $inline", 5, "handle_macro_options/in");
  if ( $macro eq 'if' ) {
    chomp( my $expr = expandmacros($argv) );
    if ($expr =~ /^[\d\s<=>&|\(\)+-]+$/) {
      # "plain" numeric expressions are evaluated as-is, except
      $expr =~ s/(\D)0(\d+)/$1$2/g; # shortcut 0%{?ubuntu} == 1204
    } else {
      # Done in this order so we don't cascade incorrectly.
      # Yes, those spaces ARE correct in the replacements!
      $expr =~ s/==/ eq /g;
      $expr =~ s/!=/ ne /g;
      $expr =~ s/<=>/ cmp /g;
      $expr =~ s/<=/ le /g;
      $expr =~ s/>=/ ge /g;
      $expr =~ s/</ lt /g;
      $expr =~ s/>/ gt /g;
    }
    return (eval $expr or 0);
  }
  local @ARGV = split ' ',$argv if $argv;
  my $argc = scalar @ARGV;
  my %options = (); # store result of 'getopts()'
  my @nonoptions = (); # store all 'other' arguments
  while (@ARGV) { # separate options and non-options
    push @nonoptions, shift @ARGV while @ARGV and $ARGV[0] !~ m/^-/;
    my $ac = scalar @ARGV;
    getopts($macroopts{$macro},\%options) if $macroopts{$macro};
    push @nonoptions, shift @ARGV if $ac and $ac == scalar @ARGV;
  }
  my %macroparms = ();
  $macroparms{0} = $macro;
  for my $i (1..@nonoptions) { # fill '%{i}' parameters
    $macroparms{$i} = $nonoptions[$i-1];
  }
  $macroparms{'**'} = $argv;
  $macroparms{'*'} = join(' ', @nonoptions);
  $macroparms{'#'} = $argc;
  foreach my $f ( keys %options ) {
    vdebug("$f = ".$options{$f}, 5, "handle_macro_options/flag");
    $macroparms{'-'.$f} = $options{$f};
  }
  unshift @macropsstk, \%macroparms;
  vdebug($macro.": ".$argv, 5, "handle_macro_options/expanding/".(scalar @macropsstk));
  my $m = $specglobals{$macro};
  if ( $m =~ /\A%\{lua:/ ) {
    my $tst = $m;
    $tst =~ s/\A%//;
    if ( defined(extract_bracketed($tst, '{}')) ) {
      $m =~ s/\A%\{lua:\s+//;
      $m =~ s/\}\s*\z//;
      $m = lua_macro($m);
    } else {
      $m = expandmacros($m);
    }
  } else {
    $m = expandmacros($m);
  }
  shift @macropsstk;
  vdebug($m, 5, "handle_macro_options/ret");
  return $m;
} # end handle_macro_options()


sub lua_get {
  my ($v, $d) = @_;
  my $r;
  eval('$r = '.$v);
  return defined($r) ? $r : $d;
}


sub lua_traceback  {
  my ($L) = @_;
  return 1
    if (! $L->isstring(1));  # 'message' not a string? keep it intact
  $L->getfield(lua_get('Lua::API::GLOBALSINDEX'), "debug");
  if (! $L->istable(-1)) {
    $L->pop(1);
    return 1;
  }
  $L->getfield(-1, "traceback");
  if (! $L->isfunction(-1)) {
    $L->pop(2);
    return 1;
  }
  $L->pushvalue(1);          # pass error message
  $L->pushinteger(2);        # skip this function and traceback
  $L->call(2, 1);            # call debug.traceback
  return 1;
}


sub lua_print {
  my ($L) = @_;
  my $n = $L->gettop();
  my $dbg = 'UNDEF';
  if ( @macropsstk and $debug_level >= 7 ) {
    $dbg = $macropsstk[0]->{0};
  }
  for ( my $i = 1; $i <= $n; $i++ ) {
    my $p = $L->tostring($i);
    vdebug($p, 7, "lua_print/$n/$i/$dbg/$lstk[0]");
    $lstk[0]->{stdout} .= ($i >1 ? "\t" : "").$p;
  }
}


sub lua_vdebug {
  my ($L) = @_;
  my $n = $L->gettop();
  if ( $n >= 3 ) {
    my $msg = $L->tostring(1);
    my $vbl = $L->tointeger(2);
    my $tag = $L->tostring(3);
    vdebug($msg, $vbl, "lua/".$tag);
  } else {
    vdebug("Not enough parameters", 3, "lua/vdebug");
  }
}


sub lua_rpm_expand {
  my ($L) = @_;
  my $p = $L->checkstring(1);
  my $r = expandmacros($p);
  $r =~ s/\\n/\n/g;
  $r =~ s/\n /\n/g;
  $L->pushstring($r);
  vdebug($p, 4, "lua_rpm_expand/in");
  vdebug($r, 4, "lua_rpm_expand/out");
  return 1;
}


sub lua_rpm_define {
  my ($L) = @_;
  my $p = $L->tostring(1);
  vdebug($p, 4, "lua_rpm_define");
  if ( my ($macro,$eq,$value) = $p =~ /^(\w+(?:\([^)]*\))?)(=|\s*)(.+)$/ ) {
    store_value('define', $macro, $value);
  }
  return 0;
}


sub lua_posix_getcwd {
  my ($L) = @_;
  my $r = getcwd();
  $L->pushstring($r);
  vdebug($r, 4, "lua_posix_getcwd");
  return 1;
}


sub lua_posix_stat {
  my ($L) = @_;
  my $n = $L->gettop();
  if ( $n < 2 ) {
    $L->pushnil();
    return 1;
  }
  my $f = $L->tostring(1);
  my $p = $L->tostring(2);
  my %c = (
    'dev'     =>  0, 'ino'     =>  1, 'mode'    =>  2,
    'nlink'   =>  3, 'uid'     =>  4, 'gid'     =>  5,
    'rdev'    =>  6, 'size'    =>  7, 'atime'   =>  8,
    'mtime'   =>  9, 'ctime'   => 10, 'blksize' => 11,
    'blocks'  => 12
  );
  my @r = stat($f);
  if ( not @r ) {
    vdebug("$f / $p => FILE NOT FOUND", 4, "lua_posix_stat");
    $L->pushnil();
    return 1;
  }
  my $r = defined($c{$p}) ? $r[$c{$p}] : undef;
  vdebug("$f / $p => @r ($p: ".(defined($r) ? $r : "UNKNOWN").")", 4, "lua_posix_stat");
  if ( not defined($r) ) {
    $L->pushnil();
    return 1;
  }
  $L->pushinteger($r);
  return 1;
}


sub lua_pmain {
  my ($L)  = @_;
  my $m = $lstk[0]->{m};
  my $st = $L->loadstring($m);
  if ( $st == 0 ) {
    my $base = $L->gettop();            # function index
    $L->pushcfunction(\&lua_traceback); # push traceback function
    $L->insert($base);                  # put it under chunk and args
    $st = $L->pcall(0, 0, $base);
    $L->remove($base);                  # remove traceback function
  }
  if ($st && !$L->isnil(-1)) {
    my $msg = $L->tostring(-1);
    $msg = "(error object is not a string)" if ! defined $msg;
    print(STDERR "Lua Error: ".$msg."\n");
    $lstk[0]->{error} = 1;
    $L->pop(1);
  }
  return 0;
}


sub lua_init {
  my $lsh = lua_get('Lua::API::State->new()');
  if ( $lsh ) {
    my $L = $lsh->open();  # create state
    if (! defined $L ) {
      vdebug("Lua Error: Cannot create state: not enough memory!", 3, "lua_init");
      print(STDERR "Lua Error: Cannot create state: not enough memory!\n");
      return;
    }
    $L->openlibs;
    $L->register("print", \&lua_print);
    $L->register("vdebug", \&lua_vdebug);
    my %rpm_lib = ('expand' => \&lua_rpm_expand,
                   'define' => \&lua_rpm_define);
    $L->register("rpm", \%rpm_lib);
    my %posix_lib = ('getcwd' => \&lua_posix_getcwd,
                     'stat'   => \&lua_posix_stat);
    $L->register("posix", \%posix_lib);
    return $L;
  } else {
    vdebug("Lua Error: Unable to open Lua::API::State!", 3, "lua_init");
    print(STDERR "Lua Error: Unable to open Lua::API::State!\n");
  }
  return;
}


sub lua_macro {
  my ($m) = @_;
  unless ( $lua_present ) {
    print(STDERR "WARNING: Lua module not loaded! The following macro is omitted:\n".
                  $m."\n# end of the ommited macro\n");
    return '';
  }
  unless ( defined($gL) ) {
    $gL = lua_init();
  }
  return '' unless defined($gL);
  my $r = {m => $m, stdout => ''};
  unshift @lstk, $r;
  my $st = $gL->cpcall(\&lua_pmain, undef);
  shift @lstk;
  $r->{stdout} =~ s/\s+\z//s;
  if ( $debug_level >= 7 ) {
    vdebug($r->{stdout}, 7, "lua_print/out/$r");
    vdebug("Lua macro (in):\n".$m."\n# end of the macro", 7, "lua_macro/in");
    if ( @macropsstk ) {
      my $i = scalar @macropsstk;
      vdebug("Parameterized macro stack: [".($i)."]", 7, "lua_macro/stack");
      foreach my $ms ( @macropsstk ) {
        vdebug("[$i] ".$ms->{'0'}." / ".$ms->{'#'}.": ".$ms->{'**'}, 7, "lua_macro/stack");
        $i--;
      }
    }
    vdebug("Lua macro (out):\n".$r->{stdout}."\n# end of the macro out", 7, "lua_macro/out");
  }
  exit(16) if $r->{error};
  return $r->{stdout};
}


=pod

=encoding utf8

=head1 NAME

debbuild — Build Debian-compatible .deb packages from RPM .spec files

=head1 COPYRIGHT

=over

=item 2005-2015 © Kris Deugau <L<kdeugau@deepnet.cx>>

=item 2015-2019 © Andreas Scherer L<https://ascherer.github.io/>

=item 2015-2019 © Neal Gompa L<ngompa13@gmail.com>

=item 2017-2019 © Datto, Inc. L<https://datto.com>

=item 2020-2021 © Victor Zhestkov L<vzhestkov@suse.com>

=back

=head1 SHORT DESCRIPTION

=over

=item Build .deb packages from RPM-style .spec files.

=item debbuild supports most package-building options rpmbuild does.

=back

=head1 OPTIONS

Build options with [ <specfile> | <tarball> | <source package> ]:

  -b.                        build from <specfile> ...
  -t.                        build from <tarball> ...
  -r.                        build from <source package> ...
        -.p      ... through %prep (unpack sources and apply patches)
        -.c      ... through %build (%prep, then compile)
        -.i      ... through %install (%prep, %build, then install)
        -.l      verify %files section
        -.a      ... source and binary packages
        -.b      ... binary package only
        -.s      ... source package only
  --rebuild (-rb)            build binary package from <source package>
  --recompile (-ri)          build through %install from <source package>
  --buildroot=DIRECTORY      override build root
  --short-circuit            skip straight to specified stage (only c,i)

Common options:

  -D, --define='MACRO EXPR'  define MACRO with value EXPR
  --with/--without FLAG      define build conditionals from FLAG
  -S, --scm=SCM              short for '--define "__scm SCM"'

debbuild-specific options:

  -i, --install              Unpack a .sdeb in the %_topdir tree
  --showpkgs                 Show package names that would be built.
  --nobuild                  Parse <specfile>, but do no processing

=head1 DESCRIPTION

B<debbuild> attempts to build Debian-friendly semi-native packages from RPM spec files, RPM-friendly tarballs, and RPM source packages (.src.rpm files).  It accepts I<most> of the options B<rpmbuild> does, and should be able to interpret most spec files usefully.  Perl modules should be handled via CPAN+dh-make-perl instead as it’s simpler than even tweaking a .spec template.

As far as possible, the command-line options are identical to those from B<rpmbuild>, although several B<rpmbuild> options are not supported:

 --clean
 --rmsource
 --rmspec
 --target

Some of these could probably be trivially added.  Feel free to send me a patch.  ;)

Complex spec files will most likely I<not> work well, if at all.  Rewrite them from scratch – you’ll have to make heavy modifications anyway.

If you see something you don’t like, mail me.  Send a patch if you feel inspired.  I don’t promise I’ll do anything other than say “Yup, that’s broken” or “Got your message”.

The source package container I invented for B<debbuild>, the .sdeb file, can be installed with C<debbuild -i> exactly the same way as a .src.rpm can be installed with C<rpm -i>.  Both will unpack the file and place the source(s) and .spec file in the appropriate places in %_topdir/SOURCES and %_topdir/SPECS respectively.

=head1 ASSUMPTIONS

As with B<rpmbuild>, B<debbuild> makes some assumptions about your system.

=over 4

=item *

Either you have rights to do as you please under /usr/src/debian, or you have created a file F<~/.debmacros> containing a suitable “%_topdir” definition.

Both B<rpmbuild> and B<debbuild> require the directories B<%_topdir/{BUILD,SOURCES,SPECS}>.  However, where B<rpmbuild> requires the B<%_topdir/{RPMS,SRPMS}> directories, B<debbuild> requires B<%_topdir/{DEBS,SDEBS}> instead.  Create them in advance; I<some> subdirectories are created automatically as needed, but most are not.

=item *

B</var/tmp> must allow script execution – B<rpmbuild> and B<debbuild> both rely on creating and executing shell scripts for much of their functionality.  By default, B<debbuild> also creates install trees under B</var/tmp> – however this is (almost) entirely under the control of the package’s .spec file.

=item *

If you wish to B<--rebuild> a .src.rpm file, your B<%_topdir> for both B<debbuild> and B<rpmbuild> must either match, or be suitably symlinked one direction or another so that both programs are effectively working in the same tree.  (Or you could just manually wrestle files around your system.)

You could symlink F<~/.rpmmacros> to F<~/.debmacros> (or vice versa) and save yourself some hassle if you need to rebuild .src.rpm packages on a regular basis.

=back

=head1 ERRATA

B<debbuild> deliberately does a few things differently from B<rpmbuild>.

=head2 Finding out what packages should be built (--showpkgs)

B<rpmbuild> does not include any convenient method I know of to list the packages a spec file will produce.  Since I needed this ability for another tool, I added it.

It requires the .spec file for the package, and produces a list of full package filenames (without path data) that would be generated by one of B<--rebuild>, B<-ta>, B<-tb>, B<-ra>, B<-rb>, B<-ba>, or B<-bb>.  This includes the .sdeb source package.

=head1 AUTHOR

B<debbuild> was written by Kris Deugau.  The present version was developed by Andreas Scherer, Neal Gompa, and others. It is available at L<http://github.com/debbuild/debbuild>.

=head1 BUGS

Funky Things Happen if you forget a command-line option or two.  I’ve been too lazy to bother fixing this.

Many macro expansions are supported, some are incompletely supported, some not at all.

The generated scriptlets don’t quite match those from B<rpmbuild> exactly.  There are extra environment variables and preprocessing that I haven't needed (yet).

Documentation, such as it is, will likely remain perpetually out of date (in which way it follows in RPM’s tradition).

%_topdir and the five “working” directories under %_topdir could arguably be created by B<debbuild>.  However, B<rpmbuild> doesn't create these directories either.

=head1 SEE ALSO

rpm(8), rpmbuild(8), and pretty much any document describing how to write a .spec file.

=cut
__DATA__
# Build-time configuration added by the Makefile:
version:21.01.0
debconfigdir:/usr/lib/debbuild
sysconfdir:/etc

