#! /usr/bin/env perl
# Copyright 2021-2024 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

# All variables are supposed to come from Makefile, in environment variable
# form, or passed as variable assignments on the command line.
# The result is a Perl module creating the package OpenSSL::safe::installdata.

use 5.10.0;
use strict;
use warnings;
use Carp;

use File::Spec;
#use List::Util qw(pairs);
sub _pairs (@);

# These are expected to be set up as absolute directories
my @absolutes = qw(PREFIX libdir);
# These may be absolute directories, and if not, they are expected to be set up
# as subdirectories to PREFIX or LIBDIR.  The order of the pairs is important,
# since the LIBDIR subdirectories depend on the calculation of LIBDIR from
# PREFIX.
my @subdirs = _pairs (PREFIX => [ qw(BINDIR LIBDIR INCLUDEDIR APPLINKDIR) ],
                      LIBDIR => [ qw(ENGINESDIR MODULESDIR PKGCONFIGDIR
                                     CMAKECONFIGDIR) ]);
# For completeness, other expected variables
my @others = qw(VERSION LDLIBS);

my %all = ( );
foreach (@absolutes) { $all{$_} = 1 }
foreach (@subdirs) { foreach (@{$_->[1]}) { $all{$_} = 1 } }
foreach (@others) { $all{$_} = 1 }
print STDERR "DEBUG: all keys: ", join(", ", sort keys %all), "\n";

my %keys = ();
my %values = ();
foreach (@ARGV) {
    (my $k, my $v) = m|^([^=]*)=(.*)$|;
    $keys{$k} = 1;
    push @{$values{$k}}, $v;
}

# warn if there are missing values, and also if there are unexpected values
foreach my $k (sort keys %all) {
    warn "No value given for $k\n" unless $keys{$k};
}
foreach my $k (sort keys %keys) {
    warn "Unknown variable $k\n" unless $all{$k};
}

# This shouldn't be needed, but just in case we get relative paths that
# should be absolute, make sure they actually are.
foreach my $k (@absolutes) {
    my $v = $values{$k} || [ '.' ];
    die "Can't have more than one $k\n" if scalar @$v > 1;
    print STDERR "DEBUG: $k = $v->[0] => ";
    $v = [ map { File::Spec->rel2abs($_) } @$v ];
    $values{$k} = $v;
    print STDERR "$k = $v->[0]\n";
}

# Absolute paths for the subdir variables are computed.  This provides
# the usual form of values for names that have become norm, known as GNU
# installation paths.
# For the benefit of those that need it, the subdirectories are preserved
# as they are, using the same variable names, suffixed with '_REL_{var}',
# if they are indeed subdirectories.  The '{var}' part of the name tells
# which other variable value they are relative to.
foreach my $pair (@subdirs) {
    my ($var, $subdir_vars) = @$pair;
    foreach my $k (@$subdir_vars) {
        my $kr = "${k}_REL_${var}";
        my $v2 = $values{$k} || [ '.' ];
        $values{$k} = [];       # We're rebuilding it
        print STDERR "DEBUG: $k = ",
            (scalar @$v2 > 1 ? "[ " . join(", ", @$v2) . " ]" : $v2->[0]),
            " => ";
        foreach my $v (@$v2) {
            if (File::Spec->file_name_is_absolute($v)) {
                push @{$values{$k}}, $v;
                push @{$values{$kr}},
                    File::Spec->abs2rel($v, $values{$var}->[0]);
            } else {
                push @{$values{$kr}}, $v;
                push @{$values{$k}},
                    File::Spec->rel2abs($v, $values{$var}->[0]);
            }
        }
        print STDERR join(", ",
                          map {
                              my $v = $values{$_};
                              "$_ = " . (scalar @$v > 1
                                         ? "[ " . join(", ", @$v) . " ]"
                                         : $v->[0]);
                          } ($k, $kr)),
            "\n";
    }
}

print <<_____;
package OpenSSL::safe::installdata;

use strict;
use warnings;
use Exporter;
our \@ISA = qw(Exporter);
our \@EXPORT = qw(
_____

foreach my $k (@absolutes) {
    print "    \@$k\n";
}
foreach my $pair (@subdirs) {
    my ($var, $subdir_vars) = @$pair;
    foreach my $k (@$subdir_vars) {
        my $k2 = "${k}_REL_${var}";
        print "    \@$k \@$k2\n";
    }
}

print <<_____;
    \$VERSION \@LDLIBS
);

_____

foreach my $k (@absolutes) {
    print "our \@$k" . ' ' x (27 - length($k)) . "= ( '",
        join("', '", @{$values{$k}}),
        "' );\n";
}
foreach my $pair (@subdirs) {
    my ($var, $subdir_vars) = @$pair;
    foreach my $k (@$subdir_vars) {
        my $k2 = "${k}_REL_${var}";
        print "our \@$k" . ' ' x (27 - length($k)) . "= ( '",
            join("', '", @{$values{$k}}),
            "' );\n";
        print "our \@$k2" . ' ' x (27 - length($k2)) . "= ( '",
            join("', '", @{$values{$k2}}),
            "' );\n";
    }
}

print <<_____;
our \$VERSION                    = '$values{VERSION}->[0]';
our \@LDLIBS                     =
    # Unix and Windows use space separation, VMS uses comma separation
    \$^O eq 'VMS'
    ? split(/ *, */, '$values{LDLIBS}->[0]')
    : split(/ +/, '$values{LDLIBS}->[0]');

1;
_____

######## Helpers

# _pairs LIST
#
# This operates on an even-sized list, and returns a list of "ARRAY"
# references, each containing two items from the given LIST.
#
# It is a quick cheap reimplementation of List::Util::pairs(), a function
# we cannot use, because it only appeared in perl v5.19.3, and we claim to
# support perl versions all the way back to v5.10.

sub _pairs (@) {
    croak "Odd number of arguments" if @_ & 1;

    my @pairlist = ();

    while (@_) {
        my $x = [ shift, shift ];
        push @pairlist, $x;
    }
    return @pairlist;
}