App-Fetchware

 view release on metacpan or  search on metacpan

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

    if (not exists $ENV{FETCHWARE_RELEASE_TESTING}
        or not defined $ENV{FETCHWARE_RELEASE_TESTING}
        or $ENV{FETCHWARE_RELEASE_TESTING}
        ne '***setting this will install software on your computer!!!!!!!***'

        # Enforce having *all* other FETCHWARE_* env vars set too to make it
        # even harder to easily enable FETCHWARE_RELEASE_TESTING. This is
        # because FETCHWARE_RELEASE_TESTING *installs* software on your
        # computer.
        #
        # Furthermore, the env vars below are required for
        # FETCHWARE_RELEASE_TESTING to work properly, so without them being set,
        # then FETCHWARE_RELEASE_TESTING will not work properly, because these
        # env vars will be undef; therefore, check to see if they're enabled.
    ) {
        plan skip_all => 'Not testing for release.';
    }
}



sub make_clean {
    BAIL_OUT(<<EOF) if -e 'lib/Test/Fetchware.pm' && -e 't/App-Fetchware-build.t';
Running make_clean() inside of fetchware's own directory! make_clean() should
only be called inside testing build directories, and perhaps also only called if
FETCHWARE_RELEASE_TESTING has been set.
EOF
    system('make', 'clean');
    chdir(updir()) or fail(q{Can't chdir(updir())!});
}



###BUGALERT### make_test_dist() only works properly on Unix, because of its
#dependencies on the shell and make, just replace those commands with perl
#itself, which we can pretty much guaranteed to be installed.
sub make_test_dist {
    my %opts = @_;

    # Validate options, and set defaults if they need to be set.
    if (not defined $opts{file_name}) {
        die <<EOD;
Test-Fetchware: file_name named parameter is a mandatory options, and must be
specified despite it pretty much always being just 'test-dist'. It is still
mandatory.
EOD
    }
    if (not defined $opts{ver_num}) {
        die <<EOD;
Test-Fetchware: ver_num named parameter is a mandatory options, and must be
specified despite it pretty much always being just '1.00'. It is still
mandatory.
EOD
    }
    # $destination_directory is a mandatory option, but if the caller does not
    # provide one, then simply use a tempdir().
    if (not defined $opts{destination_directory}) {
        $opts{destination_directory}
            = tempdir("fetchware-test-$$-XXXXXXXXXXX", TMPDIR => 1, CLEANUP => 1);
        # Don't *only* create the tempdid $destination_directory, also, it must
        # be chmod()'d to 755, unless stay_root is set, so that the dropped priv
        # user can still access the directory make_test_dist() creates.
        chmod 0755, $opts{destination_directory} or die <<EOD;
Test-Fetchware: Fetchware failed to change the permissions of it's testing
destination directory [$opts{destination_directory}] this shouldn't happen, and is
perhaps a bug. The OS error was [$!].
EOD
    }
    # This %opts check must go before the code below sets fetchwarefile even if
    # the user did not supply it. Perhaps separate things should stay separate,
    # and %opts and %test_dist_files should both exist for this, but why bother
    # duplicating the same information if only one options is annoyed?
    if (defined $opts{fetchwarefile} and defined $opts{append_option}) {
        die <<EOD;
fetchware: Run-time error. make_test_dist() can only be called with the
Fetchwarefile option *or* the append_option named parameters never both. Only
specify one.
EOD
    }
    if (not defined $opts{fetchwarefile}) {
        $opts{fetchwarefile} = <<EOF;
# $opts{file_name} is a fake "test distribution" meant for testing fetchware's basic
# installing, upgrading, and so on functionality.
use App::Fetchware;

program '$opts{file_name}';

# Every Fetchwarefile needs a lookup_url...
lookup_url 'file://$opts{destination_directory}';

# ...and a mirror.
mirror 'file://$opts{destination_directory}';

# Need to filter out the cruft.
filter '$opts{file_name}';

# Just use MD5 to verify it.
verify_method 'md5';

EOF
    }
    if (not defined $opts{configure}) {
        $opts{configure} = <<EOF;
#!/bin/sh

# A Test ./configure file for testing Fetchware's install, upgrade, and so on
# functionality.

echo "fetchware: ./configure ran successfully!"
EOF
    }
    if (not defined $opts{makefile}) {
        $opts{makefile} = <<EOF;
# Makefile for test-dist, which is a "test distribution" for testing Fetchware's
# install, upgrade, and so on functionality.

all:
	sh -c 'echo "fetchware: make ran successfully!"'

install:
	sh -c 'echo "fetchware: make install ran successfully!"'

uninstall:

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

	sh -c '(cd .. && tar --create --gzip --verbose --file test-dist-1.00/test-dist-1.01.fpkg  ./Fetchwarefile test-dist-1.01)'

	sh -c 'rm -r ../test-dist-1.01'

	sh -c 'md5sum test-dist-1.01.fpkg > test-dist-1.01.fpkg.md5'
EOF
    }
    if (defined $opts{append_option}) {
        $opts{fetchware} .= "\n$opts{append_option}\n"
    }


    # Set up some variables used during test_dist creation.
    # Append $ver_num to $file_name to complete the dist's name.
    my $dist_name = "$opts{file_name}-$opts{ver_num}";
    $opts{destination_directory} = rel2abs($opts{destination_directory});
    my $test_dist_filename = catfile($opts{destination_directory}, "$dist_name.fpkg");
    my $configure_path = catfile($dist_name, 'configure');


    # Be sure to add a prefix to the generated Fetchwarefile if fetchware is not
    # running as root to ensure that our test installs succeed.
    add_prefix_if_nonroot(sub {
        my $prefix_dir = tempdir("fetchware-test-$$-XXXXXXXXXX",
            TMPDIR => 1, CLEANUP => 1);
        $opts{fetchwarefile}
            .= 
            "prefix '$prefix_dir';";
        }
    );


    # Create a temp dir to create or test-dist-1.$opts{ver_num} directory in.
    # Must be done before original_cwd() is used to set $opts{destination_directory},
    # because original_cwd() is undef until create_tempdir() sets it.
    my $temp_dir = create_tempdir();

    mkdir($dist_name) or die <<EOD;
fetchware: Run-time error. Fetchware failed to create the directory
[$dist_name] in the current directory of [$temp_dir]. The OS error was
[$!].
EOD

    my %test_dist_files = (
        './Fetchwarefile' => $opts{fetchwarefile},
        $configure_path => $opts{configure},
        catfile($dist_name, 'Makefile') => $opts{makefile},
    );

    for my $file_to_create (keys %test_dist_files) {
        open(my $fh, '>', $file_to_create) or die <<EOD;
fetchware: Run-time error. Fetchware failed to open
[$file_to_create] for writing to create the Configure script that
test-dist needs to work properly. The OS error was [$!].
EOD
        print $fh $test_dist_files{$file_to_create};
        close $fh;
    }

    # chmod() ./configure, so it can be executed.
    chmod(0755, $configure_path) or die <<EOC;
fetchware: run-time error. fetchware failed to chmod [$configure_path] to add
execute permissions, which ./configure needs. Os error [$!].
EOC

    # Create a tar archive of all of the files needed for test-dist.
    Archive::Tar->create_archive("$test_dist_filename", COMPRESS_GZIP,
        keys %test_dist_files) or die <<EOD;
fetchware: Run-time error. Fetchware failed to create the test-dist archive for
testing [$test_dist_filename] The error was [@{[Archive::Tar->error()]}].
EOD

    # Cd back to original_cwd() and delete $temp_dir.
    cleanup_tempdir();

    return rel2abs($test_dist_filename);
}



sub md5sum_file {
    my $archive_to_md5 = shift;

    open(my $package_fh, '<', $archive_to_md5)
        or die <<EOD;
App-Fetchware: run-time error. Fetchware failed to open the file it downloaded
while trying to read it in order to check its MD5 sum. The file was
[$archive_to_md5]. OS error [$!]. See perldoc App::Fetchware.
EOD

    my $digest = Digest::MD5->new();

    # Digest requires the filehandle to have binmode set.
    binmode $package_fh;

    my $calculated_digest;
    eval {
        # Add the file for digesting.
        $digest->addfile($package_fh);
        # 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()]}";

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

        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 {
    my $callback = shift;
    my $prefix;
    if (not is_os_type('Unix') or $> != 0 ) {
        if (not defined $callback) {
            $prefix = tempdir("fetchware-test-$$-XXXXXXXXXX",
                TMPDIR => 1, CLEANUP => 1);
            note("Running as nonroot or nonunix using prefix temp dir [$prefix]");
            config(prefix => $prefix);
        } else {
            ok(ref $callback eq 'CODE', <<EOD);
Received callback that is a proper coderef [$callback].
EOD
            $prefix = $callback->();
        }
        
        # Return the prefix that will be used.
        return $prefix;
    } else {
        # Return undef meaning no prefix was added.
        return;
    }
}



sub create_test_fetchwarefile {
    my $fetchwarefile_content = shift;

    # Use a temp dir outside of the installation directory 
    my ($fh, $fetchwarefile_path)
        =
        tempfile("fetchware-$$-XXXXXXXXXXXXXX", TMPDIR => 1, UNLINK => 1);

    # Chmod 644 to ensure a possibly dropped priv child can still at least read
    # the file. It doesn't need write access just read.
    unless (chmod 0644, $fetchwarefile_path
        and
        # Only Unix drops privs. Nonunix does not.
        is_os_type('Unix')
    ) {
        die <<EOD;
fetchware: Failed to chmod 0644, [$fetchwarefile_path]! This is a fatal error,
because if the file is not chmod()ed, then fetchware cannot access the file if
it was created by root, and then tried to read it, but root on Unix dropped
privs. OS error [$!].
EOD
    }

    # Be sure to add a prefix to the generated Fetchwarefile if fetchware is not
    # running as root to ensure that our test installs succeed.
    #
    # Prepend a newline to ensure that prefix is not added to an existing line.
    add_prefix_if_nonroot(sub {
            my $prefix_dir = tempdir("fetchware-test-$$-XXXXXXXXXX",
                TMPDIR => 1, CLEANUP => 1);
            $fetchwarefile_content
            .= 
            "\nprefix '$prefix_dir';";
        }
    );

    # Put test stuff in Fetchwarefile.
    print $fh "$fetchwarefile_content";

    # Close the file in case it bothers Archive::Tar reading it.
    close $fh;

    return $fetchwarefile_path;
}



sub rmdashr_ok {
    my ($dir_to_recursive_delete, $test_message) = @_;

    # If $dir_to_recursive_delete is just a file, just unlink it.
    if (not -d $dir_to_recursive_delete) {
        unlink($dir_to_recursive_delete)
            or fail("Failed to unlink([$dir_to_recursive_delete]): $!")
    } else {
        # Delete the whole $tempdir. Use error and result for File::Path's
        # experimental error handling, and set safe to true to avoid borking the
        # filesystem. This might be run as root, so it really could screw up
        # your filesystem big time! So set safe to true to avoid doing so.
        my $ok = remove_tree($dir_to_recursive_delete, {
            error => \my $err,
            result => \my $res,
            safe => 1} );

        # Parse remove_tree()'s insane error handling system. It's expirimental,
        # but it's been experimental forever, so I can't see it changing.
        if (@$err) {
            for my $diag (@$err) {
                my ($file, $message) = %$diag;
                if ($file eq '') {
                    warn "general error: $message\n";
                } else {
                    warn "problem unlinking $file: $message\n";
                }
            }
        } else {
            note("No errors encountered during removal of [$dir_to_recursive_delete]\n");
        }

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

        file_name => $file_name,
        ver_num = $ver_num,
        # These are all optional...
        destination_directory => rel2abs($destination_directory),
        fetchwarefile => $fetchwarefile,
        # You can only specify fetchwarefile *or* append_option.
        append_option => q{fetchware_option 'some value';},
        configure => <<EOF,
    #!/bin/sh

    # A test ./configure for testing ./configure failure...it always fails.

    echo "fetchware: ./configure failed!
    # Return failure exit status to truly indicate failure.
    exit 1
    EOF
        makefile => <<EOF,
    # Test Makefile.
    all:
        sh -c 'echo "fetchware make failed!"'
    EOF
    );

Makes a C<$filename-$ver_num.fpkg> fetchware package that can be used for
testing fetchware's functionality without actually installing anything.

Reuses create_tempdir() to create a temp directory that is used to put the
test-dist's files in. Then an archive is created based on original_cwd() or
$destination_directory if provided, which is the current working directory
before you call make_test_dist(). After the archive is created in original_cwd(),
make_test_dist() deletes the $temp_dir using cleanup_tempdir().

If $destination_directory is not provided as an argument, then make_test_dist()
will just use tmpdir(), File::Spec's location for your system's temporary
directory.

Returns the full path to the created test-dist fetchwware package.

make_test_dist() supports customizing the C<Fetchwarefile>, C<./configure>, and
C<Makefile> of the generated make_test_dist():

=over

=item * C<fetchwarefile> - option takes a string that will be written to disk as that test dist's actual Fetchwarefile.

=item * C<append_option> - option confilicts with fetchwarefile option, so only one or the other can be used at the same time. C<append_option> quite literally just appends a fetchware option (or any other string) to the default C<Fetchwarefile>

=item * C<configure> - option takes a string that will completely replace the default ./configure file in your generated test dist. This file is expected to be a shell script by fetchware, but will probably transition into being a perl script file fo...

=item * C<makefile> - option takes a string that will completely replace the default Makefile that is placed in your generated test dist. This file is expected to actually be a real Makefile.

=back

=over

=item WARNING

When you specify your own $destination_directory, you must also B<ensure> that
it's permissions are C<0755>, because during testing fetchware may drop_privs()
causing it to lose its ability to access the $destination_directory. Therefore,
when specifying your own $destination_directory, please C<chmod> it to to
C<0755> to ensure its child can still access the test distribution in your
$destination_directory.

=back

=head2 md5sum_file()

    my $md5sum_fil_path = md5sum_file($archive_to_md5);

Uses Digest::MD5 to generate a md5sum just like the md5sum program does, and
instead of returning the output it returns the full path to a file containing
the md5sum called C<"$archive_to_md5.md5">.

=head2 expected_filename_listing()

    cmd_deeply($got_filelisting, eval(expected_filename_listing()),
        'test name');

Returns a crazy string meant for use with Test::Deep for testing that Apache
directory listings have been parsed correctly by lookup().

You must surround expected_filename_listing() with an eval, because Test::Deep's
crazy subroutines for creating complex data structure tests are actual
subroutines that need to be executed. They are not strings that can just be
returned by expected_filename_listing(), and then forwarded along to Test::Deep,
they must be executed:

    cmd_deeply($got_filelisting, eval(expected_filename_listing()),
        'test name');

=head2 verbose_on()

    verbose_on();

Just turns C<$fetchware::vebose> on, by setting it to 1. It does not do anything
else. There is no corresponding verbose_off(). Just a vebose_on().

Meant to be used in test suites, so that you can see any vmsg()s that print
during testing for debugging purposes.

=head2 export_ok()

    export_ok($sorted_subs, $sorted_export);
    
    my @api_subs
        = qw(start lookup download verify unarchive build install uninstall);
    export_ok(\@api_subs, \@TestPackage::EXPORT);

Just loops over C<@{$sorted_subs}>, and array ref, and ensures that each one
matches the same element of C<@{$sorted_export}>. You do not have to pre sort
these array refs, because export_ok() will copy them, and sort that copy of
them. Uses Test::More's pass() or fail() for each element in the arrays.

=head2 end_ok()

Because end() no longer uses File::Temp's cleanup() to delete B<all> temporary
File::Temp managed temporary directories when end() is called, you can no longer
test end() we a simple C<ok(not -e $temp_dir, $test_name);>; instead, you should
use this testing subroutine. It tests if the specified $temp_dir still has a
locked C<'fetchware.sem'> fetchware semaphore file. If the file is not locked,