#!/opt/local/bin/perl5.26 -w
##
## Copyright (c) 2004, Darren L. LaChausse
## ALL RIGHTS RESERVED
##
## Redistribution and use in source and binary forms, with or without
## modification, are permitted provided that the following conditions
## are met:
## 1. Redistributions of source code must retain the above copyright
##    notice, this list of conditions and the following disclaimer.
## 2. Redistributions in binary form must reproduce the above copyright
##    notice, this list of conditions and the following disclaimer in the
##    documentation and/or other materials provided with the distribution.
## 3. Neither the name of the Author nor the names of contributors
##    may be used to endorse or promote products derived from this software
##    without specific prior written permission.
##
## THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
## ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
## ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
## FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
## OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
## HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
## LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
## OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
## SUCH DAMAGE.

##
## Constants and configuration variables
##
$VERSION	= '0.5.1';
$code_name	= 'Bulldog';
$ver_string	= "keep $VERSION [$code_name]";
$copyright	= "Copyright (c) 2004, Darren L. LaChausse\nALL RIGHTS RESERVED.";

##
## Module Imports
##
use Getopt::Long;

###############################################################################

#Process the command line options
Getopt::Long::Configure("bundling");	#Turn on option bundling
					#i.e.: -xyz is equal to -x -y -z

GetOptions(	'i|interactive'	=> \$interactive,
		'f|force'	=> \$force,
		'v|verbose'	=> \$verbose,
		'h|help'	=> \$help,
		'version'	=> \$version);

@all_files = glob('*');		# Get all of the files in this directory
@keep_files = @ARGV;		# Get all of the files you want to keep

#Handle the request for help
if($help || (!$version && !$force && $#ARGV == -1))
{
	usage();
	exit 1;
}

#Handle the version option
if($version)
{
	print "$ver_string\n\n";
	print "$copyright\n";
	exit 1;
}

if(!$force) #If the force option is set, we don't prompt
{
	if(!initialPrompt(@keep_files))
	{
		exit -1;
	}
}

foreach $af(@all_files)
{
	$keep_me = 0;

	foreach $kf(@keep_files)
	{
		if($kf eq $af)
		{
			$keep_me = 1;
		}
	}

	if($keep_me)
	{
		print "Keeping $af\n" if($verbose);
	}
	else
	{
		#Enable prompting if in interactive mode
		$delete = 1;
		$delete = promptFiles($af) if($interactive);
		if($delete)
		{
			print "Deleting $af\n" if($verbose);
			deleteFile($af);
		}
		else
		{
			print "Keeping $af\n" if($verbose);
		}
	}
}

##
##Delete the specified file in a safe and consistant manner
##
sub deleteFile
{
	$file = $_[0];

	if(-d $file)
	{
		print "Unable to delete '$file', it is a directory.\n";
	}
	else
	{
		unlink $file;
	}
}

##
##Initial prompt before any files get deleted at all
##

sub initialPrompt
{
	print "This operation will delete all files in the current directory except:\n'@_'\nContinue? [Y/n] ";

	$| = 1; 	#Force a flush after the previous print statement
	$response = lc(<STDIN>);
	chomp $response; #Bye-bye new line

	if(	$response eq "" || 
		$response eq "y" ||
		$response eq "yes")
	{
		return 1;
	}
	else
	{
		return 0;
	}
}

##
##Prompt the user to make sure they really want to delete the file
##

sub promptFiles
{
	print "Are you sure you want to delete '$_[0]'? [Y/n]\n";
	$| = 1; 	#Force a flush after the previous print statement
	$response = lc(<STDIN>);
	chomp $response; #Bye-bye new line

	if(	$response eq "" || 
		$response eq "y" ||
		$response eq "yes")
	{
		return 1;
	}
	else
	{
		return 0;
	}
}

##
## Print usage information
##

sub usage
{
	print <<USAGE_MSG;
usage: keep [OPTION]... FILE...

   where OPTION is one of:
     -i --interactive	prompt before deleting any files
     -v --verbose	describe in detail what keep is doing
     -f --force		do not prompt for confirmation
     -h --help		display this help message
     --version		display version information for keep

USAGE_MSG
}

###############################################################################

##
## POD man page documentation
##

=begin html

<div class="linkbar">
	<img src="logo.png" alt="Keep">
	<p><a href="#links">LINKS</a> | <a href="#installation_instructions">INSTALLATION INSTRUCTIONS</a> | <a href="#download">DOWNLOAD</a> | <a href="#author">AUTHOR</a></p>
</div>

=end html

=head1 NAME

keep - a program that keeps the files you tell it to and deletes everything else in the current directory.

=head1 SYNOPSIS

B<keep> [B<OPTION>]... B<FILE>...

=head1 DESCRIPTION

Sometimes you find yourself in a situation where the list of files in a directory that you want to keep is shorter than the list of files you want to delete.  keep is a program designed for just such an occasion.

=head1 EXAMPLE

As an example, say that you have a directory containing:

F<banana kiwi strawberry grapefruit melon cumquat coconut pineapple>

Now, you want to delete every file in the directory except F<kiwi>, F<coconut>, and F<melon>.  Traditionally, you would use a command similar to the following:

B<$ rm banana strawberry grapefruit cumquat pineapple>

Here is the alternative, using the B<keep> command:

B<$ keep kiwi coconut melon>

As you can see, that is much easier and more logical in a situation like this.

=head1 OPTIONS

=over 8

=item B<-i>, B<--interactive>

Enables interactive mode.  B<keep> will prompt you before deleting any files.

=item B<-v>, B<--versbose>

Enables verbose mode.  B<keep> will describe in detail what it is doing.

=item B<-f>, B<--force>

Does not prompt prior to deleting files.  Use this option with caution.

=item B<-h>, B<--help>

Displays a brief help message.

=item B<--version>

Displays the version information for B<keep>.

=back

=head1 MORE EXAMPLES

=head2 Example 1

This example demonstrates basic operation of B<keep>.

=head3 Before:

F<canada mexico russia england germany france poland>

=head3 The command:

B<$ keep germany poland>

=head3 After:

F<germany poland>

=head2 Example 2

Like all other UNIX commands, you can pass wildcards to keep.

=head3 Before:

F<chicago chicken cow cheese>

=head3 The command:

B<$ keep chic*>

=head3 After:

F<chicago chicken>

=head2 Example 3

B<keep> also allows you to to keep I<nothing>, or in other words delete everything in the current directory.  The following command is identical to B<rm -f *>:

B<$ keep -f>

=begin html

=head1 LINKS

<p><a href="http://sourceforge.net/projects/keep">SourceForge.net project page</a></p>
<p><a href="http://cvs.sourceforge.net/viewcvs.py/keep/keep/">CVS Repository</a></p>

=head1 INSTALLATION INSTRUCTIONS

<p>Please refer to the <a href="README">README</a> for detailed installation instructions.</p>

=head1 DOWNLOAD

<p><a href="http://prdownloads.sourceforge.net/keep/keep-0.5.1-1.noarch.rpm?download">Binary RPM Package</a></p>
<p><a href="http://prdownloads.sourceforge.net/keep/keep-0.5.1-1.src.rpm?download">Source RPM Package</a></p>
<p><a href="http://prdownloads.sourceforge.net/keep/keep-0.5.1.tar.gz?download">Source Tarball</a></p>

=end html

=head1 BUGS

B<keep> currently does not work with directories.  Error checking is very bad.  Not very many options supported yet.

=head1 AUTHOR

Darren L. LaChausse - the_trapper@users.sourceforge.net

=head1 COPYRIGHT

Copyright (c) 2004, Darren L. LaChausse - ALL RIGHTS RESERVED

=begin man

=head1 SEE ALSO

rm(1)

=end man

=begin html

<A href="http://sourceforge.net"> <IMG src="http://sourceforge.net/sflogo.php?group_id=107485&amp;type=5" width="210" height="62" border="0" alt="SourceForge.net Logo" /></A>

=end html

=cut

