view release on metacpan or  search on metacpan

bin/install  view on Meta::CPAN

    usage();
}
foreach my $x (qw(g m o)) {
    if (defined $opt{$x} && length($opt{$x}) == 0) {
        warn "$Program: invalid argument for option -$x\n";
        exit 1;
    }
}

$opt{C}++ if $opt{p};
$Debug = 1 if $opt{D};

# 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 "$Program: unknown group `$opt{g}'\n";
        }
    }

    if ($opt{o} and $opt{o} !~ /^\d+$/) {
        if (my $uid = getpwnam $opt{o}) {
            $opt{o} = $uid;
        }
        else {
            die "$Program: 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 (defined $mode) {
        unless (chmod $mode, $path) {
            printf STDERR "$Program: chmod %o $path: $!\n", $mode;
            $Errors++;
        }
    }

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

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

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

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

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

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

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

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

            $dir = 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 "$Program: mkdir $dir: $!\n";
    }

    return unless $Unix;
    foreach my $directory (@ARGV) {

bin/install  view on Meta::CPAN

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> MODE

Specify the target file's mode.  Either octal modes or symbolic modes
are acceptable.  See the documentation for the I<PerlPowerTools::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