pacoball

About: Paco (pacKAGE oRGANIZER) is a simple, yet powerful tool to aid package management when insta

#!/usr/bin/perl
#----------------------------------------------------------------------
# pacoball - Binary package support for paco.
#----------------------------------------------------------------------
# This file is part of the package paco
# Copyright (C) 2004-2007 David Rosal <[e-mail]>
# For more information visit http://paco.sourceforge.net
#----------------------------------------------------------------------
# vim:ts=4

use Cwd;
use warnings;
use strict;
use Getopt::Long;
use File::Copy;

Getopt::Long::Configure("no_ignore_case", "bundling");

my $me = "pacoball";
my $verbose = '';
my $expand = '';
my $zip = "bzip2";
my $level = 9;
my $force = '';
my $all = '';
my $tmp = "/tmp/$me.$$";
my $logdir = '';
my ($version, $root, $dir, $extract, $use_paco, $fakeroot, $test);


sub help
{
print <<EOF;
$me - Creates binary packages from installed (and logged by paco) packages

Usage:
  $me [-bgfxtv] [-d DIR] [-1..9] [-a|<packages>]
  $me -e [-ltv] [-C DIR] [-r DIR] <pacoballs>
  $me [-Vh]

General options:
  -t, --test           Test compressed file integrity.
  -v, --verbose        Increase output messages.
  -V, --version        Display version information.
  -h, --help           Display this help message.
  
Package creation options:
  -a, --all            Create a pacoball for each logged package.
  -d, --directory=DIR  Create the pacoballs in directory DIR (default is '.').
  -b, --bzip2          Compress with bzip2 (default).
  -g, --gzip           Compress with gzip.
  -<1..9>              Compression level (speed/quality balance).
      --fast           Like -1: Compress faster.
      --best           Like -9: Compress better (default).
  -f, --force          Force overwrite of existing output files.
  -x, --expand         Expand the command line package names (as in paco).
  
Package extraction options:
  -e, --extract        Extract the pacoballs, into directory / by default.
  -C, --root=DIR       Extract the files into DIR (as the -C tar option).
  -l, --log            Log the extraction with paco.
  -r, --fakeroot=DIR   With '-l': Remove leading DIRs from the logged files, and
                       log the package in DIR/LOGDIR.

Note:
  Leading '/' are stripped from the filenames in the pacoballs.
  
Author:
  David Rosal <david.3r\@gmail.com>
EOF
exit(0);
}


sub try_help
{
	my $msg = shift;
	$msg and warn("$me: $msg\n");
	die("Try '$me --help' for more information.\n");
}


sub checkdir
{
	my $dir = shift;
	$$dir =~ s/(.)\/*$/$1/;
	(-f $$dir) and die("$me: $$dir: not a directory.\n");
	if (!-d $$dir)
		{ mkdir($$dir) or die("$me: mkdir(\"$$dir\"): $!\n"); }
	(-w $$dir) or die("$me: $$dir is not writable.\n");
}


sub check_arg
{
	my $opt = shift;
	my $switch = shift;
	(defined $opt && !$opt)
		and &help("option -$switch requires an argument");
	return $opt;
}


sub get_logdir
{
	my $pacorc = "";
	
	my $prefix = `pkg-config --variable=prefix paco 2>/dev/null`;
	chomp($prefix) and $prefix =~ s/^\/$//;  # avoid $prefix = "/"
	for ($prefix, "", "/usr") {
		if (-e "$_/etc/pacorc") {
			$pacorc = "$_/etc/pacorc";
			last;
		}
	}
	
	if (open(PACORC, "< $pacorc")) {
		while (<PACORC>) {
			if (/^LOGDIR=(.+[^\n])/) {
				$logdir = $1;
				last;
			}
		}
		close(PACORC);
	}
	
	($logdir && -d $logdir)
		or $logdir = `pkg-config --variable=logdir paco 2>/dev/null`;
	chomp($logdir);
	(-d $logdir) or $logdir = "/var/log/paco";
}


# Check for paco, and get the version
$version = `paco --version`	or exit(1);
$version =~ s/^paco-//;

# Command line arguments
GetOptions(
	'h|help'			=> \&help,
	'd|directory:s',	=> \$dir,
	'C|root|prefix:s',	=> \$root,
	'r|fakeroot:s',		=> \$fakeroot,
	'e|extract',		=> \$extract,
	'l|log',			=> \$use_paco,
	't|test'			=> \$test,
	'V|version'			=> sub { print("$me-$version");	exit(0); },
	'v|verbose'			=> sub { $verbose = "--verbose"; },
	'x|expand'			=> sub { $expand = "--expand"; },
	'b|bzip2'			=> sub { $zip = "bzip2"; },
	'g|gzip'			=> sub { $zip = "gzip"; },
	'f|force'			=> sub { $force = "--force"; },
	'a|all'				=> sub { $all = "--all"; },
	'1|fast'			=> sub { $level = 1; },
	'2'					=> sub { $level = 2; },
	'3'					=> sub { $level = 3; },
	'4'					=> sub { $level = 4; },
	'5'					=> sub { $level = 5; },
	'6'					=> sub { $level = 6; },
	'7'					=> sub { $level = 7; },
	'8'					=> sub { $level = 8; },
	'9|best'			=> sub { $level = 9; }
) or &try_help;

&check_arg($dir, "d") or $dir = getcwd();
&check_arg($root, "C") or $root = "/";
&get_logdir;
if (&check_arg($fakeroot, "r")) {
	$logdir = $fakeroot . $logdir;
	$fakeroot =~ s/\/+/\//g;
}

$SIG{'INT'} = $SIG{'QUIT'} = sub { unlink("$tmp"); exit(1); };


#-------------------#
# Extract pacoballs #
#-------------------#

if ($extract) {
	
	@ARGV or &try_help("no input pacoballs.");	
	&checkdir(\$root);
	
	foreach (@ARGV) {
		if (!-e $_) {
			warn("$me: $_: no such file.\n");
			next;
		}
		elsif (!/([^\/]*).paco\.tar\.(bz2|gz)$/ || !$1) {
			warn("$me: $_: this does not look like a pacoball. Skipping.\n");
			next;
		}
		elsif ($test) {
			$zip = /\.gz$/ ? "gzip" : "bzip2";
			system("$zip --test $_") == 0 or last;
		}
		my $exclude = "";
		if (!$use_paco and !/^paco-/) {
			$exclude = "--exclude=" . substr($logdir, 1) . "/*";
		}
		my $cmd = "tar -C $root $verbose $exclude -xf $_";
		if ($use_paco) {
			$cmd = "paco --log --logdir=$logdir --append --package=$1 \"$cmd\"";
		}
		system("$cmd");
		
		if ($fakeroot) {
			my $log = "$logdir/$1";
			if (!open(LOG, $log)) {
				warn("$me: open(\"$log\"): $!\n");
				next;
			}
			open(TMP, "> $tmp") or die("$me: open($tmp): $!\n");
			my $line;
			while ($line = <LOG>) {
				$line =~ s/^(-|)$fakeroot/$1/;
				print(TMP $line);
			}
			close(TMP);
			close(LOG);
			copy($tmp, $log) or die("$me: copy($tmp, $log): $!\n");
		}
	}
}


#------------------#
# Create pacoballs #
#------------------#

else {

	(@ARGV || $all) or &try_help("no input packages.");

	my @pkgs = `paco --one-column $expand $verbose $all @ARGV` or exit(1);
	chomp(@pkgs);

	&checkdir(\$dir);

	for (@pkgs) {
		my @files = `paco --no-package-name --files $_`;
		chomp(@files);
		open(TMP, "> $tmp") or die("$me: open(\"$tmp\"): $!\n");
		my $empty = 1;
		for (@files) {
			if (-e $_) {
				print(TMP "$_\n");
				$empty = 0;
			}
		}
		print(TMP "$logdir/$_\n");
		close(TMP);
		if ($empty) {
			warn("$me: $_: no files installed.\n");
			next;
		}
		my $tar = "$dir/$_.paco.tar";
		my $ball = ($zip eq "gzip") ? "$tar.gz" : "$tar.bz2";
		system("tar -cf $tar --files-from=$tmp 2>/dev/null");
		system("$zip -$level $verbose $force $tar");
		if ($test) {
			system("$zip --test $ball") == 0 or last;
		}
	}
}

unlink("$tmp");