test/testlib/OpenSSL/Test/Utils.pm

   1 package OpenSSL::Test::Utils;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Exporter;
   7 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
   8 $VERSION = "0.1";
   9 @ISA = qw(Exporter);
  10 @EXPORT = qw(disabled config);
  11
  12 =head1 NAME
  13
  14 OpenSSL::Test::Utils - test utility functions
  15
  16 =head1 SYNOPSIS
  17
  18   use OpenSSL::Test::Utils;
  19
  20   disabled("dh");
  21
  22   config("no_shared");
  23
  24 =head1 DESCRIPTION
  25
  26 This module provides utility functions for the testing framework.
  27
  28 =cut
  29
  30 use OpenSSL::Test qw/:DEFAULT top_file/;
  31
  32 =over 4
  33
  34 =item B<disabled ARRAY>
  35
  36 In a scalar context returns 1 if any of the features in ARRAY is disabled.
  37
  38 In an array context returns an array with each element set to 1 if the
  39 corresponding feature is disabled and 0 otherwise.
  40
  41 =item B<config STRING>
  42
  43 Returns an item from the %config hash in \$TOP/configdata.pm.
  44
  45 =back
  46
  47 =cut
  48
  49 our %disabled;
  50 my $disabled_set = 0;
  51
  52 sub check_disabled {
  53 #print STDERR "Running check_disabled\n";
  54     foreach (run(app(["openssl", "list", "-disabled"]), capture => 1)) {
  55         s/\R//;         # chomp;
  56         next if /:/;    # skip header
  57         $disabled{lc $_} = 1;
  58     }
  59     $disabled_set = 1;
  60 }
  61
  62 # args:
  63 #  list of features to check
  64 sub disabled {
  65     check_disabled() unless $disabled_set;
  66     if (wantarray) {
  67         my @ret;
  68         foreach (@_) {
  69             push @ret, exists $disabled{lc $_} ? 1 : 0;
  70         }
  71         return @ret;
  72     }
  73     foreach (@_) {
  74         return 1 if exists $disabled{lc $_};
  75     }
  76     return 0;
  77 }
  78
  79 our %config;
  80 sub config {
  81     if (!%config) {
  82         # We eval it so it doesn't run at compile time of this file.
  83         # The latter would have top_dir() complain that setup() hasn't
  84         # been run yet.
  85         my $configdata = top_file("configdata.pm");
  86         eval { require $configdata; %config = %configdata::config };
  87     }
  88     return $config{$_[0]};
  89 }
  90
  91 =head1 SEE ALSO
  92
  93 L<OpenSSL::Test>
  94
  95 =head1 AUTHORS
  96
  97 Stephen Henson E<lt>steve@openssl.orgE<gt> with inspiration
  98 from Richard Levitte E<lt>levitte@openssl.orgE<gt>
  99
 100 =cut
 101
 102 1;