#!/usr/bin/perl -w
#
# $Id: apt-build 572 2005-04-23 21:30:14Z acid $
# 
# (c) 2002-2005 Julien Danjou <acid@debian.org>
# (c) 2003 Davor Ocelic <docelic@linux.hr> (apt-build rewrite)
# (c) 2004 Alexander Ehlert <ehlert@linux.de> (implemented buildsource)
#
#
# This package 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; version 2 dated June, 1991.
#
# This package 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 package; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.
#

#
# The comments in the script have been made verbose on purpose, to help new
# developers get the grip on apt-build and Perl in general.
#

use strict;
use warnings;
use AppConfig qw/:expand :argcount/;
use Fatal qw/chdir open/;                           # see Fatal
use Env qw/@PATH $APT_BUILD_WRAPPER/;               # perldoc Env 
use AptPkg::Config qw/$_config/;                    # see libapt-pkg-perl
use AptPkg::System qw/$_system/;                    #
use AptPkg::Version;
use AptPkg::Source;
use AptPkg::Cache;


# Initial
my $VERSION = "unreleased";
my ($conf, %conf, @builddep, @apt_args);

@apt_args = qw/--yes/;     # and DEFAULT => 1, down in parse_config()

my @actions = qw/install source remove info update upgrade world build_source update_source
		clean_sources build_repository clean_build clean_repository moo find/;       # possible actions

$\ = "\n";                 # automatic newline after each print()

# Ok, we start here... 
parse_config() or die "Can't parse config\n"; # all config-related

my $cmd = shift or help(); # if no command specified, help is called and we exit
$cmd =~ s/-/_/g;           # replace all "-" in command name with "_"
@_ = @ARGV;                # For the "&$cmd" call, few lines below

-d $conf->build_dir or die "--build-dir must be a valid directory!\n";
chdir $conf->build_dir;    # use Fatal qw/chdir/ above takes care for this

# Initialize libapt now after basic checks were okay
$_config->init;
$_system = $_config->system;
$_config->{quiet} = 2;
my $_cache = new AptPkg::Cache;
my $_version = $_system->versioning;
my $_source = new AptPkg::Source $conf->sources_list;

# 'no strict' makes it possible that we call "&$cmd" (so, if the user 
# specifies command 'source', we call sub source).
# As an additional verification step, command name must be listed in @actions
# (if we didn't check that, the script would break with non-friendly message).
# The whole work is then done in some of the functions listed below.
# Also, the whole block is surrounded by { and }, so that 'no strict' would
# be turned back to 'strict' at the exit of the block automatically.
# And note the way we use to call the function; we say "&$cmd" (prefixed with
# '&' and having no closing parentheses) - that will automatically make contents
# of our @_ variable available to called functions (and we did @_ = @ARGV above)
{ no strict 'refs'; help() unless grep {/^$cmd$/i} @actions; &$cmd }

exit 0;

# END # (helpers below)
#############################################################################


# Ok, let's serve the simple subroutines first
sub help {
print "Usage: apt-build [options] [command] <package>

Commands:
  update            - Update package lists
  upgrade           - Perform an upgrade
  install           - Build and install new packages
  source            - Download and extract source in build directory
  build-source      - Download, extract and build source package
  update-source     - Update all sources and rebuild them
  remove            - Remove packages
  build-repository  - Rebuild the repository
  clean-sources     - Clean up all object files in source directories
  clean-build       - Erase downloaded packages and temporary build files
  clean-repository  - Erase downloaded packages and temporary build files
  world             - Rebuild and reinstall all packages on your system
  info              - Build-related package information

Options:
  --reinstall       - Re-build and install already installed package
  --rebuild         - Rebuild package
  --remove-builddep - Remove build-dependencies installed by apt-build
  --nowrapper       - Do not use gcc/g++ wrapper
  --purge           - Use purge instead of remove
  --noupdate        - Do not run 'apt-get update' before package installation
  --build-command   - Use <command> to build package
  --patch <file>    - Apply patch <file>s before the build
  --patch-strip     - Striplevel for the patch files
  --yes         -y  - Assume yes
  --version     -v  - Show version and exit
  --source          - Do not download source (sources are extracted already)
  --build-only      - Do not install any of build dependencies or <package>
  --build-dir       - Specify build dir
  --repository-dir  - Specify the repository directory
  --target-release  - Distribution to fetch packages from
  --sources-list    - Specify sources.list file

";
exit 1
}

# Since shell returns 0 on success, and our script usually uses true values
# for the same, we use "!" here to invert the result - shell's success (0)
# becomes our success (1)
sub patch {
	print STDERR "-----> Patching (@_) <-----";
	!system "patch -p$conf{patch_strip} < $_" or return while $_ = shift;
}

sub clean_build {
	print STDERR "-----> Cleaning the build tree <-----";
	!system "rm -rf $conf{build_dir}/*"
}

sub remove {
	print STDERR "-----> Removing packages (@_)<-----";
	!system "apt-get @apt_args remove @_"
}

sub update {
	print STDERR "-----> Updating package lists <-----";
	!system "apt-get @apt_args update"
}

sub move_to_repository {
	print STDERR "-----> Moving packages to repository <-----";
	!system "mv $conf{build_dir}/*.deb $conf{repository_dir}"
}


# Find out [source] package download locations
# If called in void context, print to screen; otherwise return array
sub find {
	local $" = ", ";
	my @res;
 	for my $pkg (@_) {
		my @seen; # Skip multiple entries for the same pkg version
		my @list = $_source->find($pkg);
		for (@list) {
			my $ver = $$_{Version};
			grep {/$ver/} @seen and next; # Skip if seen
			push @seen, $ver;
			unless (defined wantarray) { # If we're called in void context
				print "Source: @$_{'Package','Section','Version','Maintainer'}";
				print "Binaries: @{$$_{Binaries}}";
			}
			my @files = @{ $$_{Files} };
			for (@files) {
				my $type = ucfirst $$_{Type};
				!defined wantarray?
					print "$type: $$_{ArchiveURI}" :
					push @res, $$_{ArchiveURI};
			}
			print '';
		}
		print '';
	}
	return @res if defined wantarray;
	1
}


sub info {
	my @size;

	for (@_) {
		my $pkg = $_;

		# (full explanation for read_apt_list is below)
		# We invoke apt-get here to determine package size
		push @size,
			read_apt_list("apt-get --print-uris @apt_args source $pkg |",
			"^'", \&extract_size);

		# and to determine package dependencies, and their cumulative size
		my (@size_deps, @deps);
		read_apt_list("apt-get --print-uris @apt_args build-dep $pkg |",
			"^'", sub {
				push @size_deps, extract_size($_);
				push @deps, extract_name($_);
			});

		# print summary
		my $sumsize = 0;
		$sumsize += $_ for @size;
		print "Package: $pkg";
		print "Source-size: $sumsize";
		$sumsize = 0;
		$sumsize += $_ for @size_deps;
		print "Depends-size: $sumsize";
		print "Depends: @deps ";
	}
	1
}

sub source
{
	my $pkg = shift or return;
	my ($srcpkg, $srcver, @packages);

	# apt-get here prints lines, we pick the one talking about .deb file.
	read_apt_list("apt-get --print-uris @apt_args source $pkg |", "^'",
		sub {
			my ($n, $v) = extract_dsc($_) or return;
			($srcpkg, $srcver) = ($n, $v)
		});
	
	$srcpkg and $srcver or die 
		"No source versions available for $pkg\n";

	# And we retrieve the same information from apt-cache.
	# (XXX this info from 'apt-cache show' is from old source, I dont know why.
	# Since the test is made, I just added a print() if versions are not equal)
	my $new; # set to 1 if versions from here and above are not the same.
	my $oldver = $srcver;

	read_apt_list("apt-cache show $pkg |", "^Source:",
		sub {
		if (/^Source: (.+) \((.+)\)$/ && !$new)
			{ $srcpkg = $1; $srcver = $2; $new = 1 }
		if (/^Source: (.+)$/ && !$new)
			{ $srcpkg = $1; $new = 1 }
		}
		);
	$new = 0 if $srcver eq $oldver;

	print STDERR "-----> Downloading $pkg source ($srcpkg $srcver) <-----";
	print STDERR "Taking version $srcver over $oldver\n" if $new;

	update() if $conf->update; # to be consistent with install()
	!system "apt-get @apt_args source ${srcpkg}=${srcver}"
}

sub build
{
	@_ == 3 or return;
	my ($pkg, $upver, $maintver) = @_;
	my ($control, @packages, $srcpkg, $srcver, $upverchdir, $new);

	print STDERR "-----> Building $pkg <-----";

	chdir $conf{build_dir};

	read_apt_list("apt-get --print-uris @apt_args install $pkg |", "^'",
		sub {
			my ($n, $v) = extract_deb($_) or return;
			($srcpkg, $srcver) = ($n, $v)
		});

	my $oldver = $srcver;
	read_apt_list("apt-cache show $pkg |", "^Source:",
		sub {
	if (/^Source: (.+) \((.+)\)$/ && !$new)
		{ $srcver = $2; $srcpkg = $1; $new = 1 }
	if (/^Source: (.+)$/ && !$new)
		{ $srcpkg = $1; $new = 1 }
		}
	);
	$new = 0 if $srcver eq $oldver;

	read_apt_list(
		"apt-get --print-uris @apt_args source $srcpkg=".$srcver." |",
		"^'", sub {
			my ($n, $v) = extract_dsc($_) or return;
			# remove epoch
			$v =~ s/^\d+://;
			# remove Debian revision
			$v =~ s/^(.*)-.+$/$1/;
			($srcpkg, $upverchdir) = ($n, $v);
		});

	chdir "$srcpkg-$upverchdir";

	# Add an entry in changelog 
	system "debchange --append 'Built by apt-build'";
	for (@{$conf->patch}) {
		my $p = qx[basename $_];
		chomp $p;
		system "debchange --append 'Patched with $p'";
	}

	# Patch if asked
	patch($_) for @{$conf->patch};

	# Add optimizations infos
	my $buildoptions;
	$buildoptions = "Build options: ".
		$conf->Olevel." ".$conf->mcpu." ".$conf->options;
	
	system "debchange --append \"$buildoptions\"";
	
	# Now build
	my  $r = !system $conf->build_command;
	
	if ($conf->cleanup) {
		print STDERR "----> Cleaning up object files <-----";
		system "debian/rules clean";
	}
	
	chdir $conf{build_dir};
	
	$r
}


sub build_repository
{
	print STDERR "-----> Building repository <-----";

	chdir $conf->repository_dir;
	my $arch=qx[dpkg --print-architecture]; chomp $arch;

	system "ln -s . main" unless -e "main";
	system "ln -s . apt-build" unless -e "apt-build";
	system "ln -s . dists" unless -e "dists";
	system "ln -s . binary-$arch" unless -e "binary-$arch";
	make_release_file() unless -e "Release";

	system "apt-ftparchive packages . | gzip -9 > Packages.gz";
	chdir $conf->build_dir;
	1
}

sub make_release_file
{
	my $release;
	open RELEASE, "< /usr/share/apt-build/Release";
	while (<RELEASE>) {
		my $arch = qx[dpkg --print-architecture]; chomp $arch;
		s/__arch__/$arch/;
		$release .= $_;
	}
	close RELEASE;
	open RELEASEREPO, "> $conf{repository_dir}/Release";
	print RELEASEREPO $release;
	close RELEASEREPO;
	1
}

sub clean_repository
{
	print STDERR "-----> Cleaning the repository <-----";
	if($conf->repository_dir)
	{
		(! system("rm -fr $conf{repository_dir}/*.deb")) or die "Error: $!\n";
	}
	else
	{
		die "Error: what is repository_dir ?";
	}
}

sub builddep
{
	my $pkg = shift or return;

	if ($conf->remove_builddep) {
		read_apt_list("apt-get --print-uris @apt_args build-dep $pkg |",
			"^'", \&extract_name);
	}

	print STDERR "-----> Installing build dependencies (for $pkg) <-----";
	!system "apt-get @apt_args build-dep $pkg"
}

sub install
{   
	my (@packages, @pkgs, $buildpkg);
	my (@pkglist) = @_;
	my $nopkgs_okay = 0;

	for (@_) {
		my $pkg = $_;
		open APTIN, "apt-get --print-uris @apt_args install $pkg |"; #2>&1 |

		AI: while (<APTIN>) {
			if ( /^Package .* is a virtual package provided by/ ) {
				system("apt-get @apt_args install $pkg");
				exit 0;

			} elsif ( /^\'(http|ftp|file|cdrom)/ ) {
				@packages = split /\s+/;
				$packages[1] =~ /^(.*)_(.*)_(.*)\.deb$/ or warn; # XXX
				my ($buildpkg, $version, $arch) = ($1, $2, $3);

				my $stripver; # What the hell was that?
				my $pkgstriped = "";

				if ( ($stripver) = ($version =~ /\%3a(.*)$/) ) {
					$pkgstriped = "${buildpkg}_${stripver}_${arch}.deb";
				} else {
					$pkgstriped = "${buildpkg}_${version}_${arch}.deb";
				};


				if ( $arch =~ /^all$/ ) { # If arch: all, no build needed
					print "Package $buildpkg does not need to be rebuilt";
					$nopkgs_okay++;

				} elsif ( -f "$conf{build_dir}/$packages[1]"
				&& !($conf->rebuild) ) {

					print "Package $buildpkg already built.";
					push(@pkgs, $packages[1]);
					move_to_repository(@pkgs);
					build_repository();

				} elsif ( -f "$conf{repository_dir}/$packages[1]"
				&& !($conf->rebuild) ) {

					print "Package $buildpkg already in repository.";
					push @pkgs, $packages[1];

				} elsif ( -f "$conf{repository_dir}/$pkgstriped"
				&& !($conf->rebuild) ) {

					print "Package $buildpkg already in repository.";
					push @pkgs, $packages[1];

				} else {
					push @pkgs, $packages[1];
					wait;

					builddep($buildpkg) unless $conf->build_only;
					source($buildpkg) if $conf->source;

					# Now build the package
					my ($maintver, $upver);
					if ( $version =~ /(.*)(-.*)$/) {
						($upver, $maintver) = ($1, $2)
					} else {
						($upver) = ($version)
					}

					$upver =~ s/%3a/:/;
					if (build($buildpkg, $upver, $maintver)) {
						&move_to_repository(@pkgs);
						&build_repository;
					} else {
						warn "Error while building $pkg!\n" ; 
						pop @pkgs;
					}
				}
			}
		}
		close APTIN;
		wait;

		unless (@pkgs or $nopkgs_okay) {
			print STDERR "Sorry, can't find $pkg, is it already installed?";
			print STDERR "(Remove it first, or try running 'apt-get clean')"
		}
	}

	wait;

	# Remove builddep if asked
	remove(@builddep) if $conf->remove_builddep && !($conf->build_only);

	# If we have something to install, install
	if( @pkgs && !($conf->build_only) ) {
		update() if $conf->update;
		system("apt-get -t apt-build @apt_args install @pkglist");
	}
	1
}

sub build_source
{   
	my (@packages, @pkgs, $buildpkg);
	my (@pkglist) = @_;
	my $nopkgs_okay = 0;

	for (@_) {
		my $pkg = $_;
		open APTIN, "apt-get --print-uris @apt_args source $pkg |"; #2>&1 |

		AI: while (<APTIN>) {
			if ( /^Package .* is a virtual package provided by/ ) {
				system("apt-get @apt_args install $pkg");
				exit 0;

			} elsif ( /^\'(http|ftp|file|cdrom)/ ) {
				@packages = split /\s+/;
				$packages[1] =~ /^(.*)_(.*)\.dsc$/ or last; # XXX
				my ($buildpkg, $version) = ($1, $2);
				my $arch=qx[dpkg --print-architecture]; chomp $arch;
				
				my $apcout = qx[apt-cache showsrc $pkg | grep "^Binary:" | head -1]; 
				chomp $apcout;
				my $fullversion = qx[apt-cache showsrc $buildpkg | grep "^Version:" | head -1]; 
				chomp $fullversion;
				$fullversion =~ s/Version: //;
				my $build = 1;
				$apcout =~ s/(Binary: |,)//g;
				my @genpackages = split / /,$apcout;
				print "Building the following packages from source: ";
				#my $missing = 0; Some packages are architecture depend, 
				#		  so not everything is built
				foreach my $gpkg (@genpackages)  { 
					print $gpkg; 
										
					if ((( -f "$conf{repository_dir}/${gpkg}_${version}_${arch}.deb") ||
					    ( -f "$conf{repository_dir}/${gpkg}_${version}_all.deb" ))
					&& !($conf->rebuild) ) {
						print "Package $buildpkg already in repository.";
						$nopkgs_okay++;
						$build = 0;
					}
				#	if (!( -f "$conf{repository_dir}/${gpkg}_${version}_${arch}.deb") &&
				#	    !( -f "$conf{repository_dir}/${gpkg}_${version}_all.deb" )) {
				#	        print "Package $buildpkg missing in repository.";
				#		print "Trying to rebuild.";
				#		$missing = 1;
				#	}
				#	last if $missing;
				}
				wait;
				#if ($missing) { $build=1; };
				if ($build) {
					builddep($buildpkg) unless $conf->build_only;
					source($buildpkg) if $conf->source;
					patch($_) for @{$conf->patch};

					# Now build the package
					my ($maintver, $upver);
					if ( $fullversion =~ /(.*)(-.*)$/) {
						($upver, $maintver) = ($1, $2)
					} else {
						($upver) = ($fullversion)
					}
					
					$upver =~ s/%3a/:/;
					if (build($buildpkg, $upver, $maintver)) {
						&move_to_repository;
						&build_repository;
						$nopkgs_okay++;
					} else {
						warn "Error while building $pkg!\n" ; 
					}
				}
			}
		}
		close APTIN;
		wait;

		unless ($nopkgs_okay) {
			print STDERR "Some error occured building package";
		}
	}

	wait;

	# Remove builddep if asked
	remove(@builddep) if $conf->remove_builddep && !($conf->build_only);

	# If we have something to install, install
	if( @pkgs && !($conf->build_only) ) {
		update() if $conf->update;
		system("apt-get -t apt-build @apt_args install @pkglist");
	}
}

sub update_source 
{
	chdir $conf->build_dir;
	
	print STDERR "-----> Updating sources <-----";
	
	open DSCIN, "find *.dsc|";

	while (<DSCIN>) {
		chomp $_;
		my $pkg=$_;
		$pkg =~ /^(.*)_(.*)\.dsc/ or warn;
		my ($buildpkg, $version) = ($1, $2);
		my $newversion = qx[apt-cache showsrc $buildpkg | grep "^Version:" | head -1]; chomp $newversion;
		$newversion =~ s/Version: //;
		$newversion =~ s/[0-9]://;
		if ($newversion ne $version) {
			print "New version for $pkg available.";
			print "Updating from $version to $newversion";
		} else {
			print "$buildpkg-$version is up to date.";
		}
		build_source($buildpkg);
	}

	close DSCIN;
}

sub clean_sources
{
	chdir $conf->build_dir;
	
	print STDERR "-----> Cleaning sources <-----";
	
	open DSCIN, "find *.dsc|";

	while (<DSCIN>) {
		chomp $_;
		my $pkg=$_;
		$pkg =~ /^(.*)_(.*)\.dsc/ or warn;
		my ($buildpkg, $version) = ($1, $2);
		$version =~ s/-[0-9]$//;
		
		print "${buildpkg}-${version}";
		if (-d "${buildpkg}-${version}") {
			chdir "${buildpkg}-${version}";
			print STDERR "----> Cleaning up object files <-----";
			print STDERR "Package $buildpkg";
			system "debian/rules clean";
			chdir $conf->build_dir;
		}
	}

}

sub world
{
	print STDERR "-----> Rebuilding the world! <-----";
	print STDERR "-----> Building package list <-----";
	die "Please read README.Debian first.\n" if ! -e "/etc/apt/apt-build.list";
	open IGNORELIST, "< /etc/apt/apt-build.list";
	while(<IGNORELIST>)
	{
		my $p = $_;
		chomp($p);
		install($p);
	}	
	close IGNORELIST;
	1
}

sub upgrade
{
	print STDERR "-----> Upgrading (@_) <-----";
	@_ or @_ = read_apt_list(
			"apt-get --print-uris @apt_args upgrade |", "^'", \&extract_name);

	@_ ? install(@_) : print STDERR "No packages need to be upgraded";
	1
}

# the funny characters here are color sequences, to look nice when printed on
# the terminal ;)
sub moo
{
    print << "EOM";
         (__)    \e[32m~\e[0m
         (oo)   /
     _____\\/___/
    /  /\\ / /
   \e[32m~\e[0m  /  \e[33m*\e[0m /
     / ___/
*----/\\
    /  \\
   /   /
  ~    ~
..."Have you danced today? Discow!"...
EOM
}

#sub change_version
#{
#	$_ = shift;
#	$_ =~ s/^(.*_)(.*%3a)?(.*)(_.*\.deb)$/$1$3\.0$4/;
#	return($_);
#}


# The core of our config is the AppConfig module (available from CPAN).
# The whole $conf = AppConfig->new() block is related to AppConfig. So, see
# perldoc AppConfig for more. (AppConfig is very well documented and the man
# page is easy to understand).
sub parse_config
{   
	$conf = AppConfig->new(
		{
			CASE => 1,
			DEBUG => 0,
			CREATE => 0,
			GLOBAL => {
				ARGCOUNT => ARGCOUNT_NONE,
				DEFAULT => 0,
			}
		},
		# ALIAS =>, so imperfect and universe-breaking, and we still need it.
		"config|cfg=s",       { DEFAULT => "/etc/apt/apt-build.conf" },
		"remove_builddep!",   { ALIAS => "remove-builddep" },
		"wrapper!",           { DEFAULT => 0 },
		"purge!",             { ACTION => \&apt_args_modify },
		"build_command=s",    { DEFAULT=> "dpkg-buildpackage -b -us -uc",
		                        ALIAS => "build-command" },
		"reinstall|r!",       { ACTION => \&apt_args_modify },
		"yes|y!",             { ACTION => \&apt_args_modify, DEFAULT => 1 },
		"patch=s@",           { },
		"patch_strip=i",    { DEFAULT => 1, ALIAS => "patch-strip", ALIAS => "p" },
		"target-release|t=s", { ACTION => \&apt_args_modify },
		"source!",            { DEFAULT => 1 },
		"build_only!",        { ALIAS => "build-only" },
		"rebuild!",           { DEFAULT => 0 },
		"build_dir=s",        { DEFAULT => "/var/cache/apt-build/build/",
		                        ALIAS => "build-dir" },
		"repository_dir=s",   { DEFAULT => "/var/cache/apt-build/repository/",
		                        ALIAS => "repository-dir" },
		"sources_list=s",     { ACTION => \&apt_args_modify,
		                        DEFAULT => "/etc/apt/sources.list",
		                        ALIAS => "sources-list" },
		"update!",            { DEFAULT => 1 },
		"cleanup!",           { DEFAULT => 1 }, # call debian/rules clean after build
		"Olevel=s",           {},
		"mcpu=s",             {},
		"options=s",          {},
		"make_options=s",          {},
		"version",            {
			ACTION => sub { print "apt-build version $VERSION"; exit 0 }
		},
	) or die "Can't initialize the AppConfig object\n";

	tie %conf, 'AptBuild::ObjHash', \$conf; # see AptBuild::ObjHash below

	$conf->file($conf->cfg) if -r $conf->cfg;   # read the config file
	$conf->getopt;                              # parse command line

	$APT_BUILD_WRAPPER++ unless $conf->wrapper; # define ENV var
	unshift @PATH, "/usr/lib/apt-build/" unless $conf->wrapper;
	1
}


# Okay, this is the core of the script. (Note that this will be abandoned
# when we switch to libapt-pkg-perl (since we won't call external commands any
# more), but it's still worth explaining:
# You pass the script three arguments:
# 1 - command to execute
# 2 - output pattern filter
# 3 - subroutine to parse lines
# So basically, read_apt_list runs a command ("apt-get ...something" usually),
# then it discards the output lines which do not match $pattern, and it calls
# &$handler function for each remaining line to extract results.
# Filtering can be done in the handler function as well, but this pre-filter
# step is just a small convenience.
# The trick is that $handler is a function reference, which can be specified
# by either passing \&func_name as argument, or by including the whole 
# subroutine directly, in-place as the 3rd argument.
# The info() function has an example of both (passing a reference and specifying
# sub{} in-place).
# This greatly simplifies things because we concentrate on functionality, and
# don't have to bother with opening & closing files, etc.
# The return value of read_apt_list (if you want to use it) is an array
# containing all non-empty results from invocation of $&handler.
sub read_apt_list {
	my ($line, $pattern, $handler) = @_;
	my @results;
	open IN, "$line";
	while (local $_ = <IN>) {
		if (/$pattern/i) { local $_ = &$handler(); push @results, $_ if $_ }
	}
	close IN;
	return @results
}


# self-explanatory, those functions take apt-get output as input and
# try to extract information.
sub extract_name { ($_ = (split /\s+/)[1]) =~ s/_.*// if /_/; $_ }

sub extract_filename { return (split /\s+/)[1] }

sub extract_size { return (split /\s+/)[2] }
	
sub extract_dsc {
	my $t = (split /\s+/)[1]; 
	$t =~ /^(.+)_(.+)\.dsc$/ or return;
	my $n = $1; ( my $v = $2 ) =~ s/%3a/:/;
	($n, $v)
}

sub extract_deb {
	my $t = (split /\s+/)[1]; 
	$t =~ /^(.+)_(.+)_(.+)\.deb$/ or return;
	my $n = $1; ( my $v = $2 ) =~ s/%3a/:/;
	($n, $v)
}

# This function modifies @apt_args (either adds or removes arguments
# from it).
sub apt_args_modify {
	my ($self, $name, $value) = @_;

	if (!( $self->{ARGCOUNT}->{$name} )) { # if option takes no argument
		if ($value) { push @apt_args, "--$name" }
		else { @apt_args = grep {!/^--$name$/} @apt_args }

	} elsif ($self->{ARGCOUNT}->{$name} == ARGCOUNT_ONE) { # or if takes 1 arg
		@apt_args = grep {!/^--$name /} @apt_args; # just to be sure
		
		# special parsing for --sources-list
		if($name =~ /^sources.list$/)
		{	$name = "-oDir::Etc::SourceList=$value"; }
 		else
		{ $name = "--$name $value"; }

		push @apt_args, "$name";
	}
}


# This fine chunk "extends" the AppConfig object. In addition to doing
# $conf->variable and $conf->variable(value), it's now possible to do:
# $conf{variable} and $conf{variable} = value
# This is very handy inside strings, because this would be invalid:
#  print "$c->build_dir" (inside strings, the -> has no special meaning).
# But thanks to AptBuild::ObjHash, we can get the intended results with:
#  print "$c{build_dir}" (which is a valid syntax). 
# For more info on how it all works, perldoc perltie
package AptBuild::ObjHash;

use strict;
use warnings;

use base qw/Tie::Hash/;

sub TIEHASH {
    return 0 unless ref $_[1];
    return bless [ $_[1] ] => $_[0]
}

sub FETCH {
    my ($self, $key) = @_;
    return ${@$self[0]}->get("$key")
}

sub STORE {
    my ($self, $key, $val) = @_;
    return ${@$self[0]}->set("$key", $val)
}

