xref: /netbsd-src/crypto/external/bsd/openssl/dist/util/perl/OpenSSL/fallback.pm (revision b0d1725196a7921d003d2c66a14f186abda4176b)
1*b0d17251Schristos# Copyright 2019-2021 The OpenSSL Project Authors. All Rights Reserved.
2*b0d17251Schristos#
3*b0d17251Schristos# Licensed under the Apache License 2.0 (the "License").  You may not use
4*b0d17251Schristos# this file except in compliance with the License.  You can obtain a copy
5*b0d17251Schristos# in the file LICENSE in the source distribution or at
6*b0d17251Schristos# https://www.openssl.org/source/license.html
7*b0d17251Schristos
8*b0d17251Schristos=head1 NAME
9*b0d17251Schristos
10*b0d17251SchristosOpenSSL::fallback - push directories to the end of @INC at compile time
11*b0d17251Schristos
12*b0d17251Schristos=cut
13*b0d17251Schristos
14*b0d17251Schristospackage OpenSSL::fallback;
15*b0d17251Schristos
16*b0d17251Schristosuse strict;
17*b0d17251Schristosuse warnings;
18*b0d17251Schristosuse Carp;
19*b0d17251Schristos
20*b0d17251Schristosour $VERSION = '0.01';
21*b0d17251Schristos
22*b0d17251Schristos=head1 SYNOPSIS
23*b0d17251Schristos
24*b0d17251Schristos    use OpenSSL::fallback LIST;
25*b0d17251Schristos
26*b0d17251Schristos=head1 DESCRIPTION
27*b0d17251Schristos
28*b0d17251SchristosThis small simple module simplifies the addition of fallback directories
29*b0d17251Schristosin @INC at compile time.
30*b0d17251Schristos
31*b0d17251SchristosIt is used to add extra directories at the end of perl's search path so
32*b0d17251Schristosthat later "use" or "require" statements will find modules which are not
33*b0d17251Schristoslocated on perl's default search path.
34*b0d17251Schristos
35*b0d17251SchristosThis is similar to L<lib>, except the paths are I<appended> to @INC rather
36*b0d17251Schristosthan prepended, thus allowing the use of a newer module on perl's default
37*b0d17251Schristossearch path if there is one.
38*b0d17251Schristos
39*b0d17251Schristos=head1 CAVEAT
40*b0d17251Schristos
41*b0d17251SchristosJust like with B<lib>, this only works with Unix filepaths.
42*b0d17251SchristosJust like with L<lib>, this doesn't mean that it only works on Unix, but that
43*b0d17251Schristosnon-Unix users must first translate their file paths to Unix conventions.
44*b0d17251Schristos
45*b0d17251Schristos    # VMS users wanting to put [.my.stuff] into their @INC should write:
46*b0d17251Schristos    use fallback 'my/stuff';
47*b0d17251Schristos
48*b0d17251Schristos=head1 NOTES
49*b0d17251Schristos
50*b0d17251SchristosIf you try to add a file to @INC as follows, you will be warned, and the file
51*b0d17251Schristoswill be ignored:
52*b0d17251Schristos
53*b0d17251Schristos    use fallback 'file.txt';
54*b0d17251Schristos
55*b0d17251SchristosThe sole exception is the file F<MODULES.txt>, which must contain a list of
56*b0d17251Schristossub-directories relative to the location of that F<MODULES.txt> file.
57*b0d17251SchristosAll these sub-directories will be appended to @INC.
58*b0d17251Schristos
59*b0d17251Schristos=cut
60*b0d17251Schristos
61*b0d17251Schristos# Forward declare
62*b0d17251Schristossub glob;
63*b0d17251Schristos
64*b0d17251Schristosuse constant DEBUG => 0;
65*b0d17251Schristos
66*b0d17251Schristossub import {
67*b0d17251Schristos    shift;                      # Skip module name
68*b0d17251Schristos
69*b0d17251Schristos    foreach (@_) {
70*b0d17251Schristos        my $path = $_;
71*b0d17251Schristos
72*b0d17251Schristos        if ($path eq '') {
73*b0d17251Schristos            carp "Empty compile time value given to use fallback";
74*b0d17251Schristos            next;
75*b0d17251Schristos        }
76*b0d17251Schristos
77*b0d17251Schristos        print STDERR "DEBUG: $path\n" if DEBUG;
78*b0d17251Schristos
79*b0d17251Schristos        unless (-e $path
80*b0d17251Schristos                && ($path =~ m/(?:^|\/)MODULES.txt/ || -d $path)) {
81*b0d17251Schristos            croak "Parameter to use fallback must be a directory, not a file";
82*b0d17251Schristos            next;
83*b0d17251Schristos        }
84*b0d17251Schristos
85*b0d17251Schristos        my @dirs = ();
86*b0d17251Schristos        if (-f $path) {         # It's a MODULES.txt file
87*b0d17251Schristos            (my $dir = $path) =~ s|/[^/]*$||; # quick dirname
88*b0d17251Schristos            open my $fh, $path or die "Could not open $path: $!\n";
89*b0d17251Schristos            while (my $l = <$fh>) {
90*b0d17251Schristos                $l =~ s|\R$||;        # Better chomp
91*b0d17251Schristos                my $d = "$dir/$l";
92*b0d17251Schristos                my $checked = $d;
93*b0d17251Schristos
94*b0d17251Schristos                if ($^O eq 'VMS') {
95*b0d17251Schristos                    # Some VMS unpackers replace periods with underscores
96*b0d17251Schristos                    # We must be real careful not to convert the directories
97*b0d17251Schristos                    # '.' and '..', though.
98*b0d17251Schristos                    $checked =
99*b0d17251Schristos                        join('/',
100*b0d17251Schristos                             map { my $x = $_;
101*b0d17251Schristos                                   $x =~ s|\.|_|g
102*b0d17251Schristos                                       if ($x ne '..' && $x ne '.');
103*b0d17251Schristos                                   $x }
104*b0d17251Schristos                             split(m|/|, $checked))
105*b0d17251Schristos                        unless -e $checked && -d $checked;
106*b0d17251Schristos                }
107*b0d17251Schristos                croak "All lines in $path must be a directory, not a file: $l"
108*b0d17251Schristos                    unless -e $checked && -d $checked;
109*b0d17251Schristos                push @INC, $checked;
110*b0d17251Schristos            }
111*b0d17251Schristos        } else {                # It's a directory
112*b0d17251Schristos            push @INC, $path;
113*b0d17251Schristos        }
114*b0d17251Schristos    }
115*b0d17251Schristos}
116*b0d17251Schristos
117*b0d17251Schristos=head1 SEE ALSO
118*b0d17251Schristos
119*b0d17251SchristosL<FindBin> - optional module which deals with paths relative to the source
120*b0d17251Schristosfile.
121*b0d17251Schristos
122*b0d17251Schristos=head1 AUTHOR
123*b0d17251Schristos
124*b0d17251SchristosRichard Levitte, 2019
125*b0d17251Schristos
126*b0d17251Schristos=cut
127*b0d17251Schristos
128