view release on metacpan or  search on metacpan

t/compress/CompTestUtils.pm  view on Meta::CPAN

package CompTestUtils;

package main ;

use strict ;
use warnings;
use bytes;

#use lib qw(t t/compress);

use Carp ;
#use Test::More ;



sub title
{
    #diag "" ;
    ok 1, $_[0] ;
    #diag "" ;
}

sub like_eval
{
    like $@, @_ ;
}

{
    package LexFile ;

    our ($index);
    $index = '00000';

    sub new
    {
        my $self = shift ;
        foreach (@_)
        {
            # autogenerate the name unless if none supplied
            $_ = "tst" . $index ++ . ".tmp"
                unless defined $_;
        }
        chmod 0777, @_;
        for (@_) { 1 while unlink $_ } ;
        bless [ @_ ], $self ;
    }

    sub DESTROY
    {
        my $self = shift ;
        chmod 0777, @{ $self } ;
        for (@$self) { 1 while unlink $_ } ;
    }

}

{
    package LexDir ;

    use File::Path;
    sub new
    {
        my $self = shift ;
        foreach (@_) { rmtree $_ }
        bless [ @_ ], $self ;
    }

    sub DESTROY
    {
        my $self = shift ;
        foreach (@$self) { rmtree $_ }
    }
}
sub readFile
{
    my $f = shift ;

    my @strings ;

    if (IO::Compress::Base::Common::isaFilehandle($f))
    {
        my $pos = tell($f);
        seek($f, 0,0);
        @strings = <$f> ;
        seek($f, 0, $pos);
    }
    else
    {
        open (F, "<$f")
            or croak "Cannot open $f: $!\n" ;
        binmode F;
        @strings = <F> ;
        close F ;
    }

    return @strings if wantarray ;
    return join "", @strings ;
}

sub touch
{
    foreach (@_) { writeFile($_, '') }
}

sub writeFile
{
    my($filename, @strings) = @_ ;
    1 while unlink $filename ;
    open (F, ">$filename")
        or croak "Cannot open $filename: $!\n" ;
    binmode F;