70_compression_detect.t

#!/usr/bin/perl

# Test whether the client and server classes correctly detect the presence
# or absence of compression support.

use strict;
use warnings;
use vars qw($compression_available %TEST_PKGS);

use Symbol 'delete_package';

use Test::More;

# First, determine if we actually *do* have Compress::Zlib available:
eval { require Compress::Zlib; };
$compression_available = ($@) ? 0 : 1;

# These are the modules that need to correctly detect compression:
%TEST_PKGS = ( 'RPC::XML::Client' => 'RPC/XML/Client.pm',
               'RPC::XML::Server' => 'RPC/XML/Server.pm' );

plan tests => (2 * (scalar keys %TEST_PKGS));

# Clear out Compress::Zlib so it'll try to load again:
clear('Compress::Zlib', 'Compress/Zlib.pm');

# If compression is truly not available, just test that the modules correctly
# detect this. Otherwise, get crafty.

# Start by testing failure-to-detect
unshift(@INC, sub {
    die "Force-failing Compress::Zlib" if ($_[1] eq 'Compress/Zlib.pm');
    return undef;
}) if ($compression_available);

for my $pkg (sort keys %TEST_PKGS)
{
    no strict 'refs';

    eval "require $pkg;";

    is(${"${pkg}::COMPRESSION_AVAILABLE"}, '',
       "$pkg correctly saw no Compress::Zlib");

    # Remove from %INC so later tests still run
    clear($pkg, $TEST_PKGS{$pkg});
}

SKIP: {
    # Test successful detection, but only if we actually have Compress::Zlib
    skip 'Compress::Zlib truly not available', (scalar keys %TEST_PKGS)
        unless $compression_available;

    shift(@INC); # Drop the force-failure sub from above
    for my $pkg (sort keys %TEST_PKGS)
    {
        no strict 'refs';

        clear('Compress::Zlib', 'Compress/Zlib.pm');
        for (qw(deflate flush inflate))
        {
            clear('Compress::Zlib', 'Compress/Zlib.pm', $_);
        }
        eval "require $pkg;";

        # I am not explicitly testing for "deflate" here, because that might
        # change in the future. What matters is that it is not null.
        isnt(${"${pkg}::COMPRESSION_AVAILABLE"}, '',
           "$pkg correctly detected Compress::Zlib");
    }
}

exit;

sub clear
{
    no strict 'refs';

    my ($pkg, $file, $name) = @_;

    delete $INC{$file};
    delete_package($pkg);
    if ($pkg eq 'Compress::Zlib')
    {
        delete_package 'Zlib::OldDeflate';
        delete_package 'Zlib::OldInflate';
    }
}