#! /usr/bin/env perl
# Copyright 2018-2023 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::Ordinals;
use strict;
use warnings;
use Carp;
use Scalar::Util qw(blessed);
use OpenSSL::Util;
use constant {
# "magic" filters, see the filters at the end of the file
F_NAME => 1,
F_NUMBER => 2,
};
=head1 NAME
OpenSSL::Ordinals - a private module to read and walk through ordinals
=head1 SYNOPSIS
use OpenSSL::Ordinals;
my $ordinals = OpenSSL::Ordinals->new(from => "foo.num");
# or alternatively
my $ordinals = OpenSSL::Ordinals->new();
$ordinals->load("foo.num");
foreach ($ordinals->items(comparator => by_name()) {
print $_->name(), "\n";
}
=head1 DESCRIPTION
This is a OpenSSL private module to load an ordinals (F<.num>) file and
write out the data you want, sorted and filtered according to your rules.
An ordinals file is a file that enumerates all the symbols that a shared
library or loadable module must export. Each of them have a unique
assigned number as well as other attributes to indicate if they only exist
on a subset of the supported platforms, or if they are specific to certain
features.
The unique numbers each symbol gets assigned needs to be maintained for a
shared library or module to stay compatible with previous versions on
platforms that maintain a transfer vector indexed by position rather than
by name. They also help keep information on certain symbols that are
aliases for others for certain platforms, or that have different forms
on different platforms.
=head2 Main methods
=over 4
=cut
=item B<new> I<%options>
Creates a new instance of the C<OpenSSL::Ordinals> class. It takes options
in keyed pair form, i.e. a series of C<< key => value >> pairs. Available
options are:
=over 4
=item B<< from => FILENAME >>
Not only create a new instance, but immediately load it with data from the
ordinals file FILENAME.
=back
=cut
sub new {
my $class = shift;
my %opts = @_;
my $instance = {
filename => undef, # File name registered when loading
loaded_maxnum => 0, # Highest allocated item number when loading
loaded_contents => [], # Loaded items, if loading there was
maxassigned => 0, # Current highest assigned item number
maxnum => 0, # Current highest allocated item number
contents => [], # Items, indexed by number
name2num => {}, # Name to number dictionary
aliases => {}, # Aliases cache.
stats => {}, # Statistics, see 'sub validate'
debug => $opts{debug},
};
bless $instance, $class;
$instance->set_version($opts{version});
$instance->load($opts{from}) if defined($opts{from});
return $instance;
}
=item B<< $ordinals->load FILENAME >>
Loads the data from FILENAME into the instance. Any previously loaded data
is dropped.
Two internal databases are created. One database is simply a copy of the file
contents and is treated as read-only. The other database is an exact copy of
the first, but is treated as a work database, i.e. it can be modified and added
to.
=cut
sub load {
my $self = shift;
my $filename = shift;
croak "Undefined filename" unless defined($filename);
my @tmp_contents = ();
my %tmp_name2num = ();
my $max_assigned = 0;
my $max_num = 0;
open F, '<', $filename or croak "Unable to open $filename";
while (<F>) {
s|\R$||; # Better chomp
s|#.*||;
next if /^\s*$/;
my $item = OpenSSL::Ordinals::Item->new(source => $filename, from => $_);
my $num = $item->number();
if ($num eq '?') {
$num = ++$max_num;
} elsif ($num eq '?+') {
$num = $max_num;
} else {
croak "Disordered ordinals, number sequence restarted"
if $max_num > $max_assigned && $num < $max_num;
croak "Disordered ordinals, $num < $max_num"
if $num < $max_num;
$max_assigned = $max_num = $num;
}
$item->intnum($num);
push @{$tmp_contents[$num]}, $item;
$tmp_name2num{$item->name()} = $num;
}
close F;
$self->{contents} = [ @tmp_contents ];
$self->{name2num} = { %tmp_name2num };
$self->{maxassigned} = $max_assigned;
$self->{maxnum} = $max_num;
$self->{filename} = $filename;
# Make a deep copy, allowing {contents} to be an independent work array
foreach my $i (1..$max_num) {
if ($tmp_contents[$i]) {
$self->{loaded_contents}->[$i] =
[ map { OpenSSL::Ordinals::Item->new($_) }
@{$tmp_contents[$i]} ];
}
}
$self->{loaded_maxnum} = $max_num;
return 1;
}
=item B<< $ordinals->renumber >>
Renumber any item that doesn't have an assigned number yet.
=cut
sub renumber {
my $self = shift;
my $max_assigned = 0;
foreach ($self->items(sort => by_number())) {
$_->number($_->intnum()) if $_->number() =~ m|^\?|;
if ($max_assigned < $_->number()) {
$max_assigned = $_->number();
}
}
$self->{maxassigned} = $max_assigned;
}
=item B<< $ordinals->rewrite >>
=item B<< $ordinals->rewrite >>, I<%options>
If an ordinals file has been loaded, it gets rewritten with the data from
the current work database.
If there are more arguments, they are used as I<%options> with the
same semantics as for B<< $ordinals->items >> described below, apart
from B<sort>, which is forbidden here.
=cut
sub rewrite {
my $self = shift;
my %opts = @_;
$self->write($self->{filename}, %opts);
}
=item B<< $ordinals->write FILENAME >>
=item B<< $ordinals->write FILENAME >>, I<%options>
Writes the current work database data to the ordinals file FILENAME.
This also validates the data, see B<< $ordinals->validate >> below.
If there are more arguments, they are used as I<%options> with the
same semantics as for B<< $ordinals->items >> described next, apart
from B<sort>, which is forbidden here.
=cut
sub write {
my $self = shift;
my $filename = shift;
my %opts = @_;
croak "Undefined filename" unless defined($filename);
croak "The 'sort' option is not allowed" if $opts{sort};
$self->validate();
open F, '>', $filename or croak "Unable to open $filename";
foreach ($self->items(%opts, sort => by_number())) {
print F $_->to_string(),"\n";
}
close F;
$self->{filename} = $filename;
$self->{loaded_maxnum} = $self->{maxnum};
return 1;
}
=item B<< $ordinals->items >> I<%options>
Returns a list of items according to a set of criteria. The criteria is
given in form keyed pair form, i.e. a series of C<< key => value >> pairs.
Available options are:
=over 4
=item B<< sort => SORTFUNCTION >>
SORTFUNCTION is a reference to a function that takes two arguments, which
correspond to the classic C<$a> and C<$b> that are available in a C<sort>
block.
=item B<< filter => FILTERFUNCTION >>
FILTERFUNCTION is a reference to a function that takes one argument, which
is every OpenSSL::Ordinals::Item element available.
=back
=cut
sub items {
my $self = shift;
my %opts = @_;
my $comparator = $opts{sort};
my $filter = $opts{filter} // sub { 1; };
my @l = undef;
if (ref($filter) eq 'ARRAY') {
# run a "magic" filter
if ($filter->[0] == F_NUMBER) {
my $index = $filter->[1];
@l = $index ? @{$self->{contents}->[$index] // []} : ();
} elsif ($filter->[0] == F_NAME) {
my $index = $self->{name2num}->{$filter->[1]};
@l = $index ? @{$self->{contents}->[$index] // []} : ();
} else {
croak __PACKAGE__."->items called with invalid filter";
}
} elsif (ref($filter) eq 'CODE') {
@l = grep { $filter->($_) }
map { @{$_ // []} }
@{$self->{contents}};
} else {
croak __PACKAGE__."->items called with invalid filter";
}
return sort { $comparator->($a, $b); } @l
if (defined $comparator);
return @l;
}
# Put an array of items back into the object after having checked consistency
# If there are exactly two items:
# - They MUST have the same number
# - They MUST have the same version
# - For platforms, both MUST hold the same ones, but with opposite values
# - For features, both MUST hold the same ones.
# - They MUST NOT have identical name, type, numeral, version, platforms, and features
# If there's just one item, just put it in the slot of its number
# In all other cases, something is wrong
sub _putback {
my $self = shift;
my @items = @_;
if (scalar @items < 1 || scalar @items > 2) {
croak "Wrong number of items: ", scalar @items, "\n ",
join("\n ", map { $_->{source}.": ".$_->name() } @items), "\n";
}
if (scalar @items == 2) {
# Collect some data
my %numbers = ();
my %versions = ();
my %features = ();
foreach (@items) {
$numbers{$_->intnum()} = 1;
$versions{$_->version()} = 1;
foreach ($_->features()) {
$features{$_}++;
}
}
# Check that all items we're trying to put back have the same number
croak "Items don't have the same numeral: ",
join(", ", map { $_->name()." => ".$_->intnum() } @items), "\n"
if (scalar keys %numbers > 1);
croak "Items don't have the same version: ",
join(", ", map { $_->name()." => ".$_->version() } @items), "\n"
if (scalar keys %versions > 1);
# Check that both items run with the same features
foreach (@items) {
}
foreach (keys %features) {
delete $features{$_} if $features{$_} == 2;
}
croak "Features not in common between ",
$items[0]->name(), " and ", $items[1]->name(), ":",
join(", ", sort keys %features), "\n"
if %features;
# Check for in addition identical name, type, and platforms
croak "Duplicate entries for ".$items[0]->name()." from ".
$items[0]->source()." and ".$items[1]->source()."\n"
if $items[0]->name() eq $items[1]->name()
&& $items[0]->type() eq $items[1]->type()
&& $items[0]->platforms() eq $items[1]->platforms();
# Check that all platforms exist in both items, and have opposite values
my @platforms = ( { $items[0]->platforms() },
{ $items[1]->platforms() } );
foreach my $platform (keys %{$platforms[0]}) {
if (exists $platforms[1]->{$platform}) {
if ($platforms[0]->{$platform} != !$platforms[1]->{$platform}) {
croak "Platforms aren't opposite: ",
join(", ",
map { my %tmp_h = $_->platforms();
$_->name().":".$platform
." => "
.$tmp_h{$platform} } @items),
"\n";
}
# We're done with these
delete $platforms[0]->{$platform};
delete $platforms[1]->{$platform};
}
}
# If there are any remaining platforms, something's wrong
if (%{$platforms[0]} || %{$platforms[0]}) {
croak "There are platforms not in common between ",
$items[0]->name(), " and ", $items[1]->name(), "\n";
}
}
$self->{contents}->[$items[0]->intnum()] = [ @items ];
}
sub _parse_platforms {
my $self = shift;
my @defs = @_;
my %platforms = ();
foreach (@defs) {
m{^(!)?};
my $op = !(defined $1 && $1 eq '!');
my $def = $';
if ($def =~ m{^_?WIN32$}) { $platforms{$&} = $op; }
if ($def =~ m{^__FreeBSD__$}) { $platforms{$&} = $op; }
# For future support
# if ($def =~ m{^__DragonFly__$}) { $platforms{$&} = $op; }
# if ($def =~ m{^__OpenBSD__$}) { $platforms{$&} = $op; }
# if ($def =~ m{^__NetBSD__$}) { $platforms{$&} = $op; }
if ($def =~ m{^OPENSSL_SYS_}) { $platforms{$'} = $op; }
}
return %platforms;
}
sub _parse_features {
my $self = shift;
my @defs = @_;
my %features = ();
foreach (@defs) {
m{^(!)?};
my $op = !(defined $1 && $1 eq '!');
my $def = $';
if ($def =~ m{^ZLIB$}) { $features{$&} = $op; }
if ($def =~ m{^OPENSSL_USE_}) { $features{$'} = $op; }
if ($def =~ m{^OPENSSL_NO_}) { $features{$'} = !$op; }
}
return %features;
}
sub _adjust_version {
my $self = shift;
my $version = shift;
my $baseversion = $self->{baseversion};
$version = $baseversion
if ($baseversion ne '*' && $version ne '*'
&& cmp_versions($baseversion, $version) > 0);
return $version;
}
=item B<< $ordinals->add SOURCE, NAME, TYPE, LIST >>
Adds a new item from file SOURCE named NAME with the type TYPE,
and a set of C macros in
LIST that are expected to be defined or undefined to use this symbol, if
any. For undefined macros, they each must be prefixed with a C<!>.
If this symbol already exists in loaded data, it will be rewritten using
the new input data, but will keep the same ordinal number and version.
If it's entirely new, it will get a '?' and the current default version.
=cut
sub add {
my $self = shift;
my $source = shift; # file where item was defined
my $name = shift;
my $type = shift; # FUNCTION or VARIABLE
my @defs = @_; # Macros from #ifdef and #ifndef
# (the latter prefixed with a '!')
# call signature for debug output
my $verbsig = "add('$name' , '$type' , [ " . join(', ', @defs) . " ])";
croak __PACKAGE__."->add got a bad type '$type'"
unless $type eq 'FUNCTION' || $type eq 'VARIABLE';
my %platforms = _parse_platforms(@defs);
my %features = _parse_features(@defs);
my @items = $self->items(filter => f_name($name));
my $version = @items ? $items[0]->version() : $self->{currversion};
my $intnum = @items ? $items[0]->intnum() : ++$self->{maxnum};
my $number = @items ? $items[0]->number() : '?';
print STDERR "DEBUG[",__PACKAGE__,":add] $verbsig\n",
@items ? map { "\t".$_->to_string()."\n" } @items : "No previous items\n",
if $self->{debug};
@items = grep { $_->exists() } @items;
my $new_item =
OpenSSL::Ordinals::Item->new( source => $source,
name => $name,
type => $type,
number => $number,
intnum => $intnum,
version =>
$self->_adjust_version($version),
exists => 1,
platforms => { %platforms },
features => [
grep { $features{$_} } keys %features
] );
push @items, $new_item;
print STDERR "DEBUG[",__PACKAGE__,"::add] $verbsig\n", map { "\t".$_->to_string()."\n" } @items
if $self->{debug};
$self->_putback(@items);
# If an alias was defined beforehand, add an item for it now
my $alias = $self->{aliases}->{$name};
delete $self->{aliases}->{$name};
# For the caller to show
my @returns = ( $new_item );
push @returns, $self->add_alias($source, $alias->{name}, $name, @{$alias->{defs}})
if defined $alias;
return @returns;
}
=item B<< $ordinals->add_alias SOURCE, ALIAS, NAME, LIST >>
Adds an alias ALIAS for the symbol NAME from file SOURCE, and a set of C macros
in LIST that are expected to be defined or undefined to use this symbol, if any.
For undefined macros, they each must be prefixed with a C<!>.
If this symbol already exists in loaded data, it will be rewritten using
the new input data. Otherwise, the data will just be store away, to wait
that the symbol NAME shows up.
=cut
sub add_alias {
my $self = shift;
my $source = shift;
my $alias = shift; # This is the alias being added
my $name = shift; # For this name (assuming it exists)
my @defs = @_; # Platform attributes for the alias
# call signature for debug output
my $verbsig =
"add_alias('$source' , '$alias' , '$name' , [ " . join(', ', @defs) . " ])";
croak "You're kidding me... $alias == $name" if $alias eq $name;
my %platforms = _parse_platforms(@defs);
my %features = _parse_features(@defs);
croak "Alias with associated features is forbidden\n"
if %features;
my $f_byalias = f_name($alias);
my $f_byname = f_name($name);
my @items = $self->items(filter => $f_byalias);
foreach my $item ($self->items(filter => $f_byname)) {
push @items, $item unless grep { $_ == $item } @items;
}
@items = grep { $_->exists() } @items;
croak "Alias already exists ($alias => $name)"
if scalar @items > 1;
if (scalar @items == 0) {
# The item we want to alias for doesn't exist yet, so we cache the
# alias and hope the item we're making an alias of shows up later
$self->{aliases}->{$name} = { source => $source,
name => $alias, defs => [ @defs ] };
print STDERR "DEBUG[",__PACKAGE__,":add_alias] $verbsig\n",
"\tSet future alias $alias => $name\n"
if $self->{debug};
return ();
} elsif (scalar @items == 1) {
# The rule is that an alias is more or less a copy of the original
# item, just with another name. Also, the platforms given here are
# given to the original item as well, with opposite values.
my %alias_platforms = $items[0]->platforms();
foreach (keys %platforms) {
$alias_platforms{$_} = !$platforms{$_};
}
# We supposedly do now know how to do this... *ahem*
$items[0]->{platforms} = { %alias_platforms };
my $number =
$items[0]->number() =~ m|^\?| ? '?+' : $items[0]->number();
my $alias_item = OpenSSL::Ordinals::Item->new(
source => $source,
name => $alias,
type => $items[0]->type(),
number => $number,
intnum => $items[0]->intnum(),
version => $self->_adjust_version($items[0]->version()),
exists => $items[0]->exists(),
platforms => { %platforms },
features => [ $items[0]->features() ]
);
push @items, $alias_item;
print STDERR "DEBUG[",__PACKAGE__,":add_alias] $verbsig\n",
map { "\t".$_->to_string()."\n" } @items
if $self->{debug};
$self->_putback(@items);
# For the caller to show
return ( $alias_item->to_string() );
}
croak "$name has an alias already (trying to add alias $alias)\n",
"\t", join(", ", map { $_->name() } @items), "\n";
}
=item B<< $ordinals->set_version VERSION >>
=item B<< $ordinals->set_version VERSION BASEVERSION >>
Sets the default version for new symbol to VERSION.
If given, BASEVERSION sets the base version, i.e. the minimum version
for all symbols. If not given, it will be calculated as follows:
=over 4
If the given version is '*', then the base version will also be '*'.
If the given version starts with '0.', the base version will be '0.0.0'.
If the given version starts with '1.0.', the base version will be '1.0.0'.
If the given version starts with '1.1.', the base version will be '1.1.0'.
If the given version has a first number C<N> that's greater than 1, the
base version will be formed from C<N>: 'N.0.0'.
=back
=cut
sub set_version {
my $self = shift;
# '*' is for "we don't care"
my $version = shift // '*';
my $baseversion = shift // '*';
if ($baseversion eq '*') {
$baseversion = $version;
if ($baseversion ne '*') {
if ($baseversion =~ m|^(\d+)\.|, $1 > 1) {
$baseversion = "$1.0.0";
} else {
$baseversion =~ s|^0\..*$|0.0.0|;
$baseversion =~ s|^1\.0\..*$|1.0.0|;
$baseversion =~ s|^1\.1\..*$|1.1.0|;
die 'Invalid version'
if ($baseversion ne '0.0.0'
&& $baseversion !~ m|^1\.[01]\.0$|);
}
}
}
die 'Invalid base version'
if ($baseversion ne '*' && $version ne '*'
&& cmp_versions($baseversion, $version) > 0);
$self->{currversion} = $version;
$self->{baseversion} = $baseversion;
foreach ($self->items(filter => sub { $_[0] eq '*' })) {
$_->{version} = $self->{currversion};
}
return 1;
}
=item B<< $ordinals->invalidate >>
Invalidates the whole working database. The practical effect is that all
symbols are set to not exist, but are kept around in the database to retain
ordinal numbers and versions.
=cut
sub invalidate {
my $self = shift;
foreach (@{$self->{contents}}) {
foreach (@{$_ // []}) {
$_->{exists} = 0;
}
}
$self->{stats} = {};
}
=item B<< $ordinals->validate >>
Validates the current working database by collection statistics on how many
symbols were added and how many were changed. These numbers can be retrieved
with B<< $ordinals->stats >>.
=cut
sub validate {
my $self = shift;
$self->{stats} = {};
for my $i (1..$self->{maxnum}) {
if ($i > $self->{loaded_maxnum}
|| (!@{$self->{loaded_contents}->[$i] // []}
&& @{$self->{contents}->[$i] // []})) {
$self->{stats}->{new}++;
}
if ($i <= $self->{maxassigned}) {
$self->{stats}->{assigned}++;
} else {
$self->{stats}->{unassigned}++;
}
next if ($i > $self->{loaded_maxnum});
my @loaded_strings =
map { $_->to_string() } @{$self->{loaded_contents}->[$i] // []};
my @current_strings =
map { $_->to_string() } @{$self->{contents}->[$i] // []};
foreach my $str (@current_strings) {
@loaded_strings = grep { $str ne $_ } @loaded_strings;
}
if (@loaded_strings) {
$self->{stats}->{modified}++;
}
}
}
=item B<< $ordinals->stats >>
Returns the statistics that B<validate> calculate.
=cut
sub stats {
my $self = shift;
return %{$self->{stats}};
}
=back
=head2 Data elements
Data elements, which is each line in an ordinals file, are instances
of a separate class, OpenSSL::Ordinals::Item, with its own methods:
=over 4
=cut
package OpenSSL::Ordinals::Item;
use strict;
use warnings;
use Carp;
=item B<new> I<%options>
Creates a new instance of the C<OpenSSL::Ordinals::Item> class. It takes
options in keyed pair form, i.e. a series of C<< key => value >> pairs.
Available options are:
=over 4
=item B<< source => FILENAME >>, B<< from => STRING >>
This will create a new item from FILENAME, filled with data coming from STRING.
STRING must conform to the following EBNF description:
ordinal string = symbol, spaces, ordinal, spaces, version, spaces,
exist, ":", platforms, ":", type, ":", features;
spaces = space, { space };
space = " " | "\t";
symbol = ( letter | "_" ), { letter | digit | "_" };
ordinal = number | "?" | "?+";
version = number, "_", number, "_", number, [ letter, [ letter ] ];
exist = "EXIST" | "NOEXIST";
platforms = platform, { ",", platform };
platform = ( letter | "_" ) { letter | digit | "_" };
type = "FUNCTION" | "VARIABLE";
features = feature, { ",", feature };
feature = ( letter | "_" ) { letter | digit | "_" };
number = digit, { digit };
(C<letter> and C<digit> are assumed self evident)
=item B<< source => FILENAME >>, B<< name => STRING >>, B<< number => NUMBER >>,
B<< version => STRING >>, B<< exists => BOOLEAN >>, B<< type => STRING >>,
B<< platforms => HASHref >>, B<< features => LISTref >>
This will create a new item with data coming from the arguments.
=back
=cut
sub new {
my $class = shift;
if (ref($_[0]) eq $class) {
return $class->new( map { $_ => $_[0]->{$_} } keys %{$_[0]} );
}
my %opts = @_;
croak "No argument given" unless %opts;
my $instance = undef;
if ($opts{from}) {
my @a = split /\s+/, $opts{from};
croak "Badly formatted ordinals string: $opts{from}"
unless ( scalar @a == 4
&& $a[0] =~ /^[A-Za-z_][A-Za-z_0-9]*$/
&& $a[1] =~ /^\d+|\?\+?$/
&& $a[2] =~ /^(?:\*|\d+_\d+_\d+[a-z]{0,2})$/
&& $a[3] =~ /^
(?:NO)?EXIST:
[^:]*:
(?:FUNCTION|VARIABLE):
[^:]*
$
/x );
my @b = split /:/, $a[3];
%opts = ( source => $opts{source},
name => $a[0],
number => $a[1],
version => $a[2],
exists => $b[0] eq 'EXIST',
platforms => { map { m|^(!)?|; $' => !$1 }
split /,/,$b[1] },
type => $b[2],
features => [ split /,/,$b[3] // '' ] );
}
if ($opts{name} && $opts{version} && defined $opts{exists} && $opts{type}
&& ref($opts{platforms} // {}) eq 'HASH'
&& ref($opts{features} // []) eq 'ARRAY') {
my $version = $opts{version};
$version =~ s|_|.|g;
$instance = { source => $opts{source},
name => $opts{name},
type => $opts{type},
number => $opts{number},
intnum => $opts{intnum},
version => $version,
exists => !!$opts{exists},
platforms => { %{$opts{platforms} // {}} },
features => [ sort @{$opts{features} // []} ] };
} else {
croak __PACKAGE__."->new() called with bad arguments\n".
join("", map { " $_\t=> ".$opts{$_}."\n" } sort keys %opts);
}
return bless $instance, $class;
}
sub DESTROY {
}
=item B<< $item->name >>
The symbol name for this item.
=item B<< $item->number >> (read-write)
The positional number for this item.
This may be '?' for an unassigned symbol, or '?+' for an unassigned symbol
that's an alias for the previous symbol. '?' and '?+' must be properly
handled by the caller. The caller may change this to an actual number.
=item B<< $item->version >> (read-only)
The version number for this item. Please note that these version numbers
have underscore (C<_>) as a separator for the version parts.
=item B<< $item->exists >> (read-only)
A boolean that tells if this symbol exists in code or not.
=item B<< $item->platforms >> (read-only)
A hash table reference. The keys of the hash table are the names of
the specified platforms, with a value of 0 to indicate that this symbol
isn't available on that platform, and 1 to indicate that it is. Platforms
that aren't mentioned default to 1.
=item B<< $item->type >> (read-only)
C<FUNCTION> or C<VARIABLE>, depending on what the symbol represents.
Some platforms do not care about this, others do.
=item B<< $item->features >> (read-only)
An array reference, where every item indicates a feature where this symbol
is available. If no features are mentioned, the symbol is always available.
If any feature is mentioned, this symbol is I<only> available when those
features are enabled.
=cut
our $AUTOLOAD;
# Generic getter
sub AUTOLOAD {
my $self = shift;
my $funcname = $AUTOLOAD;
(my $item = $funcname) =~ s|.*::||g;
croak "$funcname called as setter" if @_;
croak "$funcname invalid" unless exists $self->{$item};
return $self->{$item} if ref($self->{$item}) eq '';
return @{$self->{$item}} if ref($self->{$item}) eq 'ARRAY';
return %{$self->{$item}} if ref($self->{$item}) eq 'HASH';
}
=item B<< $item->intnum >> (read-write)
Internal positional number. If I<< $item->number >> is '?' or '?+', the
caller can use this to set a number for its purposes.
If I<< $item->number >> is a number, I<< $item->intnum >> should be the
same
=cut
# Getter/setters
sub intnum {
my $self = shift;
my $value = shift;
my $item = 'intnum';
croak "$item called with extra arguments" if @_;
$self->{$item} = "$value" if defined $value;
return $self->{$item};
}
sub number {
my $self = shift;
my $value = shift;
my $item = 'number';
croak "$item called with extra arguments" if @_;
$self->{$item} = "$value" if defined $value;
return $self->{$item};
}
=item B<< $item->to_string >>
Converts the item to a string that can be saved in an ordinals file.
=cut
sub to_string {
my $self = shift;
croak "Too many arguments" if @_;
my %platforms = $self->platforms();
my @features = $self->features();
my $version = $self->version();
$version =~ s|\.|_|g;
return sprintf "%-39s %s\t%s\t%s:%s:%s:%s",
$self->name(),
$self->number(),
$version,
$self->exists() ? 'EXIST' : 'NOEXIST',
join(',', (map { ($platforms{$_} ? '' : '!') . $_ }
sort keys %platforms)),
$self->type(),
join(',', @features);
}
=back
=head2 Comparators and filters
For the B<< $ordinals->items >> method, there are a few functions to create
comparators based on specific data:
=over 4
=cut
# Go back to the main package to create comparators and filters
package OpenSSL::Ordinals;
# Comparators...
=item B<by_name>
Returns a comparator that will compare the names of two OpenSSL::Ordinals::Item
objects.
=cut
sub by_name {
return sub { $_[0]->name() cmp $_[1]->name() };
}
=item B<by_number>
Returns a comparator that will compare the ordinal numbers of two
OpenSSL::Ordinals::Item objects.
=cut
sub by_number {
return sub { $_[0]->intnum() <=> $_[1]->intnum() };
}
=item B<by_version>
Returns a comparator that will compare the version of two
OpenSSL::Ordinals::Item objects.
=cut
sub by_version {
return sub {
# cmp_versions comes from OpenSSL::Util
return cmp_versions($_[0]->version(), $_[1]->version());
}
}
=back
There are also the following filters:
=over 4
=cut
# Filters... these are called by grep, the return sub must use $_ for
# the item to check
=item B<f_version VERSION>
Returns a filter that only lets through symbols with a version number
matching B<VERSION>.
=cut
sub f_version {
my $version = shift;
croak "No version specified"
unless $version && $version =~ /^\d+\.\d+\.\d+[a-z]{0,2}$/;
return sub { $_[0]->version() eq $version };
}
=item B<f_number NUMBER>
Returns a filter that only lets through symbols with the ordinal number
matching B<NUMBER>.
NOTE that this returns a "magic" value that can not be used as a function.
It's only useful when passed directly as a filter to B<items>.
=cut
sub f_number {
my $number = shift;
croak "No number specified"
unless $number && $number =~ /^\d+$/;
return [ F_NUMBER, $number ];
}
=item B<f_name NAME>
Returns a filter that only lets through symbols with the symbol name
matching B<NAME>.
NOTE that this returns a "magic" value that can not be used as a function.
It's only useful when passed directly as a filter to B<items>.
=cut
sub f_name {
my $name = shift;
croak "No name specified"
unless $name;
return [ F_NAME, $name ];
}
=back
=head1 AUTHORS
Richard Levitte E<lt>levitte@openssl.orgE<gt>.
=cut
1;