Home | History | Annotate | Line # | Download | only in OpenSSL
fallback.pm revision 1.1 
      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 
     10 OpenSSL::fallback - push directories to the end of @INC at compile time
     11 
     12 =cut
     13 
     14 package OpenSSL::fallback;
     15 
     16 use strict;
     17 use warnings;
     18 use Carp;
     19 
     20 our $VERSION = '0.01';
     21 
     22 =head1 SYNOPSIS
     23 
     24     use OpenSSL::fallback LIST;
     25 
     26 =head1 DESCRIPTION
     27 
     28 This small simple module simplifies the addition of fallback directories
     29 in @INC at compile time.
     30 
     31 It is used to add extra directories at the end of perl's search path so
     32 that later "use" or "require" statements will find modules which are not
     33 located on perl's default search path.
     34 
     35 This is similar to L<lib>, except the paths are I<appended> to @INC rather
     36 than prepended, thus allowing the use of a newer module on perl's default
     37 search path if there is one.
     38 
     39 =head1 CAVEAT
     40 
     41 Just like with B<lib>, this only works with Unix filepaths.
     42 Just like with L<lib>, this doesn't mean that it only works on Unix, but that
     43 non-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 
     50 If you try to add a file to @INC as follows, you will be warned, and the file
     51 will be ignored:
     52 
     53     use fallback 'file.txt';
     54 
     55 The sole exception is the file F<MODULES.txt>, which must contain a list of
     56 sub-directories relative to the location of that F<MODULES.txt> file.
     57 All these sub-directories will be appended to @INC.
     58 
     59 =cut
     60 
     61 # Forward declare
     62 sub glob;
     63 
     64 use constant DEBUG => 0;
     65 
     66 sub 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 
    119 L<FindBin> - optional module which deals with paths relative to the source
    120 file.
    121 
    122 =head1 AUTHOR
    123 
    124 Richard Levitte, 2019
    125 
    126 =cut
    127 
    128