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