use Fcntl;
use strict;
use warnings;

my $blocksize = 2048;

sub overwrite_file($;$)
{
	my( $filename, $pattern ) = @_;
	-e $filename or die "File '$filename' does not exist.\n";
	my $filesize = -s $filename;

	local *F;
	sysopen F, $filename, O_RDWR|O_BINARY
		or die "Can't overwrite '$filename' - $!\n";

	if ( defined $pattern and length $pattern )
	{
		$pattern x= 1 + $blocksize / length $pattern;
		substr( $pattern, $blocksize ) = '';

		my $written = 0;
		$written += syswrite F, $pattern
			while $written < $filesize;
	}
	else
	{	# use random bytes
		$pattern = "\0" x $blocksize;
		my $written = 0;
		while ( $written < $filesize )
		{
			$pattern =~ s/(.)/ $1 ^ chr(rand 256) /seg;
			$written += syswrite F, $pattern;
		}
	}

	#sysseek F, 0, 0; # rewind
	close F;
}

sub shred_file($)
{
	my $filename = shift;

	overwrite_file $filename, $_ for
		# byte patterns:
		"\xA5",
		"\x5A",
		'',     # random bytes
		"\x00",
		"\xFF";

	unlink $filename or die "Can't delete '$filename' - $!\n";
}

@ARGV or die "Usage: $0 file file ...\n";
shred_file $_ for @ARGV;