xcat-core/xCAT-test/lib/XCAT/Test/File.pm

package XCAT::Test::File;

use strict;
use warnings;

use Cwd qw(abs_path);
use Exporter qw(import);
use File::Basename qw(dirname);
use File::Spec;
use IO::Handle;

our @EXPORT_OK = qw(repo_path slurp_repo_file);

my $module_dir = dirname( File::Spec->rel2abs(__FILE__) );
my $repo_root = abs_path(
    File::Spec->catdir(
        $module_dir,
        File::Spec->updir(),
        File::Spec->updir(),
        File::Spec->updir(),
        File::Spec->updir(),
    )
);
die "Unable to resolve the repository root from $module_dir: $!" unless defined $repo_root;
my $module_path = File::Spec->catfile( $repo_root, 'xCAT-test', 'lib', 'XCAT', 'Test', 'File.pm' );
die "Unable to locate the repository test support at $module_path" unless -f $module_path;

sub repo_path {
    my ($relative) = @_;
    die "Repository-relative path is required" unless defined $relative && length $relative;
    die "Repository path must be relative: $relative" if File::Spec->file_name_is_absolute($relative);
    foreach my $part ( File::Spec->splitdir($relative) ) {
        die "Repository path must not escape the checkout: $relative" if $part eq File::Spec->updir();
    }

    return File::Spec->catfile( $repo_root, $relative );
}

sub slurp_repo_file {
    my ($relative) = @_;
    my $path = repo_path($relative);

    open( my $fh, '<:raw', $path ) or die "Unable to open $path for reading: $!";
    my $contents = do { local $/; <$fh> };
    unless ( defined $contents && !$fh->error ) {
        my $error = $!;
        close($fh);
        die "Unable to read $path: $error";
    }
    close($fh) or die "Unable to close $path: $!";

    return $contents;
}

1;

__END__

=head1 NAME

XCAT::Test::File - repository file helpers for source-tree tests

=head1 FUNCTIONS

=head2 repo_path

Returns the absolute path for a repository-relative path.

=head2 slurp_repo_file

Reads a repository-relative file in raw mode and returns its complete contents.

=cut