:
# try to find and use a reasonably sane perl:
eval '
	# we do not want to use shell variables / named parameters here,
	# as those could conflict with environment variables,
	# so that makes this code a bit longer than it might otherwise be

	# first try what (if anything) our PATH finds first
	if >>/dev/null 2>&1 perl -e "{use strict; use POSIX qw(lchown);}"; then
		#that seems good - go for it
		exec perl -S "$0" ${1+"$@"}
	else
		# and if that does not work, then ...
		case X`uname -s` in
			# for flavors that do not provide (non-ancient) Perl with the
			# operating system, try /usr/local/bin/perl next
			# for completeness, these should probably be tweaked for various
			# uname -s and uname -r versions, and other version/revision factors
			XHP-UX|XSunOS)
				if >>/dev/null 2>&1 /usr/local/bin/perl -e "{use strict; use POSIX qw(lchown);}"; then
					exec /usr/local/bin/perl -S "$0" ${1+"$@"}
				elif >>/dev/null 2>&1 /usr/bin/perl -e "{use strict; use POSIX qw(lchown);}"; then
					exec /usr/bin/perl -S "$0" ${1+"$@"}
				fi
			;;
			# for flavors that do provide (non-ancient) Perl with the
			# operating system, try /usr/bin/perl next
			XLinux|XBIG-IP|*)
				if >>/dev/null 2>&1 /usr/bin/perl -e "{use strict; use POSIX qw(lchown);}"; then
					exec /usr/bin/perl -S "$0" ${1+"$@"}
				elif >>/dev/null 2>&1 /usr/local/bin/perl -e "{use strict; use POSIX qw(lchown);}"; then
					exec /usr/local/bin/perl -S "$0" ${1+"$@"}
				fi
			;;
		esac

		# if we succeeded above, the use of exec should render this unreachable
		# otherwise, if we are still executing here, we probably failed
		# one of our above tests - most likely the use POSIX qw(lchown)

		# so now let us gripe about about that:

		1>&2 echo "$0: NOTICE: failed to find perl that supports both use strict and use POSIX qw(lchown)"

		# and now let us see if we can find a perl that at least
		# satisfies use strict

		# first try what (if anything) our PATH finds first
		if >>/dev/null 2>&1 perl -e "{use strict;}"; then
			#that seems good - go for it
			exec perl -S "$0" ${1+"$@"}
		else
			# and if that does not work, then ...
			case X`uname -s` in
				# for flavors that do not provide (non-ancient) Perl with the
				# operating system, try /usr/local/bin/perl next
				# for completeness, these should probably be tweaked for various
				# uname -s and uname -r versions, and other
				# version/revision factors
				XHP-UX|XSunOS)
					if >>/dev/null 2>&1 /usr/local/bin/perl -e "{use strict;}"; then
						exec /usr/local/bin/perl -S "$0" ${1+"$@"}
					elif >>/dev/null 2>&1 /usr/bin/perl -e "{use strict;}"; then
						exec /usr/bin/perl -S "$0" ${1+"$@"}
					fi
				;;
				# for flavors that do provide (non-ancient) Perl with the
				# operating system, try /usr/bin/perl next
				XLinux|XBIG-IP|*)
					if >>/dev/null 2>&1 /usr/bin/perl -e "{use strict;}"; then
						exec /usr/bin/perl -S "$0" ${1+"$@"}
					elif >>/dev/null 2>&1 /usr/local/bin/perl -e "{use strict;}"; then
						exec /usr/local/bin/perl -S "$0" ${1+"$@"}
					fi
				;;
			esac

			# well, if we found a perl we can use, or at least squeak by
			# on, excec should have prevented us from executing this ...
			# otherwise we were not able to pass the perl use strict
			# test, ... so time to bail:

			1>&2 echo "$0: failed to find minimally useable perl, (failed use strict tests) aborting."
			exit 1
		fi
	fi
'
	if $running_under_some_shell;

# and then the real perl code starts ...

#for vi(1) :-) :
#se tabstop=4 shiftwidth=4 autoindent redraw showmatch showmode

use strict;

$^W=1;	# enable warnings

# unfortunately, in some cases we don't have lchown available to us, so ...
eval 'use POSIX qw(lchown)';
my $have_use_POSIX_lchown=!$@;
$have_use_POSIX_lchown or my $chown='';
$have_use_POSIX_lchown or my $chgrp='';
if($@){
	warn $@;
	warn "$0: we don't have POSIX qw(lchown) available";
	#try to find chown and chgrp executables
	if(! -l '/bin'){
		if(-x '/bin/chown'){
			$chown='/bin/chown';
		};
		if(-x '/bin/chgrp'){
			$chgrp='/bin/chgrp';
		};
	};
	if(!$chown){
		if(-x '/usr/bin/chown'){
			$chown='/usr/bin/chown';
		};
	};
	if(!$chgrp){
		if(-x '/usr/bin/chgrp'){
			$chgrp='/usr/bin/chgrp';
		};
	};
	$chown or die "$0: failed to find chown executable, aborting";
	$chgrp or die "$0: failed to find chgrp executable, aborting";
};

#set a secure umask
defined (umask 077) or die ("$0: \"umask 077\" failed, aborting");

#lowest UID number we allow for fromUID or toUID by default
my $minUID=50;

my $usage=<<""
usage: $0 [--force|-f] [--help|-h|-?] [--nochange|-n] [--noxdev|--nomount] [--recursive|-r|-R] [--verbose [level]|-v [level]] IDspec [IDspec ...] pathname [pathname ...]
	--force|-f
		Be forceful - bypass some checks/restrictions.
	--help|-h|-?
		Help - provide some basic usage information, overrides other options.
	--nochange|-n
		Change nothing, but say what would otherwise be done.
	--noxdev|--nomount
		Descend directories on other filesystems.
	--recursive|-r|-R
		Recursively descend directories.
	--verbose [level]|-v [level]
		Be verbose, optionally specifying verbosity level:
			-1 not verbose (default if --verbose not used)
			 0 report items changed (and not changed if --nochange)
			   (default if --verbose used without level)
			 1 0 and argument processing and report items not changed
			 2 1 and include diagnostics on options and items processed
			 3 2 and more diagnostics on options
	IDspec - ID specification, specifcation of set of ID changes as follows:
		fromUID,toUID[,fromGID,toGID ...]
		each ID must be specified as a decimal integer, any UID owned by
		fromUID will be lchown()ed to be owned by toUID, additionally, if
		and as specified, if the owning GID is fromGID, it will have the
		group ownership changed to the immedately following specified
		toGID
	pathname - pathname(s) to examine

;

# detabify
$usage=~s/\t/    /og;

use Getopt::Long;
use File::Find;

Getopt::Long::Configure (

	# start with "sane", conservitive POSIX (compatible) defaults
	"posix_default",

	# then tweak as seems fitting
	"bundling"

);

# from options and option arguments
my $force=undef;
my $help=undef;
my $nochange=undef;
my $noxdev=undef;
my $recursive=undef;
# we start with a reference level of -1, as --verbose takes optional
# argument, and will be set to 0 if --verbose is given but optional
# argument isn't supplied
my $verbose=-1;

GetOptions (
		"force|f" => \$force,
		"help|h|?" => \$help,
		"nochange|n" => \$nochange,
		"noxdev|nomount" => \$noxdev,
		"recursive|r|R" => \$recursive,
		"verbose|v:i" => \$verbose
	)

	or die	(	"$0: bad option(s), aborting\n${usage}aborting"
	);

# since we started with a reference level of -1, we want to increment
# this to have a more intuitive value
++$verbose;
if($verbose<0){$verbose=0}; #we no longer have use for $verbose to be negative
# this also allows us to conveniently check the boolean state of $verbose
# approximate $verbose levels:
# 0: not verbose
# 1: report items changed (and not changed if $nochange)
# 2: 1 (above) and argument processing and interpretation and report items not changed
# 3: 2 (above) and include diagnostics on options and items processed
# 4: 3 (above) and more diagnostics on options

if($help){
	print "$usage";
	exit(0);
};

if($verbose>=3){
	for my $opt (qw(force help nochange noxdev recursive verbose)){
		if(defined(eval "\$$opt")){
			print ("\$$opt=",eval "\$$opt","\n");
		}else{
			print "\$$opt=undef\n";
		};
	};
	if($verbose>=4){
		print "Note that \$verbose defaults to 0 if option isn't specified, defaults to 1 if option is specified but not given an option argument, and if option argument value is given, \$verbose is set to the greater of one greater than that value, or 0.\n";
	};
};

my %ids=();
# we want to be relatively efficient, with possibly very large numbers
# of ID specifications, so we use a hash to speed lookup, etc.
########################################################################
# structure of %ids:
# {
# 	fromUID,
# 	[ toUID, { fromGID, toGID, ... } ],
# 	...
# }
# Essentially, it is a hash which contains one or more fromUIDs as
# keys, and the values are each an array, the first element of each of
# those arrays is the corresponding toUID, for each of those
# arrays, it may optionally have a second element, which if present is
# a hash containing one or more fromGIDs as keys, and corresponding
# toGIDs as values.  Other logical restrictions on source and/or
# toUIDs and/or GIDs are described as and where they're checked
# sometime before data gets added to the %ids hash or items within it.
########################################################################

# check integer function - if string is an integer, return integer, else return undef
sub isint{
	$_=$_[0];

	# temporarily suspend warnings
	$^W=0;	# either \1 or \2 and \3 will be undefined,
			# we want to suppress the warning when nothing
			# is substituted for those undefineds

	unless(
			# we use a fairly picky match for our integer checking
			s/
				^(?:
					0*(\d+)
					|
					(-)0*([1-9]\d*)
				)$
			/\1\2\3/ox
	){
		$^W=1;	# reenable warnings
		return undef;
	};

	$^W=1;	# reenable warnings
	return $_+=0;	# convert to integer and return
};

if($#ARGV <1){
	die("$0: must have at least one IDspec and one pathname\n${usage}aborting");
};

# process arguments, presuming they're IDspecs, leave the loop when
# something doesn't look like an IDspec, or we have only one argument
# left, or if something goes significantly wrong
IDSPEC: while(@ARGV){

	# we're required to have one or more pathnames
	if($#ARGV <=0){
		last;	# per the syntax, remaining argument, if any, must be
				# presumed to be a pathname
	};

	if($verbose>=2){
		print "examining: $ARGV[0]\n";
	};

	# let's start to figure out if it looks like an IDspec
	@_=split(',',$ARGV[0],-1);
	unless(
		$#_ >= 1		# need one or more ...
		&&
		$#_ % 2 == 1	# even number of ',' separated pairs ...
	){
		last;			# since we didn't get that, it can't be an
						# IDspec, so we'll presume it's a pathname
	};

	# try to convert each part to an valid integer
	for(my $index=0;$index<=$#_;++$index){
		$_[$index]=&isint($_[$index]);	# string --> integer (or undef)
		if(! defined($_[$index])){
			# can't be an IDspec, we'll presume it's a pathname
			last IDSPEC;
		};
	};

	# since it now looks syntactically like an IDspec, from here on if
	# we find a logical or range problem with it we need to abort

	# range check fromUID
	if($force){
		if(	# disallow changing superuser UID
			$_[0] == 0 &&
			$_[1] != 0
		){	die "$0: fromUID $_[0] (superuser UID) cannot be changed, aborting";
		};
	}else{
		if($_[0] == 0){
			die "$0: fromUID $_[0] out of range" .
				($_[1]==0?' (--force will override)':'') .
				', aborting';
		}elsif($_[0] < $minUID){
			die "$0: fromUID $_[0] out of range (--force will override), aborting";
		};
	};

	# range check toUID
	if(
		$_[1] == -1	# -1 is special to lchown
	){
		die "$0: toUID $_[1] out of range, aborting";
	}elsif(
		!$force && (
			$_[1] < $minUID ||
			$_[1] == 0
		)
	){	die "$0: toUID $_[1] out of range (--force will override), aborting";
	};

	# check any toGIDs (from GIDs don't have a range concern)

	for(my $index=3;$index<=$#_;$index+=2){
		# check toGIDs within range
		if	(
				$_[$index] == -1	# -1 is special to lchown
			){
			die "$0: toGID $_[$index] out of range, aborting";
		};
	};

	# so far so good on the IDspec, but we still need to check for other
	# kinds of problematic/erroneous specification

	# was the fromUID already specified earlier as a fromUID?
	if(exists($ids{$_[0]})){
		die "$0: fromUID $_[0] specified multiple times, aborting";
	};

	# fromUID and toUID are the same
	# only allowed with $force and GIDs specified
	if	(	$_[0] == $_[1]
			&&
			(
				! $force
				||
				$#_ < 3
			)
		){
		die "$0: fromUID $_[0] and toUID are the same, disallowed unless GIDs also specified in same IDspec and --force option used, aborting";
	};

	# Was the fromUID already specified earlier as a toUID?
	# We only allow this with $force and if certain other checks
	# (which we defer to later) are also met.
	# The reason we generally don't allow this is it can be far too
	# hazardous - e.g.  if the same inode on the same filesystem
	# were to be matched and processed more than once, chaos could
	# ensue unless certain specific preconditions are met.
	if(!$force){
		for my $key (keys %ids){
			if($_[0] == $ids{$key}[0]){
				die "$0: fromUID $_[0] also specified as a toUID, this is only possibly allowed with --force, aborting";
			};
		};
	};

	# Was the toUID already specified earlier as a fromUID?
	# We only allow this with $force and if certain other checks
	# (which we defer to later) are also met.
	# The reason we generally don't allow this is it can be far too
	# hazardous - e.g.  if the same inode on the same filesystem
	# were to be matched and processed more than once, chaos would
	# ensue unless certain specific preconditions are met.
	if(!$force){
		if(exists($ids{$_[1]})){
			die "$0: toUID $_[1] also specified as a fromUID, this is only possibly allowed with --force, aborting";
		};
	};

	# multiple distinct fromUIDs mapped to a common toUID
	# only allowed with $force
	if	(
			! $force
	){
		for my $key (keys %ids){
			if($_[1] == $ids{$key}[0]){
				die "$0: toUID $_[1] already specified earlier as a toUID, disallowed without --force option, aborting";
			};
		};
	};

	# If $force, we possibly have some other toUID/fromUID checks to
	# perform, but we defer those checks, as we also need all the GID
	# mapping information to complete those checks.

	# If we made it to here, we have an IDspec which appears to be good,
	# possibly excepting syntactically good but logically bad GID mapping
	# specifications and possibly some toUID/fromUID problems if $force.
	# Since it's at least otherwise valid as an IDspec, if it fails a
	# logical GID mapping check, we have to abort anyway, so we'll
	# proceed as if the GID mappings are good, check things as we go,
	# and if we hit a logical GID mapping problem, we'll abort

	$ids{$_[0]}=[$_[1]];	# put the UID mapping in our hash
	my $key=$_[0];			# we need to "remember" the fromUID to add any GID stuff
	shift @_; shift @_;		# shift out the UIDs

	# deal with any GID mappings in this IDspec
	while (@_){
		if($_[0]==$_[1]){
			die "$0: fromGID $_[0] and toGID are the same, disallowed, aborting";
		}elsif($_[1]==-1){
			# -1 is special to lchown
			die "$0: toGID $_[1] out of range, aborting";
		};
		if(
			# 5.6.0 (5.006) / 5.005 (5.005) release can/can't
			# respectively use exists on array elements
			# so we avoid use of exists on array elements
			($#{$ids{$key}})>=1
		){
			# the hash exists
			if(exists(${ids{$key}[1]{$_[0]}})){
				die "$0: fromGID $_[0] specified multiple times under fromUID $key, aborting";
			};
			# add our additional GID mapping pair for that UID
			$ids{$key}[1]{$_[0]}=$_[1];
		}else{
			# the hash doesn't exist
			# initialize it with our first GID mapping pair for that UID
			$ids{$key}[1]={$_[0],$_[1]};
		};
		shift @_; shift @_;	# shift out that GID pair
	};

	# prepare to process next argument
	shift @ARGV;

};

#if $force, we possibly have some more fromUID/toUID issues to check for
if($force){
	for my $fromUID(keys %ids){
		my $toUID=$ids{$fromUID}[0];
		if(exists($ids{$toUID})){
			#toUID also exists as a fromUID
			#we only allow this if the following conditions all apply:
			#toUIDs must precisely match
			unless($ids{$fromUID}[0]==$ids{$toUID}[0]){
				die "$0: toUID $toUID also specified as fromUID but with different toUID $ids{$toUID}[0] - this is not allowed, aborting";
			};
			#fromGID,toGID mapping(s) must be supplied
			unless(
				($#{$ids{$fromUID}})>=1 &&
				($#{$ids{$toUID}})>=1
			){
				die "$0: toUID $toUID also specified as fromUID, disallowed unless GIDs also specified in same IDspec(s), aborting";
			};
			#fromGID,toGID mapping(s) must precisely match
			my $g1=$ids{$fromUID}[1];
			my $g2=$ids{$toUID}[1];
			my %gkeys=();
			for(keys %{$g1}){
				$gkeys{$_}=undef;
			};
			for(keys %{$g2}){
				$gkeys{$_}=undef;
			};
			for(keys %gkeys){
				unless(
					exists(${$g1}{$_}) &&
					exists(${$g2}{$_}) &&
					${$g1}{$_}==${$g2}{$_}
				){
					die "$0: toUID $toUID also specified as fromUID, disallowed unless precisely matched GIDs also specified in same IDspec(s), aborting";
				};
			};
		};
	};
};

# done processing IDspecs, must have at least one
if(!%ids){
	# this check isn't redundant - when we get a non-option argument
	# that doesn't look like an IDspec, we presume it and remaining
	# arguments are pathnames, so we could make it to here with zero IDspecs
	die("$0: must have at least one IDspec and one pathname\n${usage}aborting");
};

if($verbose>=2){
	print "IDspecs:\n";
	for my $key (sort {$a <=> $b} keys %ids){
		print "$key,$ids{$key}[0]";
		if(
			# 5.6.0 (5.006) / 5.005 (5.005) release can/can't
			# respectively use exists on array elements
			# so we avoid use of exists on array elements
			($#{$ids{$key}})>=1
		){
			for my $gkey (sort {$a <=> $b} keys %{$ids{$key}[1]}){
				print ",$gkey,$ids{$key}[1]{$gkey}";
			};
		};
		print "\n";
	};
	print (join("\n",'pathname(s):',@ARGV),"\n");
};

my $exit_val=0;	#	track if we encountered error(s)

my $togid;

sub wanted{
	if($verbose>=3){
		print "examining: $File::Find::name\n";
	};
	if(!$recursive){
		$File::Find::prune=1;
	};
	my $dev;
	my $uid;
	my $gid;
	if(!(($dev,$uid,$gid) = (lstat($_))[0,4,5])){
		warn "lstat($File::Find::name) failed\n";
		$exit_val=1;
		return;
	};
	if(!$noxdev&&$dev!=$File::Find::topdev){
		$File::Find::prune=1;
		return;
	};

	# does it match a fromUID?
	if(exists($ids{$uid})){
		my $touid=$ids{$uid}[0];
		if($touid==$uid){
			$touid=-1;		# no change for lchown uid
		};
		if(
			(
				# 5.6.0 (5.006) / 5.005 (5.005) release can/can't
				# respectively use exists on array elements
				# so we avoid use of exists on array elements
				($#{$ids{$uid}})>=1
			)
			&&
			exists($ids{$uid}[1]{$gid})
		){
			$togid=$ids{$uid}[1]{$gid};
		}else{
			$togid=-1;	# no change for lchown gid
		};
		if($touid!=-1||$togid!=-1){
			if($nochange||$verbose){
				# we use a chown(1)/chgrp(1) format for user friendliness
				print(($nochange?'nochange: ':''),($touid!=-1?("chown -h $touid" . ($togid!=-1?":$togid":'')):"chgrp -h $togid")," $File::Find::name\n");
			};
			if(!$nochange){
				# and finally, we're about ready to do the real work
				if(!lchown($touid,$togid,$_)){
					# if it fails, we include the much more litteral perl
					# lchown and its parameters in our diagnostics
					warn "$0: lchown($touid,$togid,$_) failed for $File::Find::name";
					$exit_val=1;
				};
			};
		}else{
			if($nochange&&$verbose||$verbose>=2){
				print "nochange: $File::Find::name\n";
			};
		};
	}else{
		if($nochange&&$verbose||$verbose>=2){
			print "nochange: $File::Find::name\n";
		};
	};
};

sub wanted_no_use_POSIX_lchown{
	if($verbose>=3){
		print "examining: $File::Find::name\n";
	};
	if(!$recursive){
		$File::Find::prune=1;
	};
	my $dev;
	my $uid;
	my $gid;
	if(!(($dev,$uid,$gid) = (lstat($_))[0,4,5])){
		warn "lstat($File::Find::name) failed\n";
		$exit_val=1;
		return;
	};
	if(!$noxdev&&$dev!=$File::Find::topdev){
		$File::Find::prune=1;
		return;
	};

	# does it match a fromUID?
	if(exists($ids{$uid})){
		my $touid=$ids{$uid}[0];
		if($touid==$uid){
			$touid=-1;		# no change for lchown uid
		};
		if(
			(
				# 5.6.0 (5.006) / 5.005 (5.005) release can/can't
				# respectively use exists on array elements
				# so we avoid use of exists on array elements
				($#{$ids{$uid}})>=1
			)
			&&
			exists($ids{$uid}[1]{$gid})
		){
			$togid=$ids{$uid}[1]{$gid};
		}else{
			$togid=-1;	# no change for lchown gid
		};
		if($touid!=-1||$togid!=-1){
			if($nochange||$verbose){
				# we use a chown(1)/chgrp(1) format for user friendliness
				print(($nochange?'nochange: ':''),($touid!=-1?("chown -h $touid" . ($togid!=-1?":$togid":'')):"chgrp -h $togid")," $File::Find::name\n");
			};
			if(!$nochange){
				# and finally, we're about ready to do the real work
				if(! -l _){
					# not a symlink, okay to use chown
					if(!chown($touid,$togid,$_)){
						# if it fails, we include the much more litteral perl
						# chown and its parameters in our diagnostics
						warn "$0: chown($touid,$togid,$_) failed for $File::Find::name";
						$exit_val=1;
					};
				}else{
					# is a symlink, we don't have use POSIX qw(lchown), so
					# it gets messier
					my $chownchgrp;
					my $touidgid;
					if($touid!=-1){
						$chownchgrp=$chown;
						if($togid!=-1){
							$touidgid=$touid . ':' . $togid;
						}else{
							$touidgid=$touid . '';
						};
					}else{
						$chownchgrp=$chgrp;
						$touidgid=$togid . '';
					};

					# do the real work
					my $system_return=system($chownchgrp,'-h','--',$touidgid,$_);
					# check for possible failures:
					if ($system_return==-1){
						warn ("$0: system($chownchgrp,'-h','--',$touidgid,$_) failed for $File::Find::name, got: $!");
						$exit_val=1;
					}elsif($system_return>0){
						warn "$0: system($chownchgrp,'-h','--',$touidgid,$_) failed for $File::Find::name, system returned: $?";
						$exit_val=1;
					}elsif($system_return<-1){
						# Hopefully this can't happen ... but just in case:
						warn ("$0: system($chownchgrp,'-h','--',$touidgid,$_) failed for $File::Find::name, unexpected return: \$!=$!, \$?=$?");
						$exit_val=1;
					};	# else it went fine
				};
			};
		}else{
			if($nochange&&$verbose||$verbose>=2){
				print "nochange: $File::Find::name\n";
			};
		};
	}else{
		if($nochange&&$verbose||$verbose>=2){
			print "nochange: $File::Find::name\n";
		};
	};
};

# now we're about ready to do some real work (or not (--nochange))
# use wanted (or wanted_no_use_POSIX_lchown if we don't have use POSIX
# qw(lchown) available) to process individual items
if($have_use_POSIX_lchown){
	for my $pathname (@ARGV){
		find(   {
		            wanted => \&wanted,
		        },
		        ($pathname)
		);
	};
}else{
	for my $pathname (@ARGV){
		find(   {
		            wanted => \&wanted_no_use_POSIX_lchown,
		        },
		        ($pathname)
		);
	};
};

exit $exit_val;
