view release on metacpan or  search on metacpan

integration/blank-env/run-integration.pl  view on Meta::CPAN

    return $BROWSER_BINARY;
}

# _single_subdir($dir)
# Returns the only immediate child directory under one extraction root.
# Input: directory path.
# Output: single child directory path or undef.
sub _single_subdir {
    my ($dir) = @_;
    opendir my $dh, $dir or die "Unable to open $dir: $!";
    my @children = grep { $_ ne '.' && $_ ne '..' } readdir $dh;
    closedir $dh;
    my @dirs = grep { -d File::Spec->catdir( $dir, $_ ) } @children;
    return if @dirs != 1;
    return File::Spec->catdir( $dir, $dirs[0] );
}

# _distribution_version($source_root)
# Reads the extracted distribution version from the main module file.
# Input: extracted source root directory path string.
# Output: version string or undef when it cannot be found.
sub _distribution_version {
    my ($source_root) = @_;
    return if !defined $source_root || $source_root eq '';
    my $module = File::Spec->catfile( $source_root, 'lib', 'Developer', 'Dashboard.pm' );
    return if !-f $module;
    my $text = _read_text($module);
    return $1 if $text =~ /our \$VERSION = '([^']+)'/;
    return;
}

# _versioned_install_tarball_path($expected_version)
# Builds a local tarball path whose basename includes the release version for cpanm.
# Input: extracted distribution version string.
# Output: container-local tarball path string.
sub _versioned_install_tarball_path {
    my ($expected_version) = @_;
    die "Missing expected version for cpanm install tarball path\n"
      if !defined $expected_version || $expected_version eq '';
    return File::Spec->catfile( '/tmp', "Developer-Dashboard-$expected_version.tar.gz" );
}

# _copy_file($source, $destination)
# Copies one file to another path, creating parent directories when needed.
# Input: source file path string and destination file path string.
# Output: destination path string after a successful copy.
sub _copy_file {
    my ( $source, $destination ) = @_;
    die "Missing source file path for copy\n" if !defined $source || $source eq '';
    die "Missing destination file path for copy\n" if !defined $destination || $destination eq '';
    my $dir = dirname($destination);
    make_path($dir) if defined $dir && $dir ne '' && !-d $dir;
    copy( $source, $destination )
      or die "Unable to copy $source to $destination: $!";
    return $destination;
}

# _decode_json_tail($text)
# Decodes the trailing JSON object or array embedded at the end of command output.
# Input: output text string.
# Output: decoded Perl structure.
sub _decode_json_tail {
    my ($text) = @_;
    $text = '' if !defined $text;
    if ( $text =~ /(\[\s*[\s\S]*\])\s*\z/ ) {
        return decode_json($1);
    }
    if ( $text =~ /(\{\s*[\s\S]*\})\s*\z/ ) {
        return decode_json($1);
    }
    die "Unable to locate trailing JSON payload in command output\n";
}

# _reset_dir($dir)
# Recreates a directory from scratch for clean integration state.
# Input: directory path.
# Output: none.
sub _reset_dir {
    my ($dir) = @_;
    remove_tree($dir) if -e $dir;
    make_path($dir);
}

# _write_text($file, $text)
# Writes text content to a file path, creating parent directories as needed.
# Input: file path string and text string.
# Output: none.
sub _write_text {
    my ( $file, $text ) = @_;
    my $dir = dirname($file);
    make_path($dir) if defined $dir && $dir ne '' && !-d $dir;
    open my $fh, '>', $file or die "Unable to write $file: $!";
    print {$fh} $text;
    close $fh;
}

# _read_text($file)
# Reads one whole text file into memory.
# Input: file path string.
# Output: file contents string.
sub _read_text {
    my ($file) = @_;
    open my $fh, '<', $file or die "Unable to read $file: $!";
    local $/;
    my $text = <$fh>;
    close $fh;
    return $text;
}

# _trim($text)
# Trims leading and trailing whitespace from text.
# Input: text string.
# Output: trimmed string.
sub _trim {
    my ($text) = @_;
    $text = '' if !defined $text;
    $text =~ s/\A\s+//;
    $text =~ s/\s+\z//;
    return $text;
}