view release on metacpan or  search on metacpan

lib/Test/Fetchware.pm  view on Meta::CPAN

        # Actually digest it.
        $calculated_digest = $digest->hexdigest();
    };
    if ($@) {
        die <<EOD;
App-Fetchware: run-time error. Digest::MD5 croak()ed an error [$@].
See perldoc App::Fetchware.
EOD
    }

    close $package_fh or die <<EOD;
App-Fetchware: run-time error Fetchware failed to close the file
[$archive_to_md5] after opening it for reading. See perldoc App::Fetchware.
EOD
    
    my $md5sum_file = rel2abs($archive_to_md5);
    $md5sum_file = "$md5sum_file.md5";
    open(my $md5_fh, '>', $md5sum_file) or die <<EOD;
fetchware: run-time error. Failed to open [$md5sum_file] while calculating a
md5sum. Os error [$!].
EOD

    print $md5_fh "$calculated_digest  @{[file($archive_to_md5)->basename()]}";

    close $md5_fh or die <<EOD;
App-Fetchware: run-time error Fetchware failed to close the file
[$md5sum_file] after opening it for reading. See perldoc App::Fetchware.
EOD

    return $md5sum_file;
}



sub expected_filename_listing {
    my $expected_filename_listing = <<'EOC';
        array_each(
            array_each(any(
                re(qr/Announcement2.\d.(html|txt)/),
                re(qr/CHANGES_2\.\d(\.\d+)?/),
                re(qr/CURRENT(-|_)IS(-|_)\d\.\d+?\.\d+/),
                re(qr/
                    HEADER.html
                    |
                    KEYS
                    |
                    README.html
                    |
                    binaries
                    |
                    docs
                    |
                    flood
                /x),
                re(qr/httpd-2\.\d\.\d+?-win32-src\.zip(\.asc)?/),
                re(qr/httpd-2\.\d\.\d+?\.tar\.(bz2|gz)(\.asc)?/),
                re(qr/httpd-2\.\d\.\d+?-deps\.tar\.(bz2|gz)(\.asc)?/),
                re(qr/
                    libapreq
                    |
                    mod_fcgid
                    |
                    mod_ftp
                    |
                    patches
                /x),
                re(qr/\d{10,12}/)
                ) # end any
            )
        );
EOC

    return $expected_filename_listing;
}



sub verbose_on {
    # Turn on verbose functionality.
    $fetchware::verbose = 1;
}



sub export_ok{
    my ($sorted_subs, $sorted_export) = @_;

    package main;
    my @sorted_subs = sort @$sorted_subs;
    my @sorted_export = sort @$sorted_export;

    fail("Specified arrays have a different length.\n[@sorted_subs]\n[@sorted_export]")
        if @sorted_subs != @sorted_export;

    my $i = 0;
    for my $e (@sorted_subs) {
        if ($e eq $sorted_export[$i]) {
            pass("[$e] matches [$sorted_export[$i]]");
        } else {
            fail("[$e] does *not* match [$sorted_export[$i]]");
        }
        $i++;
    }
}



sub end_ok {
    my $temp_dir = shift;

    ok(open(my $fh_sem, '>', catfile($temp_dir, 'fetchware.sem')),
        'checked cleanup_tempdir() open fetchware lock file success.');
    ok( flock($fh_sem, LOCK_EX | LOCK_NB),
        'checked cleanup_tempdir() success.');
    ok(close $fh_sem,
        'checked cleanup_tempdir() released fetchware lock file success.');
}



sub add_prefix_if_nonroot {