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