discourse-legacysite-perl/site/glist/lib/GT/TempFile.pm

# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::TempFile
#   Author  : Scott Beck
#   CVS Info :                          
#   $Id: TempFile.pm,v 1.36 2005/03/23 04:27:26 jagerman Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description:
#   Implements a tempfile.
#

package GT::TempFile;
# ===================================================================

# Pragmas
use strict;
use vars   qw/$VERSION $TMP_DIR %OBJECTS/;
use bases 'GT::Base' => ':all';
use overload '""' => \&as_string;

$VERSION = sprintf "%d.%03d", q$Revision: 1.36 $ =~ /(\d+)\.(\d+)/;

sub find_tmpdir {
# -------------------------------------------------------------------
# Sets the tmpdir.
#
    return $TMP_DIR if $TMP_DIR;
    my @tmp_dirs;
    for (qw/GT_TMPDIR TEMP TMP TMPDIR/) {
        push @tmp_dirs, $ENV{$_} if exists $ENV{$_};
    }
    push @tmp_dirs, $ENV{windir} . '/temp' if exists $ENV{windir};
    eval { push @tmp_dirs, (getpwuid $>)[7] . '/tmp' };
    push @tmp_dirs, '/usr/tmp', '/var/tmp', 'c:/temp', '/tmp', '/temp', '/sys$scratch', '/WWW_ROOT', 'c:/windows/temp', 'c:/winnt/temp';

    for my $dir (@tmp_dirs) {
        return $TMP_DIR = $dir if $dir and -d $dir and -w _ and -x _;
    }
    $TMP_DIR = '.';
}

sub new {
# -----------------------------------------------------------------------------
# Create a new tempfile.
#
    $TMP_DIR ||= find_tmpdir();
    my $self = bless {}, 'GT::TempFile::Tmp';
    $self->reset;

# Backwards compatibility
    if ( @_ == 2 and not ref( $_[1] ) ) {
        ( $self->{tmp_dir} ) = $_[1];
    }
    elsif ( @_ > 1 ) {
        $self->set( @_[1 .. $#_] );
    }

    my $dir      = $self->{tmp_dir} || $TMP_DIR;
    my $count    = substr(time, -4) . int(rand(10000));
    my $filename = '';

# Directory for locking
    my $lock_dir = "$dir/$self->{prefix}GT_TempFile_lock";

# W need to create the directory
    my $safety = 0;
    until ( mkdir( $lock_dir, 0777 ) ) {

# If we wait 10 seconds and still no lock we assume the lockfile is stale
        if ( $safety++ > 10 ) {
            rmdir $lock_dir or $self->fatal( 'RMDIR', $lock_dir, "$!" );
        }
        sleep 1;
    }

# Now lets get our temp file
    for (1 .. 20) {
        $filename = "$dir/$self->{prefix}GTTemp$count";
        last if (! -f $filename);
        $count++;
    }

# If the open fails we need to remove the lockdir
    if ( !open( FH, ">$filename" ) ) {
        rmdir $lock_dir or $self->fatal( 'RMDIR', $lock_dir, "$!" );
        $self->fatal( 'WRITEOPEN', $filename, "$!" );
    }
    close FH;

# All done searching for a temp file, now release the directory lock
    rmdir $lock_dir or $self->fatal( 'RMDIR', $lock_dir, "$!" );
    ($filename =~ /^(.+)$/) and ($filename = $1); # Detaint.

    $self->{filename} = $filename;
    my $object = bless \$filename, 'GT::TempFile';
    $OBJECTS{overload::StrVal $object} = $self;
    $self->debug("New tmpfile created ($filename).") if ($self->{_debug});
    $object;
}

sub as_string {
# -------------------------------------------------------------------
# Backwards compatibility
    my ( $self ) = @_;
    return $$self;
}

sub DESTROY {
# -------------------------------------------------------------------
    my $obj = shift;
    my $self = $OBJECTS{$obj};
    $self->debug("Deleteing $self->{filename}") if $self->{_debug};

# unlink the file if they wanted it deleted
    if ($self->{destroy}) {
        unless (unlink $self->{filename}) {
            $self->debug("Unable to remove temp file: $self->{filename} ($!)") if $self->{_debug};
        }
    }
    delete $OBJECTS{$obj};
}

package GT::TempFile::Tmp;
use bases 'GT::Base' => '';
use vars qw/$ATTRIBS $ERRORS/;
$ATTRIBS = {
    prefix  => '',
    destroy => 1,
    tmp_dir => undef,
};
$ERRORS = { SAFETY => "Safety reached while trying to create lock directory %s, (%s)" };

1;

__END__

=head1 NAME

GT::TempFile - implements a very simple temp file.

=head1 SYNOPSIS

    my $file = new GT::TempFile;
    open (FILE, "> $file");
    print FILE "somedata";
    close FILE;

=head1 DESCRIPTION

GT::TempFile implements a very simple temp file system that will remove
itself once the variable goes out of scope.

When you call new, it creates a random file name and looks for a 
tmp directory. What you get back is an object that when dereferenced
is the file name. You can also pass in a temp dir to use:

    my $file = new GT::Tempfile '/path/to/tmpfiles';

Other option you may use are:
    my $file = new GT::TempFile(
        destroy => 1,
        prefix  => '',
        tmp_dir => '/tmp'
    );


When the object is destroyed, it automatically unlinks the temp file 
unless you specify I<destroy> => 0.

I<prefix> will be prepended to the start of all temp files created
and the lock directory that is created. It is used to keep programs
using the tempfile module that do not have the temp files destroyed
from clashing.

I<tmp_dir> is the same as calling new with just one argument, it is
the directory where files will be stored.

TempFile picks a temp directory based on the following:

    1. ENV{GT_TMPDIR}
    2. ~/tmp
    3. ENV{TMPDIR}, ENV{TEMP}, ENV{TMP}
    4. /usr/tmp, /var/tmp, c:/temp, /tmp, /temp, 
       /WWW_ROOT, c:/windows/temp, c:/winnt/temp

=head1 COPYRIGHT

Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
http://www.gossamer-threads.com/

=head1 VERSION

Revision: $Id: TempFile.pm,v 1.36 2005/03/23 04:27:26 jagerman Exp $

=cut