#!/usr/bin/perl -w

#########################################################################
#                                                                       #
#                  Create Uninstall Script for Archive                  #
#                 Copyright (C) 2002-07, John Zaitseff                  #
#                                                                       #
#########################################################################

# Author:  John Zaitseff <J.Zaitseff@zap.org.au>
# Date:    7th March, 2007
# Version: 1.5

# The mkuninst script takes an archive file (possibly compressed) and
# creates an uninstall shell script for it.  The script thus produced
# removes files and directories that would be installed by the archive
# file.
#
# Syntax:
#    mkuninst [--prefix=DIRNAME | --no-prefix] [--stdout | --output=OUTFILE |
#        --to-files] [--help] [--version] FILENAME ...
#
# where the following options exist:
#     -p, --prefix=DIRNAME       - Don't delete the prefix directories
#                                  created by the archive (this is the
#                                  default, using the directory
#                                  "/usr/local").
#     -P, --no-prefix            - Attempt to delete all directories
#                                  created by the archive, including any
#                                  prefix directories.
#     -c, --stdout, --to-stdout  - Send the (single) uninstall shell
#                                  script to standard output (the
#                                  default).
#     -o, --output=OUTFILE       - Send the (single) uninstall shell
#                                  script to "OUTFILE".
#     -F, --to-files             - Send the (possibly multiple) uninstall
#                                  shell scripts to files having the same
#                                  basename as the input archives.
#     -h, --help                 - Show a command-line summary.
#     -V, --version              - Show program version information.
#
# and where "FILENAME" is an archive file (".tar", ".tar.gz", ".tgz",
# ".tar.bz2", ".tbz2" or ".tbz" extensions are supported).  If
# "--to-files" is specified, the output files are created with the
# extension replaced by ".uninstall".


# This program, including associated files, is free software.  You may
# distribute 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.,
# 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA


#########################################################################
# Configuration parameters and default values

use strict;				# Enforce better programming habits

(our $O = $0)          =~ s,^.*/,,;	# Script name (without path)
our $version           = "1.5";		# Script version

# Programs and options needed for this script to function

our @tar_prog          = ("/bin/tar", "t");
our @cat_prog          = ("/bin/cat");
our @zcat_prog         = ("/bin/gzip", "-dc");
our @bzcat_prog        = ("/bin/bzip2", "-dc");

# Important constants

our $stdout            = "-";		# Standard output "filename"
our $script_suffix     = ".uninstall";	# Suffix for individual scripts
our @prefix_subdirs    =		# Subdirectories not to be deleted,
    ("bin", "etc", "include", "info",	# if $use_prefixdir is 0.
     "lib", "man", "sbin", "share", "src");

# Default values

our $def_prefixdir     = "/usr/local";	# Don't delete this directory
our $def_use_prefixdir = 1;		# 1 = Use $prefixdir, 0 = don't

our $def_out_filename  = $stdout;	# Default output, "-" = stdout
our $def_single_out    = 1;		# 1 = single file output, 0 = multiple

# Other constants

our $is_cat   = 1;			# Uncompressed archive
our $is_gzip  = 2;			# GNU gzip-compressed archive
our $is_bzip2 = 3;			# Bzip2-compressed archive

our %archive_type = (			# The type of archive, based on the
    ".tar"     => $is_cat,		# file extension
    ".tar.gz"  => $is_gzip,
    ".tgz"     => $is_gzip,
    ".tar.bz2" => $is_bzip2,
    ".tbz2"    => $is_bzip2,
    ".tbz"     => $is_bzip2,
    );

our %use_prog = (			# The program to use, based on type
    $is_cat   => "@cat_prog",
    $is_gzip  => "@zcat_prog",
    $is_bzip2 => "@bzcat_prog",
    );

# Function prototypes

sub showusage();
sub showversion();
sub showcmdlerr(@);
sub chkparam($);
sub quoteifspaces($);
sub create_output();
sub remember_dir($);
sub process_dirs();


#########################################################################
# Initialise global variables

our $prefixdir     = $def_prefixdir;	# Prefix directory to ignore
our $use_prefixdir = $def_use_prefixdir;# Use $prefixdir or not
our $out_filename  = $def_out_filename;	# Output script filename
our $single_out    = $def_single_out;	# Single output or not

our $in_filename;			# Input filename
our $file_type;				# Type of archive file
our $process_cmdl;			# Processing command line

our %archive_dirs;			# Directories seen in archive


#########################################################################
# Process command-line arguments

while ($_ = $ARGV[0]) {
    last if (! /^-/);
    shift @ARGV;
    last if ($_ eq '--');

    # Split combined short-form options into single arguments
    if (/^-(\w{2,})/) {
        my @args = split //, $1;

        foreach my $arg (@args) {
            $arg = "-$arg";
        }
        unshift @ARGV, @args;
        next;
    }

    # Process command-line options

    if (($_ eq "--prefix") || ($_ eq "-p")) {
	chkparam($_);
	$prefixdir = shift @ARGV;
	$use_prefixdir = 1;
    } elsif ($_ =~ /^--prefix=(.*)$/) {
	$prefixdir = $1;
	$use_prefixdir = 1;
    }

    elsif (($_ eq "--no-prefix") || ($_ eq "-P")) {
	$use_prefixdir = 0;
    }

    elsif (($_ eq "--stdout") || ($_ eq "--to-stdout") || ($_ eq "-c")) {
	$out_filename = $stdout;
	$single_out = 1;
    }

    elsif (($_ eq "--output") || ($_ eq "-o")) {
	chkparam($_);
	$out_filename = shift @ARGV;
	$single_out = 1;
    } elsif ($_ =~ /^--output=(.*)$/) {
	$out_filename = $1;
	$single_out = 1;
    }

    elsif (($_ eq "--to-files") || ($_ eq "-F")) {
	$out_filename = undef;
	$single_out = 0;
    }

    elsif (($_ eq "--help") || ($_ eq "-h") || ($_ eq "-?")) {
	showusage();
    }

    elsif (($_ eq "--version") || ($_ eq "-V")) {
	showversion();
    }

    else {
	showcmdlerr("Unrecognised option: $_");
    }
}

# Remove leading or trailing "/" from prefix directory
$prefixdir =~ s,^/,,g;
$prefixdir =~ s,/$,,g;

# Check that the programs needed actually exist

if (! -x $tar_prog[0])   { die "$O: $tar_prog[0] not executable\n"; }
if (! -x $cat_prog[0])   { die "$O: $cat_prog[0]: $!\n"; }
if (! -x $zcat_prog[0])  { die "$O: $zcat_prog[0] not executable\n"; }
if (! -x $bzcat_prog[0]) { die "$O: $bzcat_prog[0] not executable\n"; }

# Check that all filenames given are valid archives

foreach $_ (@ARGV) {

    # Check if the file actually exists
    if (! -f $_) {
	die "$O: $_: $!\n";
    }

    # Check if the extension is supported
    my $ok = 0;
    foreach my $i (keys %archive_type) {
	if (substr($_, -length($i)) eq $i) {
	    $ok = 1;
	    last;
	}
    }
    if (! $ok) {
	die "$O: $_: Unrecognised file extension\n";
    }
}


#########################################################################
# Main program

# Create the script file, if it is to be a single file
if ($single_out) {
    %archive_dirs = ();
    create_output();
}

foreach $in_filename (@ARGV) {

    # Determine the type of archive (and output filename, if needed)
    foreach my $i (keys %archive_type) {
	my $len = length($i);
	if (substr($in_filename, -$len) eq $i) {
	    $file_type = $archive_type{$i};
	    if (! $single_out) {
		$out_filename = substr($in_filename, 0, -$len) 
		    . $script_suffix;
	    }
	    last;
	}
    }

    # Create the output script file, if it is to be an individual file
    if (! $single_out) {
	%archive_dirs = ();
	create_output();
    }

    # Open the archive and process it
    $process_cmdl = $use_prog{$file_type} . " " . quoteifspaces($in_filename)
	. " | @tar_prog";

    open(PROCESS, "-|", $process_cmdl) or die "$O: Processing: $!\n";
    while (<PROCESS>) {
	chomp;

	# Push the directory portion of the filename onto the stack
	remember_dir($_);

	if (! /\/$/) {
	    # The archive creates a file: remove it
	    # Directories are removed later
	    print OUTPUT "rm " . quoteifspaces($_) . "\n";
	}
    }

    close(PROCESS);

    if (! $single_out) {
	process_dirs();
	close(OUTPUT);
    }
}

if ($single_out) {
    process_dirs();
    close(OUTPUT);
}


#########################################################################
# Check that the next command-line argument is a valid parameter

sub chkparam ($) {
    my $arg = $_[0];
    if (! $ARGV[0] || ($ARGV[0] =~ /^-/)) {
        showcmdlerr("Missing argument for $arg");
    }
}


#########################################################################
# Show an error message relating to the command-line and terminate

sub showcmdlerr(@) {
    map { warn "$O: $_\n" } @_;

    die "\nUsage:\n" .
	"    $O [--prefix=DIRNAME | --no-prefix] [--stdout | " .
	  "--output=OUTFILE |\n" .
	"        --to-files] [--help] [--version] FILENAME ...\n";
}


#########################################################################
# Check filename for spaces and quote appropriately

sub quoteifspaces($) {
    my $fn = $_[0];

    if ($fn =~ /\s/) {
	return "\"" . $fn . "\"";
    } else {
	return $fn;
    }
}


#########################################################################
# Open the output script file and print the header portion 

sub create_output() {
    # Global variables: $single_out, $in_filename, $out_filename, OUTPUT

    open(OUTPUT, ">$out_filename") or die "$O: $out_filename: $!\n";
    if (-f OUTPUT) {
	chmod(0755, $out_filename) or die "$O: $out_filename: $!\n";
    }

    print OUTPUT <<"DATAEND"
#!/bin/sh

# This script was automatically generated by $O to uninstall the
# contents of an archive file.  Please note that you need to change to the
# directory you used to install the archive (usually \"/\") BEFORE you run
# this script.

DATAEND
	;
    if ($single_out) {
	if ($#ARGV == 0) {
	    print OUTPUT "# Archive file: " . quoteifspaces($ARGV[0]) . "\n\n";
	} else {
	    print OUTPUT "# Archive files:";
	    my $olen = 16;
	    foreach my $fn (@ARGV) {
		my $fnout = quoteifspaces($fn);
		my $fnlen = length($fn) + 1;
		if ($olen + $fnlen > 78) {
		    print OUTPUT "\n#               ";
		    $olen = 16;
		}
		print OUTPUT " $fnout";
		$olen += $fnlen;
	    }
	    print OUTPUT "\n\n";
	}
    } else {
	print OUTPUT "# Archive file: " . quoteifspaces($in_filename) . "\n\n";
    }
}


#########################################################################
# Remember the directory component of a filename, for later processing

sub remember_dir($) {
    my $fn = $_[0];

    if ($fn =~ /(.+)\//) {
	# The filename has a directory component to it (in $1)
	$archive_dirs{$1} = 1;
    }
}


#########################################################################
# Process the directories

sub process_dirs() {

    print OUTPUT "\n";

    if ($use_prefixdir) {
	my @dir_list = split(/\//, $prefixdir);
	for (my $i = 0; $i <= $#dir_list; $i++) {
	    my $pdir = join("/", @dir_list[0..$i]);
	    delete($archive_dirs{$pdir});
	}
	foreach my $sdir (@prefix_subdirs) {
	    delete($archive_dirs{$prefixdir . "/" . $sdir});
	}
    }

    foreach my $dir (sort { $b cmp $a } keys(%archive_dirs)) {
	print OUTPUT "rmdir " . quoteifspaces($dir) . "\n";
    }
}


#########################################################################
# Display usage information

sub showusage() {
    print <<"DATAEND"
$O v$version: Create Uninstall Script for Archives.
Copyright (C) 2002-07, John Zaitseff.

The $O program takes an archive file (possibly compressed) and
creates an uninstall shell script for it.  The script thus produced removes
files and directories that would be installed by the archive file.

Syntax:
    $O [--prefix=DIRNAME | --no-prefix] [--stdout | --output=OUTFILE |
        --to-files] [--help] [--version] FILENAME ...

where the following options exist:

    -p, --prefix=DIRNAME       - Don\'t delete the prefix directories created
                                 by the archive (this is the default, using
                                 the directory \"$def_prefixdir\").
    -P, --no-prefix            - Attempt to delete all directories created
                                 by the archive, including any prefix
                                 directories.
    -c, --stdout, --to-stdout  - Send the (single) uninstall shell script
                                 to standard output (the default).
    -o, --output=OUTFILE       - Send the (single) uninstall shell script to
                                 \"OUTFILE\".
    -F, --to-files             - Send the (possibly multiple) uninstall shell
                                 scripts to files having the same basename as
                                 the input archives.
    -h, --help                 - Show a command-line summary.
    -V, --version              - Show program version information.

and where "FILENAME" is an archive file (".tar", ".tar.gz", ".tgz", ".tar.bz2",
".tbz2" and ".tbz" extensions are supported).  If "--to-files" is specified,
the output files are created with the extension replaced by ".uninstall".
DATAEND
;
    exit(0);
}


#########################################################################
# Display program version information

sub showversion() {
    print <<"DATAEND"
$O v$version: Create Uninstall Script for Archives.
Copyright (C) 2002-07, John Zaitseff.

This program, including associated files, is distributed under the GNU
General Public License.  See the file COPYING for more information.
DATAEND
;
    exit(0);
}