view release on metacpan or  search on metacpan

lib/Util/SelfDestruct.pm  view on Meta::CPAN

############################################################
#
#   $Id: SelfDestruct.pm,v 1.20 2006/01/12 22:45:11 nicolaw Exp $
#   Util::SelfDestruct - Conditionally prevent execution of a script
#
#   Copyright 2005,2006 Nicola Worthington
#
#   Licensed under the Apache License, Version 2.0 (the "License");
#   you may not use this file except in compliance with the License.
#   You may obtain a copy of the License at
#
#       http://www.apache.org/licenses/LICENSE-2.0
#
#   Unless required by applicable law or agreed to in writing, software
#   distributed under the License is distributed on an "AS IS" BASIS,
#   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#   See the License for the specific language governing permissions and
#   limitations under the License.
#
############################################################

package Util::SelfDestruct;
# vim:ts=4:sw=4:tw=78

BEGIN {
	use strict;
	use Carp qw(cluck croak);
	use Cwd qw(abs_path);
	use Fcntl qw(:DEFAULT :flock);

	use constant DEBUG => $ENV{'DEBUG'} ? 1 : 0;
	use constant PROGRAM_NAME => -e abs_path($0) ? abs_path($0) : undef;
	use constant HOME => -d (getpwuid($>))[7] ? (getpwuid($>))[7] : $ENV{HOME};
	use constant RC_FILE => HOME.'/.selfdestruct';

	use vars qw($VERSION $PARAM);
	$VERSION = '1.21' || sprintf('%d.%02d', q$Revision$ =~ /(\d+)/g);
	$PARAM = {};
}

END {
	if (my ($action,$context) = _whatActionToTake($PARAM)) {
		if ($action eq 'unlink' && !exists $PARAM->{ABORT}) {
			if (unlink(PROGRAM_NAME)) {
				cluck(__PACKAGE__.": $context");
			} else {
				croak(sprintf('Failed to unlink %s during self destruct: %s',
						PROGRAM_FILE,$!));
			}
		}
	}
}

sub import {
	my $class = shift;

	my %alias = (
			'delete'      => 'unlink',
			'erase'       => 'unlink',
		);
	my %struct = (
			'unlink' => 'bool',
			'after'  => 'value',
			'before' => 'value',
		);

	while (my $k = lc(shift(@_))) {
		$k = $alias{$k} if exists $alias{$k};
		if ($struct{$k} eq 'bool') {
			$PARAM->{$k}++;
		} else {
			$PARAM->{$k} = lc(shift(@_));
			if ($k eq 'before') {
				$PARAM->{$k} = _mungeDateTime($PARAM->{$k},'000000');
			} elsif ($k eq 'after') {
				$PARAM->{$k} = _mungeDateTime($PARAM->{$k},'235959');
			}
			delete $PARAM->{$k} unless defined $PARAM->{$k};
		}
	}

	if ((exists $PARAM->{'before'} || exists $PARAM->{'after'}) &&
		exists $PARAM->{'now'}) {
		$PARAM->{ABORT}++;
		croak "The 'now' flag cannot be used in conjunction with the ",
			"'before' or 'after' options";
	}

	DUMP('$PARAM',$PARAM);

	if (my ($action,$context) = _whatActionToTake($PARAM)) {
		if ($action eq 'die') {
			croak(__PACKAGE__.": $context");