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