view release on metacpan or  search on metacpan

lib/App/CELL/Test.pm  view on Meta::CPAN

=head1 SYNOPSIS

    use App::CELL::Test;

    App::CELL::Test::cleartmpdir();
    my $tmpdir = App::CELL::Test::mktmpdir();
    App::CELL::Test::touch_files( $tmpdir, 'foo', 'bar', 'baz' );
    my $booltrue = App::CELL::Test::cmp_arrays(
        [ 0, 1, 2 ], [ 0, 1, 2 ]
    );
    my $boolfalse = App::CELL::Test::cmp_arrays(
        [ 0, 1, 2 ], [ 'foo', 'bar', 'baz' ]
    );


=head1 DESCRIPTION

The C<App::CELL::Test> module provides a number of special-purpose functions for
use in CELL's test suite. 



=head1 EXPORTS

This module exports the following routines:
    cleartmpdir
    cmp_arrays
    mktmpdir
    populate_file
    touch_files

=cut 

use Exporter qw( import );
our @EXPORT_OK = qw( cleartmpdir cmp_arrays mktmpdir populate_file 
                     touch_files _touch );



=head1 PACKAGE VARIABLES

=cut

our $tdo;  # temporary directory object



=head1 FUNCTIONS


=head2 mktmpdir

Creates the App::CELL testing directory in a temporary directory
(obtained using L<File::Temp>) and returns the path to this directory in
the payload of a status object.

=cut

sub mktmpdir {

    use Try::Tiny;

    try { 
        use File::Temp;
        $tdo = File::Temp->newdir();
    }
    catch {
        my $errmsg = $_ || '';
        $errmsg =~ s/\n//g;
        $errmsg =~ s/\012/ -- /g;
        return App::CELL::Status->new( level => 'ERR',
            code => 'CELL_CREATE_TMPDIR_FAIL',
            args => [ $errmsg ],
        );
    };
    $log->debug( "Created temporary directory" . $tdo );
    return App::CELL::Status->ok( $tdo->dirname );
}


=head2 cleartmpdir

DESTROYs the temporary directory object (see L<File::Temp>).

=cut

sub cleartmpdir { 
    $tdo->DESTROY if defined $tdo;
    return App::CELL::Status->ok;
}


=head3 _touch

Touch a file

=cut

sub _touch {
    my ( $file ) = @_;
    my $now = time;

    utime ($now, $now, $file)
                || open my $fh, ">>", $file
                || warn ("Couldn't touch file: $!\n");
} 


=head2 touch_files

"Touch" some files. Takes: directory path and list of files to "touch" in
that directory. Returns number of files successfully touched.

=cut

sub touch_files { 
    my ( $dirspec, @file_list ) = @_;
    use Try::Tiny;

    my $count = @file_list;
    try {
        foreach my $file ( map { File::Spec->catfile( $dirspec, $_ ); } @file_list ) {
            _touch( $file );
        }
    }
    catch {
        my $errmsg = $_;
        $errmsg =~ s/\n//g;
        $errmsg =~ s/\012/ -- /g;
        $errmsg = "Attempting to 'touch' $count files in $dirspec . . . failure: $errmsg";
        $log->debug( $errmsg );
        print STDERR $errmsg, "\n";
        return 0;
    };
    $log->debug( "Attempting to 'touch' $count files in $dirspec . . .  success" );
    return $count;
}


=head2 populate_file 

Takes filename (full path) and contents (as a string, potentially
containing newlines) to write to it. If the file exists, it is first
unlinked. Then the routine creates the file and populates it with
the contents. Returns true if something was written, or false if not.

=cut

sub populate_file {
    my ( $full_path, $contents ) = @_;
    unlink $full_path;
    {
        _touch( $full_path ) or die "Could not touch $full_path";
    }
    return 0 unless -f $full_path and -W $full_path;
    return 0 unless $contents;
    open(my $fh, '>', $full_path ) or die "Could not open file: $!";
    print $fh $contents;
    close $fh;
    return length $contents;
}

=head2 cmp_arrays

Compare two arrays of unique elements, order doesn't matter. 
Takes: two array references
Returns: true (they have the same elements) or false (they differ).

=cut

sub cmp_arrays {
    my ( $ref1, $ref2 ) = @_;
        
    $log->debug( "cmp_arrays: we were asked to compare two arrays:");
    $log->debug( "ARRAY #1: " . join( ',', @$ref1 ) );
    $log->debug( "ARRAY #2: " . join( ',', @$ref2 ) );

    # convert them into hashes