# Copyright (c) 1997-2006 # Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany) # http://www.math.tu-berlin.de/polymake, mailto:polymake@math.tu-berlin.de # # 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, or (at your option) any # later version: http://www.gnu.org/licenses/gpl.txt. # # 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. #---------------------------------------------------------------------------- # $Project: polymake $$Id: Tempfile.pm 6754 2006-01-12 22:41:05Z gawrilow $ use strict; use namespaces; package Poly::Tempfile; my $dir; foreach ($ENV{TMPDIR}, "/tmp", "/var/tmp", $Poly::UserSettings::dir, ".") { $dir=$_, last if $_ and -d $_ and -w _; } if (!defined $dir) { die "Tempfile:: cannot find a writable working directory; set TMPDIR variable to a proper path\n"; } sub new { bless \(my $name), shift; } my $cnt="aaaa0000"; sub basename { "poly".$$."T".(++$cnt) } use overload '""' => sub { $ {$_[0]} ||= "$dir/".basename; }; sub dir { $dir } sub DESTROY { my ($self)=@_; if (defined($$self)) { if (my @files=glob $$self."*") { if ($Switches::d and $@) { warn_print( "temporary files kept: @files\n" ); } else { unlink @files; } } } } ################################################################################# package Poly::OverwriteFile; use Struct ( [ new => '$' ], [ '$dst' => '#1' ], '$tempname', ); sub new { my $self=&_new; my ($dir)= $self->dst =~ m|^(.*/)[^/]+$|; $self->tempname=$dir . Tempfile->basename; $self; } use overload '""' => "tempname"; sub DESTROY { my ($self)=@_; if ($@) { if ($Switches::d) { warn_print( "incomplete new copy of ", $self->dst, " kept as ", $self->tempname ); } else { unlink $self->tempname; } } else { rename $self->tempname, $self->dst or die "can't rename temporary file ", $self->temporary, " to destination ", $self->dst, ": $!\n"; } } 1