Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / mhfile.pl

##---------------------------------------------------------------------------##
##  File:
##	$Id: mhfile.pl,v 2.6 2002/05/14 00:04:40 ehood Exp $
##  Author:
##      Earl Hood       mhonarc@mhonarc.org
##  Description:
##      File routines for MHonArc
##---------------------------------------------------------------------------##
##    MHonArc -- Internet mail-to-HTML converter
##    Copyright (C) 1997-1999	Earl Hood, mhonarc@mhonarc.org
##
##    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
##---------------------------------------------------------------------------##

package mhonarc;

use Symbol;

##---------------------------------------------------------------------------##

sub file_open {
    my($file) = shift;
    my($handle) = gensym;
    my($gz) = $file =~ /\.gz$/i;

    if ($gz) {
	return $handle  if open($handle, "$GzipExe -cd $file |");
	die qq/ERROR: Failed to exec "$GzipExe -cd $file |": $!\n/;
    }
    return $handle  if open($handle, $file);
    if (-e "$file.gz") {
	return $handle  if open($handle, "$GzipExe -cd $file.gz |");
	die qq/ERROR: Failed to exec "$GzipExe -cd $file.gz |": $!\n/;
    }
    die qq/ERROR: Failed to open "$file": $!\n/;
}

sub file_create {
    my($file) = shift;
    my($gz) = shift;
    my($handle) = gensym;

    if ($gz) {
	$file .= ".gz"  unless $file =~ /\.gz$/;
	return $handle  if open($handle, "| $GzipExe > $file");
	die qq{ERROR: Failed to exec "| $GzipExe > $file": $!\n};
    }
    return $handle  if open($handle, "> $file");
    die qq{ERROR: Failed to create "$file": $!\n};
}

sub file_exists {
    (-e $_[0]) || (-e "$_[0].gz");
}

sub file_copy {
    my($src, $dst) = ($_[0], $_[1]);
    my($gz) = $src =~ /\.gz$/i;

    if ($gz || (-e "$src.gz")) {
	$src .= ".gz"  unless $gz;
	$dst .= ".gz"  unless $dst =~ /\.gz$/i;
    }
    &cp($src, $dst);
}

sub file_rename {
    my($src, $dst) = ($_[0], $_[1]);
    my($gz) = $src =~ /\.gz$/i;

    if ($gz || (-e "$src.gz")) {
	$src .= ".gz"  unless $gz;
	$dst .= ".gz"  unless $dst =~ /\.gz$/i;
    }
    if (!rename($src, $dst)) {
	die qq/ERROR: Unable to rename "$src" to "$dst": $!\n/;
    }
}

sub file_remove {
    my($file) = shift;

    unlink($file);
    unlink("$file.gz");
}

sub file_utime {
    my($atime) = shift;
    my($mtime) = shift;
    foreach (@_) {
	utime($atime, $mtime, $_, "$_.gz");
    }
}

##---------------------------------------------------------------------------##

sub dir_remove {
    my($file) = shift;

    if (-d $file) {
	local(*DIR);
	local($_);
	if (!opendir(DIR, $file)) {
	    warn qq{Warning: Unable to open "$file"\n};
	    return 0;
	}
	my @files = grep(!/^(\.|\..)$/i, readdir(DIR));
	closedir(DIR);
	foreach (@files) {
	    &dir_remove($file . $mhonarc::DIRSEP . $_);
	}
	if (!rmdir($file)) {
	    warn qq{Warning: Unable to remove "$file": $!\n};
	    return 0;
	}

    } else {
	if (!unlink($file)) {
	    warn qq{Warning: Unable to delete "$file": $!\n};
	    return 0;
	}
    }
    1;
}

##---------------------------------------------------------------------------##
1;