The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

=for info

Name: chown
Description: change ownership of files
Author: Abigail, abigail@fnx.com
License: perl

=cut

use strict;

my ($VERSION) = '1.2';

my $warnings = 0;

# Print a usuage message on a unknown option.
# Requires my patch to Getopt::Std of 25 Feb 1999.
$SIG {__WARN__} = sub {
    if (substr ($_ [0], 0, 14) eq "Unknown option") {die "Usage"};
    require File::Basename;
    $0 = File::Basename::basename ($0);
    $warnings = 1;
    warn "$0: @_";
};

$SIG {__DIE__} = sub {
    require File::Basename;
    $0 = File::Basename::basename ($0);
    if (substr ($_ [0], 0,  5) eq "Usage") {
        die <<EOF;
$0 (Perl bin utils) $VERSION
$0 [-R [-H | -L | -P]] user[:group] file [files ...]
EOF
    }
    die "$0: @_";
};

# Get the options.
# We can't use Getopts, as the order is important.
my %options;
while (@ARGV && $ARGV [0] =~ /^-/) {
    my $opt = reverse shift;
    chop $opt;
    if ($opt eq '-') {shift; last;}
    die "Usage" unless $opt =~ /^[RHLP]+$/;
    local $_;
    while (length ($_ = chop $opt)) {
        /R/ && do {$options {R} = 1; next};
        die "Usage" unless $options {R};
        /H/ && do {$options {L} = $options {P} = 0; $options {H} = 1; next};
        /L/ && do {$options {H} = $options {P} = 0; $options {L} = 1; next};
        /P/ && do {$options {H} = $options {L} = 0; $options {P} = 1; next};
    }
}

die "Usage" unless @ARGV > 1;

my $mode = shift;

my ($owner, $group) = split /:/ => $mode, 2;

defined (my $uid = getpwnam $owner) or die "$owner is an invalid user\n";
my $gid;

if (defined $group) {
    defined ($gid = getgrnam $group) or die "$group is an invalid group\n";
}

my %ARGV;
%ARGV = map {$_ => 1} @ARGV if $options {H};

sub modify_file;

if (exists $options {R}) {
    # Recursion.
    require File::Find;
    File::Find::find (\&modify_file, @ARGV);
}
else {
    foreach my $file (@ARGV) {
        modify_file $file;
    }
}

# File::Find is weird. If called with a directory, it will call
# the sub with "." as file name, while having chdir()ed to the
# directory. But it doesn't do that in recursion, just the top
# level ones. And it ain't true that $File::Find::name eq
# "$File::Find::dir/$_" in all cases.
# But it shouldn't matter in this case.
sub modify_file {
    my $file = @_ ? shift : $_;
    # Now, if this is a symbolic link, it points somewhere,
    # *and* we are following symbolic links, we recurse.
    # This may never end as symlinks can form loops.
    if (-l $file && -e $file &&
                      ($options {L} || $options {H} && $ARGV {$file})) {
        # We don't want to recurse symlinks that just happen to
        # have the same name as one of the arguments, hence the local.
        # Remember that $file is relative to the current directory.
        local $ARGV {readlink $file} = 0;
        File::Find::find (\&modify_file, readlink $file);
        return;
    }
    unless (-e $file) {
        warn "$file does not exist\n";
        return;
    }
    unless (defined $group) {
        $gid = (stat $file) [5] or do {
            warn "failed to stat $file: $!\n";
            return;
        };
    }
    chown $uid, $gid, $file or warn "$!\n";
}

exit $warnings;

__END__

=pod

=head1 NAME

chown - change ownership of files

=head1 SYNOPSIS

chown [-R [-H | -L | -P]] user[:group] file [files ...]

=head1 DESCRIPTION

I<chown> sets the ownership of files. The first argument after the
options is either a I<user>, or a I<user>-I<group> pair, separated
by a colon. If the I<group> is given, group membership of the file
is changed as well.

=head2 OPTIONS

I<chown> accepts the options described below. The options I<-L>,
I<-H> and I<-P> are mutally exclusive, and only the last given
option will be honoured. All of I<-L>, I<-H> and I<-P> require the
I<-R> option to be set first.

=over 4

=item -R

Recurse into directories. Any directories are recursively traversed,
and all files and directories will change owner.

=item -L

Follow symbolic links. By default, I<chown> will not follow symbolic
links. This is a potential dangerous option, as I<chown> will not
check for cycles. Be careful. This option requires the I<-R> option to be set.

=item -H

Follow symbolic links of command line files/directories only. This option
requires the I<-R> option to be set.

=item -P

Do not follow symbolic links at all. This option requires the I<-R> option
to be set.

=back

=head1 ENVIRONMENT

The working of I<chown> is not influenced by any environment variables.

=head1 BUGS

I<chown> can loop forever when symbolic links create cycles.

I<chown> uses C<File::Find> to recurse.

=head1 REVISION HISTORY

    $Log: chown,v $
    Revision 1.2  2004/08/05 14:17:43  cwest
    cleanup, new version number on website

    Revision 1.1  2004/07/23 20:10:01  cwest
    initial import

    Revision 1.1  1999/02/28 19:59:17  abigail
    Initial revision

=head1 AUTHOR

The Perl implementation of I<chown> was written by Abigail, I<abigail@fnx.com>.

=head1 COPYRIGHT and LICENSE

This program is copyright by Abigail 1999.

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 to do the same.

=cut