#!/usr/bin/perl -w
# $Id: deb2tgz,v 1.12 2003/02/07 03:27:44 Tony Borras <tonyb@sysdev.org>$
# Author:	Mike Taylor, <mike@miketaylor.org.uk>
# Modified for linuxTheTools by Tony Borras, <tonyb@sysdev.org>

# deb2tgz - convert a Debian Linux .deb file to a Slackware Linux .tgz
#
# This is a hack based only on my eyeball inspection of a single .deb
# file (scottfree_1.14-5_i386.deb) and not on a deep understanding of
# the format.  However, so far as I can tell, here's how it works:
#
# First line -- file header: "!<arch>" or similar
# Multiple blocks -- each one, a header line followed by data
#	Header line -- <filename> <num1> <num2> <num3> <mode> <len>
#	Data -- <len> bytes of data
# We want the block called "data.tgz"
#
# This naive algorithm seems to work on the other .deb files that I've
# tested it on, so I'm happy enough with it:
#	libapache-reload-perl_0.07-1_all.deb
#	libogg0_1.0.0-1_i386.deb
#	abiword_1.0.2+cvs.2002.06.05-1_i386.deb

use strict;
use IO::File;

$0 =~ s@.*/@@;
my $verbose = "";

if (@ARGV == 0) {
    print STDERR "Usage: $0 [-v] <deb-file> [<deb-file> ...]\n";
    exit(1);
}

FILE: foreach my $filename (@ARGV) {
    if ($filename eq "\-v") {
	$verbose = "1";
	next FILE;
    }

    if ($filename !~ /\.deb$/) {
	print "$0: ignoring '$filename' (not a .deb)\n";
	next;
    }

    print "$0: converting '$filename' ...\n";
    my $fh = new IO::File("<$filename")
	or die "$0: not found: '$filename' $!";

    <$fh>;			# discard file-header line
    my $data = join('', <$fh>);
    $fh->close();

    while ($data) {
	my $header;
	($header, $data) = ($data =~ /(.*?)\n(.*)/s);
	my($name, $num1, $num2, $num3, $num4, $len) = split /\s+/, $header;

        if ($verbose eq "1") {
	    print "header='$header'\nname='$name', len=$len\n\n";
        }

	if ($name eq "data.tar.gz") {
	    # Found it
	    $data = substr($data, 0, $len);
	    $filename =~ s/\.deb$/.tgz/;
	    my $fh = new IO::File(">$filename")
		or die "can't write '$filename': $!";
	    print $fh $data;
	    $fh->close();
	    print "$0: wrote '$filename'\n";
	    next FILE;
	}

        if ($verbose eq "1") {
	  print "$0: skipping section '$name'\n";
        }

	if (substr($data, $len, 1) eq "\n") {
	    $len++;
	}

	$data = substr($data, $len);
    }
}

# Done.
