#!/usr/bin/perl -lw
#
# $Id: cswproto 19813 2012-12-04 17:08:27Z dmichelsen $
#
# Copyright 2006 Cory Omand <comand@blastwave.org>
# All rights reserved.  Use is subject to license terms.
#
# Redistribution and/or use, with or without modification, is
# permitted.  This software is without warranty of any kind.  The
# author(s) shall not be liable in the event that use of the
# software causes damage.
#
# cswproto - Create package prototypes which adhere to CSW standards.
#

use strict;
use File::Basename;
use File::Spec::Functions qw/catfile/;
use Getopt::Long qw/:config no_ignore_case/;
use POSIX;

use vars qw/
    @XFORMS $Common $StdOwn $StdGrp $StdDirPerm $common $stamp $root
    /;

# atime=8,mtime=9,ctime=10
use constant TIME_FIELD => 10;

# Prototype defaults
$StdOwn     = 'root';
$StdGrp     = 'bin';
$StdDirPerm = '0755';

# Path transforms
@XFORMS = (
    [ qr{^/opt/csw/man$},  q{/opt/csw/share/man}  ],
    [ qr{^/opt/csw/doc$},  q{/opt/csw/share/doc}  ],
    [ qr{^/opt/csw/info$}, q{/opt/csw/share/info} ],
);

# Print usage information and exit
sub usage {
    print join(" ", @_) if @_;

    my $program = basename $0;
    print <<"_USAGE_";
Usage: $program [-c <commonpathes>] [-h] [-s <timestamp>] path1[=path1] ... pathN[=pathN]

    -c      Filename containing common pathes not to include in the package
    
    -s      Timestamp source.
            The path to a file to be used as the base timestamp for prototype
            operations.  If this is specified, all source file creation times
            are compared to the creation time of this file.  Files created
            *before* this time will be excluded from the prototype.

    -h      Display brief usage.

    pathN   The remainder of arguments to this command will be specified
            directly to pkgproto.  These arguments specify which paths are to
            be included in the prototype.  This can be specified as
            pathX=pathY to use a different prefix for files in the prototype
            than were present on the build system.
_USAGE_

    exit 1;
}

# Returns true if the file should be excluded, false otherwise.
sub exclude {
    my $path = shift;

    return 0 unless $stamp;
    return 1 unless $path;

    die "Path $path is not readable by current user!\n" unless -r $path or -l $path;

    my $time = (lstat($path))[TIME_FIELD];
    return ($time >= $stamp) ? 0 : 1;
}

#
# MAIN EXECUTION
#

# Process command line arguments
my $test;
GetOptions(
    'root=s'  => \$root,
    'stamp=s' => \$stamp,
    'common=s' => \$common,
    'help'    => \&usage,
) or usage;

usage "Error: timestamp '$stamp' not readable" if $stamp and not -r $stamp;
usage "Error: one or more pkgproto patterns required" unless @ARGV;

$stamp = $stamp ? (stat($stamp))[TIME_FIELD] : 0;

if( $common ) {
    # Load common path contents
    my %alldirs = ('/' => 1);
    open F, $common || die "Couldn't open $common";
    while (<F>) {
        chomp; next if /^\s*$/ or /^#/;
	s/\+/\\+/g;
	s/\-/\\-/g;
        my @c = split( m!/! );
        my @pc = map { join( '/', @c[0..$_] ) } 1..$#c;
        $alldirs{$_} = 1 foreach (@pc);
    }
    close F;
    my $re = '^(' . join( '|', keys %alldirs ) . ')$';
    $Common = qr /$re/;
}

my @prototype;

foreach my $protopat (@ARGV) {
    my ($actual, $virtual) = split /=/, $protopat;

    my @pproto = `/usr/bin/pkgproto $protopat`;
    die "Failed to generate prototype"
        unless WIFEXITED($?) and WEXITSTATUS($?) == 0;

SPECLINE:
    foreach my $entry (@pproto) {
        chomp $entry;
        do { print $entry; next } if $entry =~ /^(?:i|\!)/;

        my @F = split /\s+/, $entry;
        my ($lhs, $rhs) = split /=/, $F[2];

        # Find the real path
        my $realpath;
        if ($F[0] eq 's' or $F[0] eq 'l') {
            $realpath = substr($lhs, 0, 1) ne '/'
                ? catfile($actual, $lhs)
                : $lhs;

        }
        else {
            $F[2] = $lhs if $lhs and $rhs;
            $realpath = $rhs
                ? $rhs
                : (substr($lhs, 0, 1) ne '/' ? catfile($actual, $lhs) : $lhs);
        }

        # Then do path transforms
        foreach my $xform (@XFORMS)  { $F[2] =~ s/$xform->[0]/$xform->[1]/g }
        $F[2] =~ s/$root// if $root;
        next unless $F[2];

        # Then process any excludes
	next SPECLINE if( $Common && $F[2] =~ /$Common/ );
        next if exclude($realpath);

        # Fix up dir permissions/file ownership.
        $F[3] = $StdDirPerm if $F[0] eq 'd';
        ($F[4], $F[5]) = ( $StdOwn, $StdGrp )
            unless $F[0] eq 's' or $F[0] eq 'l';

        push @prototype, [ grep { defined $_ } @F ];
    }
}

print join " " => @$_ foreach (sort { $a->[2] cmp $b->[2] } @prototype);

# End of file
