Home | History | Annotate | Line # | Download | only in Config 
      1 # Copyright 2021 The OpenSSL Project Authors. All Rights Reserved.
      2 #
      3 # Licensed under the Apache License 2.0 (the "License").  You may not use
      4 # this file except in compliance with the License.  You can obtain a copy
      5 # in the file LICENSE in the source distribution or at
      6 # https://www.openssl.org/source/license.html
      7 
      8 package OpenSSL::Config::Query;
      9 
     10 use 5.10.0;
     11 use strict;
     12 use warnings;
     13 use Carp;
     14 
     15 =head1 NAME
     16 
     17 OpenSSL::Config::Query - Query OpenSSL configuration info
     18 
     19 =head1 SYNOPSIS
     20 
     21     use OpenSSL::Config::Info;
     22 
     23     my $query = OpenSSL::Config::Query->new(info => \%unified_info);
     24 
     25     # Query for something that's expected to give a scalar back
     26     my $variable = $query->method(... args ...);
     27 
     28     # Query for something that's expected to give a list back
     29     my @variable = $query->method(... args ...);
     30 
     31 =head1 DESCRIPTION
     32 
     33 The unified info structure, commonly known as the %unified_info table, has
     34 become quite complex, and a bit overwhelming to look through directly.  This
     35 module makes querying this structure simpler, through diverse methods.
     36 
     37 =head2 Constructor
     38 
     39 =over 4
     40 
     41 =item B<new> I<%options>
     42 
     43 Creates an instance of the B<OpenSSL::Config::Query> class.  It takes options
     44 in keyed pair form, i.e. a series of C<< key => value >> pairs.  Available
     45 options are:
     46 
     47 =over 4
     48 
     49 =item B<info> =E<gt> I<HASHREF>
     50 
     51 A reference to a unified information hash table, most commonly known as
     52 %unified_info.
     53 
     54 =item B<config> =E<gt> I<HASHREF>
     55 
     56 A reference to a config information hash table, most commonly known as
     57 %config.
     58 
     59 =back
     60 
     61 Example:
     62 
     63     my $info = OpenSSL::Config::Info->new(info => \%unified_info);
     64 
     65 =back
     66 
     67 =cut
     68 
     69 sub new {
     70     my $class = shift;
     71     my %opts = @_;
     72 
     73     my @messages = _check_accepted_options(\%opts,
     74                                            info => 'HASH',
     75                                            config => 'HASH');
     76     croak $messages[0] if @messages;
     77 
     78     # We make a shallow copy of the input structure.  We might make
     79     # a different choice in the future...
     80     my $instance = { info => $opts{info} // {},
     81                      config => $opts{config} // {} };
     82     bless $instance, $class;
     83 
     84     return $instance;
     85 }
     86 
     87 =head2 Query methods
     88 
     89 =over 4
     90 
     91 =item B<get_sources> I<LIST>
     92 
     93 LIST is expected to be the collection of names of end products, such as
     94 programs, modules, libraries.
     95 
     96 The returned result is a hash table reference, with each key being one of
     97 these end product names, and its value being a reference to an array of
     98 source file names that constitutes everything that will or may become part
     99 of that end product.
    100 
    101 =cut
    102 
    103 sub get_sources {
    104     my $self = shift;
    105 
    106     my $result = {};
    107     foreach (@_) {
    108         my @sources = @{$self->{info}->{sources}->{$_} // []};
    109         my @staticlibs =
    110             grep { $_ =~ m|\.a$| } @{$self->{info}->{depends}->{$_} // []};
    111 
    112         my %parts = ( %{$self->get_sources(@sources)},
    113                       %{$self->get_sources(@staticlibs)} );
    114         my @parts = map { @{$_} } values %parts;
    115 
    116         my @generator =
    117             ( ( $self->{info}->{generate}->{$_} // [] ) -> [0] // () );
    118         my %generator_parts = %{$self->get_sources(@generator)};
    119         # if there are any generator parts, we ignore it, because that means
    120         # it's a compiled program and thus NOT part of the source that's
    121         # queried.
    122         @generator = () if %generator_parts;
    123 
    124         my @partial_result =
    125             ( ( map { @{$_} } values %parts ),
    126               ( grep { !defined($parts{$_}) } @sources, @generator ) );
    127 
    128         # Push conditionally, to avoid creating $result->{$_} with an empty
    129         # value
    130         push @{$result->{$_}}, @partial_result if @partial_result;
    131     }
    132 
    133     return $result;
    134 }
    135 
    136 =item B<get_config> I<LIST>
    137 
    138 LIST is expected to be the collection of names of configuration data, such
    139 as build_infos, sourcedir, ...
    140 
    141 The returned result is a hash table reference, with each key being one of
    142 these configuration data names, and its value being a reference to the value
    143 corresponding to that name.
    144 
    145 =cut
    146 
    147 sub get_config {
    148     my $self = shift;
    149 
    150     return { map { $_ => $self->{config}->{$_} } @_ };
    151 }
    152 
    153 ########
    154 #
    155 #  Helper functions
    156 #
    157 
    158 sub _check_accepted_options {
    159     my $opts = shift;           # HASH reference (hopefully)
    160     my %conds = @_;             # key => type
    161 
    162     my @messages;
    163     my %optnames = map { $_ => 1 } keys %$opts;
    164     foreach (keys %conds) {
    165         delete $optnames{$_};
    166     }
    167     push @messages, "Unknown options: " . join(', ', sort keys %optnames)
    168         if keys %optnames;
    169     foreach (sort keys %conds) {
    170         push @messages, "'$_' value not a $conds{$_} reference"
    171             if (defined $conds{$_} && defined $opts->{$_}
    172                 && ref $opts->{$_} ne $conds{$_});
    173     }
    174     return @messages;
    175 }
    176 
    177 1;
    178