File Coverage

blib/lib/File/Misc.pm

Criterion	Covered	Total	%
statement	69	505	13.6
branch	0	248	0.0
condition	0	77	0.0
subroutine	23	64	35.9
pod	13	31	41.9
total	105	925	11.3

package File::Misc;
use strict;
use Carp 'croak';
use FileHandle;
use Exporter;
use File::Find;
use File::Path;
use String::Util ':all';
use File::chdir;
use Fcntl ':mode', ':flock';

# version
our $VERSION = '0.10';

# debug tools
# use Debug::ShowStuff ':all';
# use Debug::ShowStuff::ShowVar;


#------------------------------------------------------------------------------
# opening POD
#

=head1 NAME

File::Misc -- handy file tools

=head1 Description

File::Misc provides a variety of utilities for working with files.  These
utilities provides tools for reading in, writing out to, and getting
information about files.

=head1 SYNOPSIS

 # slurp in the contents of a file
 $var = slurp('myfile.txt');

 # spit content into a file
 spit 'myfile.txt', $var;

 # get the lines in a file as an array
 @arr = file_lines('myfile.txt');

 # get a list of all the files in a directory
 @arr = files('/my/dir');

 # ensure a file is deleted - if it is already deleted return success
 ensure_unlink('myfile.txt');

 # ensure a file exists, update its date to now
 touch('myfile.txt');

 # many others

=head1 INSTALLATION

File::Misc can be installed with the usual routine:

 perl Makefile.PL
 make
 make test
 make install

=head1 FUNCTIONS

=cut

#
# opening POD
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# import/export
#
use vars qw[@EXPORT_OK %EXPORT_TAGS @ISA];
@ISA = 'Exporter';
@EXPORT_OK = qw[
	slurp
	spit
	file_lines
	files
	touch

	ensure_dir
	dir_ensure

	size
	mod_date mod_time
	mode
	age
	search_inc
	search_isa
	ensure_unlink unlink_ensure
	script_dir
	print_file_contents

	file_type

	eq_files eq_file ne_files ne_file

	build_tree
	mirror_tree
	tree_hash
	lock_file

	stat_hash

	tmp_path
	tmp_dir
];

%EXPORT_TAGS = ('all' => [@EXPORT_OK]);
#
# import/export
#------------------------------------------------------------------------------



#------------------------------------------------------------------------------
# slurp
#

=head2 slurp

Returns the contents of the given file

 $var = slurp('myfile.txt');

B max

Sets the maximum amount in bytes to slurp in.  By default the maximums is 100k.

 # set maximum to 1k
 $var = slurp('myfile.txt', max=>1024);

Set max to 0 to set no maximum.

B firstline

If true, only slurp in the first line.

 $line = slurp('myfile.txt', firstline=>1);

B stdout, stderr

If the C option is true, then the contents of the file are sent to
STDOUT and are not saved as a scalar at all.  C returns true.

 slurp('myfile.txt', stdout=>1);

The C option works the same way except that contents are sent to STDERR.
Both options can be set to true, and contents will be sent to both STDOUT and
STDERR.

=cut

sub slurp {
	my ($path, %opts)=@_;
	my ($chunk, $fh, @rv, $max, $stdout, $stderr, $out, $total);
	$total = 0;

	# TESTING
	# println subname(); ##i

	# don't slurp in more than this amount
	# default is 100K
	if (defined $opts{'max'})
		{ $max = $opts{'max'} }
	else
		{ $max = 102400 }

	# send to stdout or stderr
	$stdout = $opts{'stdout'};
	$stderr = $opts{'stderr'};
	$out = $opts{'stdout'} || $opts{'stderr'};

	# attempt to open
	unless ($fh = FileHandle->new($path)){
		$opts{'quiet'} and return undef;
		croak "slurp: could not open file [$path] for reading: $!";
	}

	$fh->binmode($fh) if $opts{'bin'};

	# if first line only
	if ($opts{'firstline'}) {
		$chunk = <$fh>;
		$chunk =~ s|[\r\n]+$||s;

		# output to stdout and|or stderr
		if ($stdout)
			{ print STDOUT $chunk }
		if ($stderr)
			{ print STDERR $chunk }
		if ($out)
			{ return 1 }

		# return
		return $chunk;
	}

	# slurp in everything
	CHUNKLOOP:
	while (read $fh, $chunk, 1024) {
		push @rv, $chunk;
		$total += length($chunk);

		# output to stdout and|or stderr
		if ($stdout)
			{ print STDOUT $chunk }
		if ($stderr)
			{ print STDERR $chunk }

		if ( $max && ($total > $max) ) {
			if ($out)
				{ return 1 }

			# we're done reading in
			last CHUNKLOOP;
		}
	}

	# return
	return join('', @rv);
}
#
# slurp
#------------------------------------------------------------------------------



#------------------------------------------------------------------------------
# spit
#

=head2 spit

The opposite of slurp(), spit() outputs the given string(s) to the given file
in a single command. In its simplest form, C takes a file path, then one
or more strings. Those strings are concatenated together and output the given
path. So, the following code outputs "hello world" to /tmp/myfile.txt.

 spit('/tmp/myfile.txt', 'hello world');

If you want to append to the file (if it exists) then the first param should be
a hashref, with 'path' set to the path to the file and 'append' set to true,
like as follows.

 spit(
   {path=>'/tmp/myfile.txt', append=>1},
   'hello world'
 );

=cut

sub spit {
	my ($path, @data) = @_;
	my ($out, $opentype);

	if (ref $path) {
		my $opts = $path;
		$path = $opts->{'path'};

		if ($opts->{'append'})
			{ $opentype = '>>' }
		else
			{ $opentype = '>' }
	}

	else {
		$opentype = '>';
	}

	#$out = FileHandle->new("$opentype $path")
	#	or croak "cannot open output file handle to $path: $!";

	open($out, $opentype , $path) or die $!;

	# print out data
	print $out @data;
}
#
# spit
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# file_lines
#

=head2 file_lines

Cfile_lines> returns the contents of one or more files as an array. Newlines
are stripped off the end of each line. So, for example, the following code
would the lines from buffer.txt:

 @lines = file_lines('buffer.txt');

If the first param is an arrayref, then every file in the array is read. So,
the following code returns lines from buffer.txt and data.txt.

 @lines = file_lines(['buffer.txt', 'data.txt']);

B

C sets the maximum number of lines to return. So, the following code
indicates to send no more than 100 lines.

 @lines = file_lines('buffer.txt', max=>100);

B

If the C option is true, then C does not croak on error.
For example:

 @lines = file_lines('buffer.txt', quiet=>1);

B

If C is true, then empty lines are not returned. Note that a line
with just spaces or tabs is considered empty.

 @lines = file_lines('buffer.txt', skip_empty=>1);

=cut

sub file_lines {
	my ($paths, %opts)=@_;
	my ($total, $max, @rv, $skipempty);

	# initialize total to zero
	$total = 0;

	# ensure paths is an array ref
	ref($paths) or $paths = [$paths];

	# default options
	%opts = (max=>0, %opts);

	# maximum number of lines
	$max = $opts{'max'};

	# if we should skip empty lines
	$skipempty = $opts{'skipempty'} || $opts{'skip_empty'};

	# loop through paths
	FILELOOP:
	foreach my $path (@$paths) {
		my ($fh);

		# open file
		unless ($fh = FileHandle->new($path)){
			$opts{'quiet'} and next FILELOOP;
			croak "could not open $path for reading: $!";
		}

		# ensure bonary mode
		$fh->binmode($fh) if $opts{'bin'};

		# loop through lines
		LINELOOP:
		while (my $line = <$fh>) {
			# remove trailing newline
			$line =~ s|[\r\n]+$||s;

			# skip empty lines if options indicate to do so
			if ($skipempty) {
				unless ($line =~ m|\S|s)
					{ next LINELOOP }
			}

			# add to return array
			push @rv, $line;

			# add to total number of lines
			$total++;

			# finished looping if max is reached
			if ( defined($max) && ($max > 0) && ($total > $max) )
				{ last FILELOOP }
		}
	}

	# return
	return @rv;
}
#
# file_lines
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# size
#

=head2 size

Returns the size of the given file. If the file doesn't exist, returns undef.

=cut

sub size {
	my ($path) = @_;
	my (@stats);

	# if file doesn't exist, return undef
	if (! -e $path)
		{ return undef }

	# get file stats
	@stats = stat($path);

	# return size
	return $stats[7];
}
#
# size
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# mod_date
#

=head2 mod_time

Returns the modification time (in epoch seconds) of the given file. If the file
doesn't exist, returns undef.

 print 'modification time: ', mod_time('myfile.txt'), "\n";

If you are familiar with the stat() function, then it may clarify to know that
C simply returns the ninth element of stat().

=head2 mod_date

C does exactly the same thing as C.

=cut

sub mod_time {
	my ($path) = @_;
	my (@stats);

	@stats = stat($path);
	return $stats[9];
}

sub mod_date {
	return mod_time(@_);
}
#
# mod_date
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# age
#

=head2 age

C returns the number of seconds since the given file has been modifed.

 print 'file age: ', age('myfile.txt'), "\n";

C simply returns the current time minus the value of C.

=cut

sub age {
	my ($path) = @_;
	my ($mod_time);

	$mod_time = mod_time($path);

	return(time() - $mod_time);
}
#
# age
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# files
#

=head2 files

C returns an array of file paths starting at the given directory. In its
simplest use, C is called with just a directory path.

 @myfiles = files('./tmp');

That command will return all files within ./tmp, including recursing into
nested directories.  By default, all paths will be relative to the current
directory, so the file list mught look something like this:

 ./tmp/buffer.txt
 ./tmp/build
 ./tmp/build/myfile.txt

You can get just the file names with the full_path option, described below.

Note that the

C has several options, explained below.

B

By default, C recurses directory structures.

B

B

B

B

B

=cut

sub files {
	my ($base, %opts) = @_;
	my (
		@rv,
		%extensions,
		@alldirs,
		$dirs,
		$files,
		$fullpath,
		$recurse,
		$hidden,
		$prune_file,
		$dir_slash,
		$path_rx,
		$follow_links,
	);

	# TESTING
	# println subname(); ##i

	# $base must be defined
	if (! defined $base)
		{ croak '$base must be defined' }

	$base =~ s|\\|/|sg;
	$base =~ s|/$||sg;
	@alldirs = $base;

	# default options
	%opts = (dirs=>1, files=>1, recurse=>1, %opts);

	# options
	$dirs = $opts{'dirs'};
	$files = $opts{'files'};
	$recurse = $opts{'recurse'};
	$hidden = $opts{'hidden'};
	$prune_file = $opts{'prune_file'};
	defined($opts{'extension'}) and $opts{'extensions'} = $opts{'extension'};
	$dir_slash = $opts{'dir_slash'} ? '/' : '';
	$follow_links = $opts{'follow_links'};

	# full path
	if (defined $opts{'full_path'})
		{ $fullpath = $opts{'full_path'} }
	elsif (defined $opts{'fullpath'})
		{ $fullpath = $opts{'fullpath'} }
	else
		{ $fullpath = 1 }

	# hold on to path rx
	$path_rx = $opts{'rx'};

	#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	# build hash of extensions
	#
	do {
		my ($ext_opt);

		# get extensions option if it exists
		EXT_LOOP:
		foreach my $key (qw{extensions extension ext exts}) {
			if ( hascontent ($ext_opt = $opts{$key}) ) {
				# enforce as array
				ref($ext_opt) or $ext_opt = [$ext_opt];

				# normalize extensions
				grep {s|.*\.||s; $_ = lc($_);} @$ext_opt;

				# build %extensions
				@extensions{@$ext_opt} = ();
			}
		}
	};
	#
	# build hash of extensions
	#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


	#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	# loop through files in directory and sub-directories
	#
	DIRLOOP:
	while(my $dir = pop @alldirs) {
		# if $dir is actually a normal file and normal files are
		# allowed as root
		if ( $opts{'allow_file_root'} && (! -d $dir) ) {
			push @rv, $dir;
		}

		# else loop through files in directory
		else {
			my ($dh);
			opendir($dh, $dir) or croak "opendir($dir): $!";

			# read in files in this directory
			READLOOP:
			foreach my $f (readdir $dh) {
				next READLOOP if $f eq '.' or $f eq '..';

				# skip hidden files unless directed to show them
				if ( ($f =~ m|^\.|s) && (! $hidden) )
					{ next READLOOP }

				$f = "$dir/$f";

				# if it's a directory, and it's not a link OR we should follow links,
				# then add to the list of directories to recurse
				if ( -d($f) && ( (! -l($f)) || $follow_links ) ){
					# if there's a prune file
					if (defined($prune_file) && -e("$f/$prune_file"))
						{ next READLOOP }

					# add to return array if necessary
					# add / to end of directory name if options indicate to do so
					if ( $dirs && allowed_ext($f, \%extensions) && allowed_rx($f, $path_rx) )
						{ push @rv, $f . $dir_slash }

					# add new directory to @alldirs
					$recurse and push @alldirs, $f;
				}

				# else it's enough of a "normal" file to add to the return array
				elsif ( $files && allowed_ext($f, \%extensions) && allowed_rx($f, $path_rx) ) {
					push @rv, $f;
				}
			}
		}
	}
	#
	# loop through files in directory and sub-directories
	#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


	if (! $fullpath)
		{ grep { s|.*/||s } @rv }


	# return
	return @rv;
}


# private sub
sub allowed_rx {
	my ($path, $rx) = @_;
	defined($rx) or return 1;

	# return if the path matches the rx
	return $path =~ m|$rx|s;
}


# private sub
sub allowed_ext {
	my ($path, $exts) = @_;
	%$exts or return 1;
	$path =~ s|.*\.||s;
	$path = lc($path);
	return exists $exts->{$path};
}

#
# files
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# earliest_mod_date
#
#sub earliest_mod_date {
#	my ($roots, %opts) = @_;
#	my ($earliest);
#
#	# coerce $roots into array
#	if (! ref $roots)
#		{ $roots = [$roots] }
#
#	# loop through root directories
#	foreach my $root (@$roots) {
#		# if root doesn't exist, throw error
#		if (! -e $root) {
#			croak "no file or directory at $root";
#		}
#
#		# loop through files
#		foreach my $file (files $root, %opts, allow_file_root=>1) {
#			my $mod_date = mod_date $file;
#
#			if ( (! defined $earliest) || ($mod_date < $earliest) )
#				{ $earliest = $mod_date }
#		}
#	}
#
#	# return
#	return $earliest;
#}
#
# earliest_mod_date
#------------------------------------------------------------------------------



#------------------------------------------------------------------------------
# latest_mod_date
#
#sub latest_mod_date {
#	my ($roots, %opts) = @_;
#	my ($latest);
#
#	# coerce $roots into array
#	if (! ref $roots)
#		{ $roots = [$roots] }
#
#	# loop through root directories
#	foreach my $root (@$roots) {
#		# loop through files
#		foreach my $file (files $root, %opts, allow_file_root=>1) {
#			my $mod_date = mod_date $file;
#
#			if ( (! defined $latest) || ($mod_date > $latest) )
#				{ $latest = $mod_date }
#		}
#	}
#
#	# return
#	return $latest;
#}
#
# latest_mod_date
#------------------------------------------------------------------------------



#------------------------------------------------------------------------------
# search_inc
#

=head2 search_inc

search_inc() searches the @INC directories for a given file and returns the
full path to that file. For example, this command:

 search_inc('JSON/Tiny.pm')

might return somethng like this:

 /usr/local/share/perl/5.18.2/JSON/Tiny.pm

The given path must be the full path within the @INC directory. So, for
example, this command would not return the path to JSON/Tiny.pm:

 search_inc('Tiny.pm')

That feature might be added later.

If you prefer, you can give the path in Perl module format:

 search_inc('JSON::Tiny')

=cut

sub search_inc {
	my ($str) = @_;
	my ($lib, $addpm);

	# TESTING
	# println subname(); ##i

	# if module is given in format Module::Name then change :: to /
	# also add .pm to end
	if ($str =~ s|::|/|g) {
		my $file = $str;
		$file =~ s|.*/||s;

		# if there isn't already an extension
		if ( $file !~ m|\.| )
			{ $str .= '.pm' }
	}

	# search through library directories
	foreach $lib (reverse @INC) {
		if (-e "$lib/$str") {
			my $rv = "$lib/$str";
			$rv =~ s|//+|/|gs;
			return $rv;
		}
	}

	# if we get this far then the file wasn't found, so return undef
	return undef;
}
#
# search_inc
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# search_isa
#
sub search_isa {
	my ($object, $file_name, %opts) = @_;
	my ($verbose, $indent, @isas, @paths, $object_class);

	# TESTING
	# println subname(); ##i

	# must have params
	defined($object) or croak 'must have $object';
	defined($file_name) or croak 'must have $file_name';

	# load necessarey class
	require Class::ISA;

	# verbosify
	if ($opts{'verbose'}) {
		print 'searching @ISA for file : ', $file_name, "\n";
		$indent = indent();
	}

	# get class of object
	if (ref $object)
		{ $object_class = ref $object }
	else
		{ $object_class = $object }

	# clean up file name
	$file_name =~ s|^/||s;

	# get list of directories in which to look for message file
	@isas = Class::ISA::self_and_super_path($object_class);

	# output list of potential directories
	foreach my $isa (@isas) {
		my ($path);
		$isa =~ s|::|/|gs;
		$path = $isa . '/' . $file_name;
		push @paths, $path;
	}

	# loop through directories in @INC
	foreach my $dir (@INC) {
		my $dir_use = $dir;
		$dir_use =~ s|/$||s;

		# loop through paths
		foreach my $path (@paths) {
			my $full = $dir_use . '/' . $path;

			# return if we found the file
			if (-e $full)
				{ return $full }
		}
	}

	# didn't find file
	$verbose and print 'did not find file ', $file_name, "\n";
	return undef;
}
#
# search_isa
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# touch
#
sub touch {
	my ($path, %opts) = @_;
	my ($rv);

	# if file exists, use utime to update
	if (-e $path) {
		$rv = utime(undef, undef, $path);
	}

	# else create file
	else {
		my ($hold_umask);

		# hold on to umask if a temporary umask was sent
		if ( defined $opts{'umask'} ) {
			$hold_umask = umask;
			umask($opts{'umask'});
		}

		# create file
		$rv = FileHandle->new("> $path") ? 1 : 0;

		# set umask back
		if ( defined $opts{'umask'} ) {
			umask($hold_umask);
		}
	}

	# return success|failure
	return $rv;
}
#
# touch
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# dirhandle
# private sub
#
sub dirhandle {
	return File::Misc::DirHandle->new(@_);
}
#
# dirhandle
#------------------------------------------------------------------------------



#------------------------------------------------------------------------------
# ensure_dir
#
sub ensure_dir {
	my ($dir, %opts) = @_;

	# create the directory if it doesn't already exist
	if (! -e $dir) {
		my ($rv, $hold_umask);

		# hold on to umask if a temporary umask was sent
		if ( defined $opts{'umask'} ) {
			$hold_umask = umask;
			umask($opts{'umask'});
		}

		# create directory
		$rv = mkpath($dir);

		# set umask back
		if ( defined $opts{'umask'} ) {
			umask($hold_umask);
		}

		# return
		return $rv;
	}

	# return success
	return 1;
}

# alias dir_ensure to ensure_dir
*dir_ensure = \&ensure_dir;

#
# ensure_dir
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# ensure_unlink
#
sub unlink_ensure {
	return ensure_unlink(@_);
}

sub ensure_unlink {
	my ($path) = @_;

	if (-e $path) {
		# if it's a directory
		if (-d $path)
			{ return rmtree($path) }

		# else file
		return unlink($path);
	}

	return 1;
}
#
# ensure_unlink
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# script_dir
#

=head2 script_dir

Returns the directory of the script.  The directory is relative the current
directory when the script was called. Call this command before altering $0.

=cut

sub script_dir {
	my $dir = $0;

	# special case: no /
	unless ($dir =~ m|/|s)
		{ return './' }

	# remove everything after last /
	$dir =~ s|^(.*)/[^/]*$|$1|s;

	# return
	return $dir;
}
#
# script_dir
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# mode
#

=head2 mode

mode() returns the file mode (i.e. type and permissions) of the given path.

=cut

sub mode {
	my ($path) = @_;
	my $mode = (stat($path))[2];
	return S_IMODE($mode);
}
#
# mode
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# build_tree
#
sub build_tree {
	my ($root, @paths) = @_;

	# remove trailing / from root
	$root =~ s|/$||s;

	# ensure root exists
	if (! -e $root) {
		mkpath($root) or die $!;
	}

	# loop through files
	foreach my $path (@paths) {
		my ($full);
		$path =~ s|^/||s;
		$full = "$root/$path";

		# if dir
		if ($path =~ m|/$|s) {
			if (! -e $full) {
				mkpath($full) or die $!;
			}
		}

		# else create file
		else {
			my ($dir, $rv, $arrows);


			# create directory
			$dir = $full;

			if ($dir =~ s|/[^/]+$||s) {
				if (! -e $dir)
					{ mkpath($dir) or die $! }
			}

			if (-e $full)
				{ $arrows = '>>' }
			else
				{ $arrows = '>' }

			# $rv = FileHandle->new("$arrows$full") or die $!;
			touch($full) or die $!;
		}
	}

	# return success
	return 1;
}
#
# build_tree
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# mirror_tree
#
our %mirror_tree_results;

sub mirror_tree {
	my ($src, $tgt, %opts) = @_;
	my ($verbose, $change_count);
	%mirror_tree_results = ();
	$verbose = $opts{'verbose'};


	#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	# if tgt exists, copy as needed
	#
	if (-e $tgt) {
		my ($tgt_files, $src_files);
		$tgt_files = tree_hash($tgt);
		$src_files = tree_hash($src);

		# initialize results
		$mirror_tree_results{'dirs_copied'} = 0;
		$mirror_tree_results{'dirs_deleted'} = 0;
		$mirror_tree_results{'files_copied'} = 0;
		$mirror_tree_results{'files_deleted'} = 0;
		$mirror_tree_results{'files_replaced'} = 0;


		# delete new files in target
		foreach my $tgt_path (sort keys %$tgt_files) {
			my $src_full_path = qq|$src/$tgt_path|;

			# if it doesn't exist in src, delete it
			if (! -e $src_full_path) {
				my $tgt_full_path = qq|$tgt/$tgt_path|;

				# If it still exists in target (it might
				# have been deleted with a ancestor tree
				# in a previous loop) then delete it.
				if (-e $tgt_full_path) {
					# if it's a directory, rmtree it
					if (-d $tgt_full_path) {
						rmtree($tgt_full_path) or croak $!;
						change_message_during(\%opts);
						$mirror_tree_results{'dirs_deleted'}++;
					}

					# else delete the file
					else {
						unlink($tgt_full_path) or croak $!;
						change_message_during(\%opts);
						$mirror_tree_results{'files_deleted'}++;
					}
				}
			}
		}

		# add files as needed
		foreach my $src_path (keys %$src_files) {
			my ($tgt_full_path, $src_full_path, $copy);
			$tgt_full_path = qq|$tgt/$src_path|;
			$src_full_path = qq|$src/$src_path|;

			# handle situation where src is a dir and target is not
			# by deleting target
			if (
				(-e $tgt_full_path)   &&
				(  -d $src_full_path) &&
				(! -d $tgt_full_path)
				) {
				unlink($tgt_full_path) or die $!;
			}

			# if it doesn't exist in tgt, add it
			if (! -e $tgt_full_path) {
				# if dir
				# if ($src_full_path =~ m|/$|s) {
				if (-d $src_full_path) {
					mkpath($tgt_full_path) or die $!;
					change_message_during(\%opts);
					$mirror_tree_results{'dirs_copied'}++;
				}

				# else create file
				else {
					my ($dir);

					# create directory
					$dir = $tgt_full_path;

					if ($dir =~ s|/[^/]+$||s) {
						if (! -e $dir) {
							mkpath($dir) or die $!;
							change_message_during(\%opts);
							$mirror_tree_results{'dirs_copied'}++;
						}
					}

					# copy file
					change_message_during(\%opts);
					$mirror_tree_results{'files_copied'}++;
					$copy = 1;
				}
			}

			# if file, check if different
			elsif (! -d $src_full_path) {
				require File::Compare;

				if (File::Compare::compare($src_full_path, $tgt_full_path)) {
					$copy = 1;
					change_message_during(\%opts);
					$mirror_tree_results{'files_replaced'}++;
				}
			}

			# copy file if necessary
			if($copy) {
				my ($result, $dir);
				require File::Copy;

				# test for strange problem in which
				$dir = $tgt_full_path;
				$dir =~ s|/[^/]+$||s;

				$result = File::Copy::copy($src_full_path, $tgt_full_path);

				if (! $result) {
					die $!;
				}
			}
		}
	}
	#
	# if tgt exists, copy as needed
	#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


	#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	# else tgt doesn't exist, so just copy entire tree
	#
	else {
		require File::Copy::Recursive;
		File::Copy::Recursive::dircopy($src, $tgt) or die $!;

		# set results as full copy
		$mirror_tree_results{'full_copy'} = 1;
	}
	#
	# else tgt doesn't exist, so just copy entire tree
	#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


	# initialize change count to 0
	$change_count = 0;


	# count changes and return
	# use 0E0 for "zero but true"
	foreach my $count (values %mirror_tree_results) {
		$change_count += $count;
	}

	if ($change_count && $opts{'change_message_after'})
		{ print $opts{'change_message_after'}, "\n" }

	# set to "zero but true" if necessary
	unless ($opts{'return_count'}) {
		$change_count ||= '0E0';
	}

	# return success
	return $change_count;
}

sub change_message_during {
	my ($opts) = @_;

	if (
		$opts->{'change_message_during'} &&
		(! $opts->{'change_message_during_done'})
		) {
		# print $opts->{'change_message_during'}, "\n";
		$opts->{'change_message_during_done'} = 1;
	}
}
#
# mirror_tree
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# tree_hash
#
sub tree_hash {
	my ($root_node) = @_;
	my (@files, %rv);

	# change to root
	local $CWD = $root_node;

	# get list of files
	@files = files('./');
	grep {$_ =~ s|^\./||s} @files;

	# build hash of files
	@rv{@files} = ();

	# return
	return \%rv;
}
#
# tree_hash
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# eq_files, ne_files, and aliases
#
sub eq_files {
	my ($path_a, $path_b) = @_;
	require File::Compare;
	return ! File::Compare::compare($path_a, $path_b);
}

sub eq_file { return eq_files(@_) }
sub ne_files { return ! eq_files(@_) }
sub ne_file { return ! eq_files(@_) }
#
# eq_files, ne_files, and aliases
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# file_type
#
#
# default path to file program
#my $file_program_path = '/usr/bin/file';
#
#sub file_type {
#	my ($path, %opts) = @_;
#	my ($bin, $fh, $type);
#
#	# load Taint::Misc
#	require Taint::Misc;
#
#	# get path to binary
#	$bin = $opts{'bin_path'} || $file_program_path;
#
#	# get type from file program
#	$fh = Taint::Misc::pipefrom($bin, '--mime', '--brief', $path);
#	$type = <$fh>;
#	undef $fh;
#
#	# parse out mime type
#	$type =~ s|;.*||s;
#	$type = lc($type);
#	$type = nospace($type);
#
#	# return
#	return $type;
#}
#
# file_type
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# lock_file
#

# LockFile::Simple provides similar functionality

sub lock_file {
	my ($path, $exclusive, %opts) = @_;
	my ($lock, $mode, $wait);

	# determine wait
	if (defined $opts{'wait'})
		{ $wait = $opts{'wait'} }
	else
		{ $wait = 1 }

	# must have defined $exclusive
	unless (defined $exclusive)
		{ croak 'must have defined $exclusive' }

	# open file handle
	$lock = FileHandle->new(">> $path");

	# fail if not able to get filehandle
	if (! $lock) {
		print STDERR "cannot get lock file $path: $!\n";
		return 0;
	}

	# get lock mode
	if ($exclusive)
		{ $mode = LOCK_EX }
	else
		{ $mode = LOCK_SH }

	# if waiting, get lock, fail if we don't
	if ($wait) {
		flock($lock, $mode) or
			die "unable to lock file: $!";
	}

	# if not waiting, add LOCK_NB, don't wait
	else {
		$mode = $mode | LOCK_NB;
		flock($lock, $mode) or return undef;
	}

	# return
	return $lock;
}
#
# lock_file
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# stat_hash
#

# field names
my @stat_fields = qw{
	dev
	ino
	mode
	nlink
	uid
	gid
	rdev
	size
	atime
	mtime
	ctime
	blksize
	blocks
};

sub stat_hash {
	my ($path) = @_;
	my (@vals, %rv);

	# get values
	@vals = stat($path);

	# if no value, return defined false
	@vals or return 0;

	# populate hash
	@rv{@stat_fields} = @vals;

	# return
	return \%rv;
}
#
# stat_hash
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# tmp_path
#

=head2 tmp_path

tmp_path() is for the situation where you want to create a temporary file, then
have that file automatically deleted at the end of your code or code block.

tmp_path() returns a C object. That object stringifies
to a random path. When the object goes out of scope, the file, if it exists, is
deleted. tmp_path() does B create the file, it just deletes the file if
the file exists.

tmp_path() takes one required param: the directory in which the file will go.
Here's a simple example:

 # variables
 my ($tmp, $fh);

 # get temporary path: file is NOT created
 $tmp = tmp_path('./');

 # open a file handle, write stuff to the file, close the handle
 $fh = FileHandle->new("> $tmp") or die $!;
 print $fh "stuff\n";
 undef $fh;

 # do something that might cause a crash
 # if there is a crash, $tmp goes out of scope and deletes the file
 if ( it_could_happen() ) {
   die 'crash!';
 }

 # move the file somewhere else
 rename($tmp, './permanent') or die $!;

 # the file doesn't exist anymore, so when $tmp object
 # goes out of scope, nothing happens

By default, the path consists of the given directory followed by a random
string of four characters. So in the example above, the path would look
something like this:

 ./fZ96

No effort is made to ensure that there isn't already a file with that name. It
is simply assumed that four characters is enough to assure a microscopic (but
non-zero) chance of a name conflict.

Note that L provides a similar functionality, but there is an
important difference. File::Temp creates the temporay file and returns a
file handle for that file. This is useful for situations where you want to
cache data for use in the current scope. It gets a little trickier, however,
if you want to close the file handle and move the temporary file to a permanent
location. tmp_path simply gives you a path that will be deleted if the file
exists, allowing you manipulate and move the file as you like. File::Temp also
goes to some effort to ensure that there are no name conflicts. What you use is
a matter of needs and taste.

B

By default the random string is 4 characters long. rand_length gives a
different length to the string. So, for example, the following code indicates
a random string length of 8:

 $tmp = tmp_path('./', rand_length=>8);

That produces a string like this:

 ./JQd4P6W7

B

If the C option is sent and is false, then the file is not
actually deleted when the tmp object goes out of scope. For example:

 $tmp = tmp_path('./', auto_delete=>0);

This option might seem to defeat the purpose of tmp_path, but it's useful for
debugging your code.  By setting the object so that it doesn't automatically
delete the file you can look at the contents of the file later to see if it
actually contains what you thought it should.

B

extension allows you to give the path a file extension. For example, the
following code creates a path that ends with '.txt'.

 $tmp = tmp_path('./', extension=>'txt');

B

prefix indicates a string that should be put after the directory name but
before the random string. So, for example, the following code puts the prefix
"build-" in the file name:

 $tmp = tmp_path('./', prefix=>'build-');

giving us something like

 ./build-J3v1

=cut

sub tmp_path {
	return File::Misc::Tmp::Path->new(@_);
}
#
# tmp_path
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# tmp_dir
#

=head2 tmp_dir

tmp_dir() creates a temporary directory and returns a File::Misc::Tmp::Dir
object.  When the object goes out of scope, the directory is deleted.

=cut

sub tmp_dir {
	return File::Misc::Tmp::Dir->new(@_);
}
#
# tmp_dir
#------------------------------------------------------------------------------



###############################################################################
# File::Misc::DirHandle
#
package File::Misc::DirHandle;
use strict;
use Carp;
use DirHandle;

# debug tools
# use Debug::ShowStuff ':all';


#------------------------------------------------------------------------------
# new
#
sub new {
	my ($class, $path, %opts) = @_;
	my $self = bless {}, $class;

	$self->{'dh'} = DirHandle->new($path);
	$self->{'path'} = $path;
	$self->{'untaint'} = $opts{'untaint'};
	$self->{'fullpath'} = $opts{'fullpath'} || $opts{'full_path'};

	return $self;
}
#
# new
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# read
#
sub read {
	my ($self) = @_;
	my ($rv, $untaint);

	GETLOOP:
	while (1) {
		$rv = $self->{'dh'}->read;

		if (! defined $rv)
			{ return $rv }

		if ( $rv !~ m|^\.+$|s ){
			if ($self->{'untaint'}) {
				# Double check that we've got a real file
				# Yeah, I know this is redundant, but I can't
				# help myself.  I just can't untaint without
				# some kind of check.
				if (-e qq|$self->{'path'}/$rv|) {
					unless ($rv =~ m|^(.+)$|s)
						{ die "no-match-for-path:$rv doesn't match m|^(.+)\$|s" }
					$rv = $1;
				}
			}

			if ($self->{'fullpath'})
				{ $rv = qq|$self->{'path'}/$rv| }

			# return
			return $rv;
		}
	}

	# should never get to this point
	die 'error: should never get to this point';
}
#
# read
#------------------------------------------------------------------------------


#
# File::Misc::DirHandle
###############################################################################


###############################################################################
# File::Misc::Tmp::Path
#
package File::Misc::Tmp::Path;
use strict;
use Carp 'croak';
use String::Util ':all';
use overload '""'=>\&path, fallback=>1;

# debug tools
# use Debug::ShowStuff ':all';

# Objects of this class create a file path (but not the file itself), then
# delete the file upon destruction.

# object overloading
use overload
	'""'     => sub{$_[0]->{'path'}},  # stringification
	fallback => 1;                     # operations not defined here


#------------------------------------------------------------------------------
# new
#
sub new {
	my ($class, $parent_dir, %opts) = @_;
	my $self = bless {}, $class;

	# TESTING
	# println subname(); ##i
	# showvar %opts;

	# error checking: make sure we got a parent directory
	unless (defined $parent_dir)
		{ croak 'did not get defined parent directory' }

	# default options
	%opts = (rand_length=>4, auto_delete => 1, %opts);

	# automatically delete upon destruction
	$self->{'auto_delete'} = $opts{'auto_delete'};

	# clean up $parent_dir
	$parent_dir =~ s|/+$||s;

	# if exact fil name was sent
	if ($opts{'exact_path'} || $opts{'full_path'}) {
		$self->{'path'} = $self->{'file_name'} = $parent_dir;
		$self->{'file_name'} =~ s|^.*/||s;
	}

	# else generate file name
	else {
		# error checking: make sure parent directory exists
		unless (-e $parent_dir)
			{ croak qq|directory $parent_dir does not exist| }

		# error checking: make sure parent directory is a directory
		unless (-d $parent_dir)
			{ croak qq|$parent_dir is not a directory| }

		if (defined $opts{'file_name'}) {
			$self->{'file_name'} = $opts{'file_name'};

			# build full path
			$self->{'path'} = $parent_dir . '/' . $self->{'file_name'};
		}
		else {
			while (
				(! defined $self->{'path'}) ||
				(-e $self->{'path'})
				) {

				# add random string
				$self->{'file_name'} = randword($opts{'rand_length'});

				# untaint file name
				unless ($self->{'file_name'} =~ m|^([a-z0-9]+)$|si)
					{ die 'unable to untaint' }
				$self->{'file_name'} = $1;

				# add extension
				if (defined $opts{'extension'})
					{ $self->{'file_name'} .= '.' . $opts{'extension'} }

				# begin with prefix if sent
				if (defined $opts{'prefix'})
					{ $self->{'file_name'} = "$opts{'prefix'}$self->{'file_name'}" }

				# build full path
				$self->{'path'} = $parent_dir . '/' . $self->{'file_name'};
			}
		}
	}

	# return
	return $self;
}
#
# new
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# path
#
sub path {
	return $_[0]->{'path'};
}
#
# path
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# file_name
#
sub file_name {
	return $_[0]->{'file_name'};
}
#
# file_name
#------------------------------------------------------------------------------


#-----------------------------------------------------------------------
# DESTROY
#
DESTROY {
	my ($self) = @_;

	if ( $self->{'auto_delete'} && -e($self->{'path'}) ) {
		unlink($self->{'path'}) or
			die "unable to remove $self->{'path'}: $!";
	}
}
#
# DESTROY
#-----------------------------------------------------------------------


#
# File::Misc::Tmp::Path
###############################################################################



###############################################################################
# File::Misc::Tmp::Dir
#
package File::Misc::Tmp::Dir;
use strict;
use Carp 'croak';
use String::Util ':all';
use File::Path;
use overload '""'=>\&path, fallback=>1;

# debug tools
# use Debug::ShowStuff ':all';

# Objects of this class create a directory, then
# delete the entire temporary directory (including all
# of its contents) upon destruction.


#------------------------------------------------------------------------------
# new
#
sub new {
	my ($class, $parent_dir, %opts) = @_;
	my $self = bless {}, $class;

	# default options
	%opts = (auto_delete => 1, %opts);

	# automatically rmtree upon destruction
	$self->{'auto_delete'} = $opts{'auto_delete'};

	# error checking: make sure we got a parent directory
	unless (defined $parent_dir)
		{ croak 'did not get defined parent directory for Joyis::DirRemover object' }

	# error checking: make sure parent directory exists
	unless (-e $parent_dir)
		{ croak qq|directory $parent_dir does not exist| }

	# error checking: make sure parent directory is a directory
	unless (-d $parent_dir)
		{ croak qq|$parent_dir is not a directory| }

	# normalize path to parent directory
	$parent_dir =~ s|/$||;

	# if explicit name of temp directory sent, use that, else generate new
	if (defined $opts{'tmp_name'}) {
		$self->{'path'} = $parent_dir . '/' . $opts{'tmp_name'};
	}

	# else generate own
	else {
		while (
			(! defined $self->{'path'}) ||
			(-e $self->{'path'})
			) {
			$self->{'dir'} = randword(4);
			$self->{'path'} = $parent_dir . '/' . $self->{'dir'};
		}
	}

	# create temp directory
	mkdir($self->{'path'}) or
		die "unable to create directory $self->{'path'}: $!";

	# return
	return $self;
}
#
# new
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# path
#
sub path {
	return $_[0]->{'path'};
}
#
# path
#------------------------------------------------------------------------------


#-----------------------------------------------------------------------
# DESTROY
#
DESTROY {
	my ($self) = @_;

	if (
		-e($self->{'path'}) &&
		$self->{'auto_delete'}
		) {
		rmtree($self->{'path'}) or
			die "unable to remove $self->{'path'}: $!";
	}
}
#
# DESTROY
#-----------------------------------------------------------------------


#
# File::Misc::Tmp::Dir
###############################################################################



# return true
1;

__END__