File Coverage

perllib/Arch/TempFiles.pm

Criterion	Covered	Total	%
statement	58	64	90.6
branch	8	14	57.1
condition	8	20	40.0
subroutine	16	20	80.0
pod	12	13	92.3
total	102	131	77.8

# Arch Perl library, Copyright (C) 2004 Mikhael Goikhman
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use 5.005;
use strict;

package Arch::TempFiles;

use Exporter;
use vars qw($global_tmp @ISA @EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT_OK = qw(
	temp_root temp_name temp_file_name temp_dir_name temp_file temp_dir
);

use Arch::Util qw(remove_dir);

sub new ($) {
	my $class = shift;
	my $self = {
		root  => $ENV{TMP_DIR} || "/tmp",
		files => [],
		dirs  => [],
	};
	return bless $self, $class;
}

sub DESTROY ($) {
	my $self = shift;
	my @temp_files = @{$self->{files}};
	my @temp_dirs = @{$self->{dirs}};

	foreach my $file (@temp_files) {
		unlink($file) || warn "Can't unlink $file: $!\n" if -f $file;
	}
	remove_dir(@temp_dirs) if @temp_dirs;
}

sub root ($;$) {
	my $self = shift;
	$self->{root} = shift if @_;
	return $self->{root};
}

sub name ($;$) {
	my $self = shift;
	my $label = shift || "arch";
	die "Can't make temporary $label name, no valid temp root defined\n"
		unless $self->{root} && -d $self->{root};
	my $prefix = "$self->{root}/,,$label-";
	my $file_name;
	my $tries = 10000;
	do {
		$file_name = $prefix . sprintf("%06d", rand(1000000));
	} while -e $file_name && --$tries;
	die "Failed to acquire unused temp name $prefix*\n" unless $tries;
	return $file_name;
}

sub file_name ($;$) {
	my $self = shift;
	my $file_name = $self->name($_[0]);
	push @{$self->{files}}, $file_name;
	return $file_name;
}

sub dir_name ($;$) {
	my $self = shift;
	my $dir_name = $self->name($_[0]);
	push @{$self->{dirs}}, $dir_name;
	return $dir_name;
}

sub file ($;$) {
	my $self = shift;
	my $file_name = $self->file_name($_[0]);
	# don't create file currently
	return $file_name;
}

sub dir ($;$) {
	my $self = shift;
	my $dir_name = $self->dir_name($_[0]);
	mkdir($dir_name, 0777) and return $dir_name;
	die "Can't mkdir $dir_name: $!" if ($_[1] || 10) <= 1;
	$self->dir($_[0], ($_[1] || 10) - 1);
}

sub _self () {
	return $global_tmp ||= Arch::TempFiles->new;
}

sub temp_root (;$) {
	_self()->root(@_);
}

sub temp_name (;$) {
	_self()->name(@_);
}

sub temp_file_name (;$) {
	_self()->file_name(@_);
}

sub temp_dir_name (;$) {
	_self()->dir_name(@_);
}

sub temp_file (;$) {
	_self()->file(shift);
}

sub temp_dir (;$) {
	_self()->dir(shift);
}

1;

__END__