#!/usr/bin/perl

=begin metadata

Name: install
Description: install files and directories
Author: Greg Bacon, gbacon@itsc.uah.edu
License: perl

=end metadata

=cut


use strict;

my ($VERSION) = '1.2';

sub usage () {
    <<EOUsage;
install (Perl bin utils) $VERSION

Usage: $0 [-CcDp] [-g group] [-m mode] [-o owner] file1 file2
       $0 [-CcDp] [-g group] [-m mode] [-o owner] file ... directory
       $0 -d [-g group] [-m mode] [-o owner] directory ...
EOUsage
}

$SIG{__DIE__} = sub {
    warn @_;
    exit 1;
};

# still in Kansas, Toto?
my $Unix = $^O !~ /Win|VMS|DOS|MacOS|OS2/i;

my $Debug = 0;
my $Errors = 0;

# process options
my %opt;

while (@ARGV and $ARGV[0] =~ /^-/) {
    my $opt = shift;

    last if $opt eq '--';

    if ($opt =~ s/^-C//) {
        $opt{C}++;
    }
    elsif ($opt =~ s/^-c//) {
        $opt{c}++;
    }
    elsif ($opt =~ s/^-D//) {
        $Debug++;
    }
    elsif ($opt =~ s/^-d//) {
        $opt{d}++;
    }
    elsif ($opt =~ s/^-f(.*)//) {  # compat
        $opt{f} = $1 || shift;
    }
    elsif ($opt =~ s/^-g(.*)//) {
        $opt{g} = $1 || shift;
    }
    elsif ($opt =~ s/^-M//) {  # compat
        $opt{M}++;
    }
    elsif ($opt =~ s/^-m(.*)//) {
        $opt{m} = $1 || shift;
    }
    elsif ($opt =~ s/^-o(.*)//) {
        $opt{o} = $1 || shift;
    }
    elsif ($opt =~ s/^-p//) {
        $opt{p}++;
    }
    elsif ($opt =~ s/^-s//) {
        $opt{s}++;
    }
    elsif ($opt =~ s/^-\?//) {
        warn usage;
        exit 0;
    }
    else {
        $opt =~ s/^-//;
        die "$0: illegal option -- $opt\n", usage;
    }

    if ($opt) {
        unshift @ARGV, "-$opt";
    }
}

die usage unless @ARGV;

if ($opt{d} and grep($_, @opt{qw/ C c D p /}) > 0) {
    die "$0: -d not allowed with -[CcDp]\n", usage;
}

$opt{C}++ if $opt{p};

# these probably won't make sense elsewhere
if ($Unix) {
    if ($opt{g} and $opt{g} !~ /^\d+$/) {
        if (my $gid = getgrnam $opt{g}) {
            $opt{g} = $gid;
        }
        else {
            die "$0: unknown group `$opt{g}'\n";
        }
    }

    if ($opt{o} and $opt{o} !~ /^\d+$/) {
        if (my $uid = getpwnam $opt{o}) {
            $opt{o} = $uid;
        }
        else {
            die "$0: unknown user `$opt{o}'\n";
        }
    }
}

# do stuff
if ($opt{d}) {
    install_dirs();
}
else {
    install_files();
}

exit $Errors == 0 ? 0 : 1;

sub modify_file {
    my($path,$mode,$st) = @_;

    if ($mode) {
        unless (chmod $mode, $path) {
            printf STDERR "$0: chmod %o $path: $!\n", $mode;
            $Errors++;
        }
    }

    if ($opt{o} || $opt{g}) {
        my @st = stat $path;
        my $uid = $opt{o} || $st[4];
        my $gid = $opt{g} || $st[5];

        unless (chown $uid, $gid => $path) {
            warn "$0: chown $uid.$gid $path: $!\n";
            $Errors++;
        }
    }

    if ($opt{p}) {
        unless (utime @{$st}[8,9] => $path) {
            warn "$0: utime $path: $!\n";
            $Errors++;
        }
    }

    if ($opt{s} and -B $path) {
        if (system "strip", $path) {
            warn "$0: strip $path exited " . ($? >> 8) . "\n";
            $Errors++;
        }
    }
}

sub install_dirs {
    require File::Basename;

    my $mode = $opt{m} || '755';
    my $symbolic = $mode =~ /^[0-7]{1,4}$/ ? 0 : 1;

    require SymbolicMode if $symbolic;

    # credit Abigail
    my @dirs;
    my %min;
    while (@ARGV) {
        my $dir = pop @ARGV;
        my $intermediate = 0;
        while ($dir ne File::Basename::dirname ($dir)) {
            my $val = $intermediate++;

            push @dirs => [$dir, $val];

            if ($val == 0 || !defined($min{$dir}) || $val < $min{$dir}) {
                $min{$dir} = $val;
            }

            $dir = File::Basename::dirname ($dir);
        }
    }

    my %seen;
    for (reverse @dirs) {
        next if $seen{ $_->[0] }++;

        $_->[1] = $min{ $_->[0] };
        push @ARGV, $_;
    }

    foreach my $directory (@ARGV) {
        my($dir,$implied) = @$directory;

        next if $implied && -d $dir;

        mkdir $dir, 0755 or die "$0: mkdir $dir: $!\n";
    }

    foreach my $directory (@ARGV) {
        my($dir,$implied) = @$directory;

        next if $implied;

        my $bits;
        if ($symbolic) {
            unless ( $bits = SymbolicMode::mod($mode, $dir) ) {
                die "$0: invalid mode: $mode\n";
            }
            $bits = oct $bits;
        }
        else {
            $bits = oct $mode;
        }

        # do these make sense elsewhere?
        modify_file $dir, $bits if !$implied && $Unix;
    }
}

sub install_files {
    my $dst = pop @ARGV;
    my $dir = -d $dst;

    if (!$dir and @ARGV > 1) {
        die "$0: $dst is not a directory\n", usage;
    }

    my $mode = $opt{m} || '755';
    my $symbolic = ($mode =~ /^[0-7]{1,4}$/) ? 0 : 1;

    require SymbolicMode if $symbolic;
    require File::Copy;
    require File::Spec;

    foreach my $file (@ARGV) {
        my $targ = $dir ? File::Spec->catfile($dst,$file) : $dst;

        my @st;
        if ($opt{p}) {
            unless (@st = stat $file) {
                warn "$0: stat $file: $!\n";
                $Errors++;
                next;
            }
        }

        if ($opt{C}) {
            if (system "cmp", "-s", $file, $targ) {
                warn "$0: copy $file $targ\n" if $Debug;

                unless ( File::Copy::copy($file, $targ) ) {
                    warn "$0: copy $file $targ: $!\n";
                    $Errors++;
                    next;
                }
            }
            else {
                if ($Debug >= 2) {
                    warn "$0: $file not copied to $targ\n";
                }
                next;
            }
        }
        elsif ($opt{c}) {
            warn "$0: copy $file $targ\n" if $Debug;

            unless ( File::Copy::copy($file, $targ) ) {
                warn "$0: copy $file $targ: $!\n";
                $Errors++;
                next;
            }
        }
        else {
            warn "$0: move $file $targ\n" if $Debug;

            unless ( File::Copy::move($file, $targ) ) {
                warn "$0: move $file $targ: $!\n";
                $Errors++;
                next;
            }
        }

        my $bits;
        if ($symbolic) {
            unless ( $bits = SymbolicMode::mod($mode, $targ) ) {
                die "$0: invalid mode: $mode\n";
            }
            $bits = oct $bits;
        }
        else {
            $bits = oct $mode;
        }

        modify_file $targ, $bits, \@st if $Unix;
    }
}

__END__

=pod

=head1 NAME

install - install files and directories

=head1 SYNOPSIS

B<install> [B<-CcDp>] [B<-g> I<group>] [B<-m> I<mode>] [B<-o> I<owner>] I<file1> I<file2>

B<install> [B<-CcDp>] [B<-g> I<group>] [B<-m> I<mode>] [B<-o> I<owner>] I<file> ... I<directory>

B<install> B<-d> [B<-g> I<group>] [B<-m> I<mode>] [B<-o> I<owner>] I<directory> ...

=head1 DESCRIPTION

B<install> moves (or copies if B<-C> or B<-c> are specified) files to the
target path specified by I<file2> or I<directory>.  Alternatively, if
B<-d> is specified, B<install> creates directories (also creating missing
parent directories as necessary, similar to B<mkdir -p>).

B<install> accepts these options:

=over 4

=item B<-C>

Copy the file only if it differs from the target (according to
B<cmp -s>).  This option implies B<-c>.

=item B<-c>

Copy the file instead of performing the default action of deleting
the original.

=item B<-D>

Give debugging information.  If specified once, B<install> will warn
about impending copies or moves.  If specified more than once, B<install>
will warn when it does not install files due to B<-C>.

=item B<-d>

Create directories (creating missing parent directories as needed,
similar to B<mkdir -p>).  When creating parent directories, the implied
directories are created with the default creation mask 0755 (modified
by your umask).  Only those directories explicitly provided on the
command line take the permissions specified by B<-m>.  This behavior
imitates that of BSD install(1).

=item B<-f>

Specify the target's file flags, i.e. B<-f> I<flags>.  This option is
only provided for compatibility and does not affect the execution of
B<install>.

=item B<-g>

Specify the group to which the target file should belong.  Both numeric
and mnemonic group IDs are acceptable.

=item B<-M>

Do not use mmap(2).  This option is only provided for compatibility and
does not affect the execution of B<install>.

=item B<-m>

Specify the target file's mode.  Either octal modes or symbolic modes
are acceptable.  See the documentation for the I<SymbolicMode> module
for details on acceptable symbolic modes.  The default mode (used in
absence of B<-m> is 0755).  When specifying a symbolic mode, keep in
mind that all directories are created with the default creation mask
0755 (as modified by your umask), so it is probably best to use
absolute symbolic permissions (e.g. C<u=rwx,g=rx,o=rx>) as opposed
to relative symbolic permissions (e.g. C<ugo+x>).

=item B<-o>

Specify the owner to whom the target should belong.  Both numeric and
mnemonic user IDs are acceptable.

=item B<-p>

Preserve modification time.  This option implies B<-C>.

=item B<-s>

Invoke strip(1) on installed binaries.

=back

=head1 ENVIRONMENT

No environment variables affect the execution of B<install>.

=head1 CAVEATS

The combination of creation of and setting permissions for files and
directories is not atomic, so there are lots of possibilities for
race conditions.  If you are really concerned about this, use a umask
of 77.

=head1 AUTHOR

The Perl implementation of B<install> was written by Greg Bacon
E<lt>I<gbacon@itsc.uah.edu>E<gt> as part of the ADaM Project.

=head1 COPYRIGHT and LICENSE

Copyright 1999 UAH Information Technology and Systems Center.

This program is free and open software. You may use, copy, modify,
distribute, and sell this program (and any modified variants) in any way
you wish, provided you do not restrict others from doing the same.

=head1 SEE ALSO

umask(2), chmod(1), mkdir(1), chown(8), chgrp(8), strip(1)

=cut