Use Configure's @disablables and %disabled through configdata.pm

print OUT <<"EOF";

);

EOF

print OUT "our \%available_protocols = (\n";

print OUT "  tls => [ ", join(", ", map { quotify("perl", $_) } @tls), " ],\n";

print OUT "  dtls => [ ", join(", ", map { quotify("perl", $_) } @dtls), " ],\n";

print OUT <<"EOF";

);

EOF

print OUT "our \%disabled = (\n";

foreach (sort keys %disabled) {

    print OUT "  ", quotify("perl", $_), " => ", quotify("perl", $disabled{$_}), ",\n";

}

print OUT <<"EOF";

);

EOF

print OUT "our %withargs = (\n";

foreach (sort keys %withargs) {

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION = "0.1";

@ISA = qw(Exporter);

@EXPORT = qw(disabled config);

@EXPORT = qw(alldisabled anydisabled disabled config available_protocols);

=head1 NAME

  use OpenSSL::Test::Utils;

  disabled("dh");

  my @tls = available_protocols("tls");

  my @dtls = available_protocols("dtls");

  alldisabled("dh", "dsa");

  anydisabled("dh", "dsa");

  config("no_shared");

  config("fips");

=head1 DESCRIPTION

=over 4

=item B<disabled ARRAY>

=item B<available_protocols STRING>

In a scalar context returns 1 if any of the features in ARRAY is disabled.

Returns a list of strings for all the available SSL/TLS versions if

STRING is "tls", or for all the available DTLS versions if STRING is

"dtls".  Otherwise, it returns the empty list.  The strings in the

returned list can be used with B<alldisabled> and B<anydisabled>.

=item B<alldisabled ARRAY>

=item B<anydisabled ARRAY>

In an array context returns an array with each element set to 1 if the

corresponding feature is disabled and 0 otherwise.

In a scalar context, alldisabled returns 1 if all of the features in

ARRAY are disabled, while anydisabled returns 1 if any of them are

disabled.

=item B<config STRING>

Returns an item from the %config hash in \$TOP/configdata.pm.

=cut

our %available_protocols;

our %disabled;

my $disabled_set = 0;

our %config;

my $configdata_loaded = 0;

sub load_configdata {

    # We eval it so it doesn't run at compile time of this file.

    # The latter would have top_dir() complain that setup() hasn't

    # been run yet.

    my $configdata = top_file("configdata.pm");

    eval { require $configdata;

	   %available_protocols = %configdata::available_protocols;

	   %disabled = %configdata::disabled;

	   %config = %configdata::config;

    };

    $configdata_loaded = 1;

}

# args

#  list of 1s and 0s, coming from check_disabled()

sub anyof {

    my $x = 0;

    foreach (@_) { $x += $_ }

    return $x > 0;

}

# args

#  list of 1s and 0s, coming from check_disabled()

sub allof {

    my $x = 1;

    foreach (@_) { $x *= $_ }

    return $x > 0;

}

# args

#  list of strings, all of them should be names of features

#  that can be disabled.

# returns a list of 1s (if the corresponding feature is disabled)

#  and 0s (if it isn't)

sub check_disabled {

#print STDERR "Running check_disabled\n";

    foreach (run(app(["openssl", "list", "-disabled"]), capture => 1)) {

        s/\R//;         # chomp;

        next if /:/;    # skip header

        $disabled{lc $_} = 1;

    return map { exists $disabled{lc $_} ? 1 : 0 } @_;

}

    $disabled_set = 1;

# Exported functions #################################################

# args:

#  list of features to check

sub anydisabled {

    load_configdata() unless $configdata_loaded;

    my @ret = check_disabled(@_);

    return @ret if wantarray;

    return anyof(@ret);

}

# args:

#  list of features to check

sub disabled {

    check_disabled() unless $disabled_set;

    if (wantarray) {

        my @ret;

        foreach (@_) {

            push @ret, exists $disabled{lc $_} ? 1 : 0;

sub alldisabled {

    load_configdata() unless $configdata_loaded;

    my @ret = check_disabled(@_);

    return @ret if wantarray;

    return allof(@ret);

}

        return @ret;

#!!! Kept for backward compatibility

# args:

#  single string

sub disabled {

    anydisabled(@_);

}

    foreach (@_) {

        return 1 if exists $disabled{lc $_};

sub available_protocols {

    my $protocol_class = shift;

    if (exists $available_protocols{lc $protocol_class}) {

	return @{$available_protocols{lc $protocol_class}}

    }

    return 0;

    return ();

}

our %config;

sub config {

    if (!%config) {

	# We eval it so it doesn't run at compile time of this file.

	# The latter would have top_dir() complain that setup() hasn't

	# been run yet.

	my $configdata = top_file("configdata.pm");

	eval { require $configdata; %config = %configdata::config };

    }

    return $config{$_[0]};

}

=head1 AUTHORS

Stephen Henson E<lt>steve@openssl.orgE<gt> with inspiration

from Richard Levitte E<lt>levitte@openssl.orgE<gt>

Stephen Henson E<lt>steve@openssl.orgE<gt> and

Richard Levitte E<lt>levitte@openssl.orgE<gt>

=cut