File Coverage

blib/lib/Beam/Runner/Util.pm

Criterion	Covered	Total	%
statement	39	39	100.0
branch	10	12	83.3
condition	3	5	60.0
subroutine	6	6	100.0
pod	2	2	100.0
total	60	64	93.7

package Beam::Runner::Util;
our $VERSION = '0.016';
# ABSTRACT: Utilities for Beam::Runner command classes

#pod =head1 SYNOPSIS
#pod
#pod     use Beam::Runner::Util qw( find_container_path );
#pod
#pod     my $path = find_container_path( $container_name );
#pod
#pod =head1 DESCRIPTION
#pod
#pod This module has some shared utility functions for creating
#pod L classes.
#pod
#pod =head1 SEE ALSO
#pod
#pod L, L, L
#pod
#pod =cut

use strict;
use warnings;
use Exporter 'import';
use Path::Tiny qw( path );

our @EXPORT_OK = qw( find_container_path find_containers );

# File extensions to try to find, starting with no extension (which is
# to say the extension is given by the user's input)
our @EXTS = ( "", qw( .yml .yaml .json .xml .pl ) );
# A regex to use to remove the container's name
my $EXT_RE = qr/(?:@{[ join '|', @EXTS ]})$/;

# The "BEAM_PATH" separator value. Windows uses ';' to separate
# PATH-like variables, everything else uses ':'
our $PATHS_SEP = $^O eq 'MSWin32' ? ';' : ':';

#pod =sub find_containers
#pod
#pod     my %container = find_containers();
#pod
#pod Returns a list of C and C pairs pointing to all the containers
#pod in the C paths.
#pod
#pod =cut

sub find_containers {
    my %containers;
    for my $dir ( split /$PATHS_SEP/, $ENV{BEAM_PATH} // '' ) {
        my $p = path( $dir );
        my $i = $p->iterator( { recurse => 1, follow_symlinks => 1 } );
        while ( my $file = $i->() ) {
            next unless $file->is_file;
            next unless $file =~ $EXT_RE;
            my $name = $file->relative( $p );
            $name =~ s/$EXT_RE//;
            $containers{ $name } ||= $file;
        }
    }
    return %containers;
}

#pod =sub find_container_path
#pod
#pod     my $path = find_container_path( $container_name );
#pod
#pod Find the path to the given container. If the given container is already
#pod an absolute path, it is simply returned. Otherwise, the container is
#pod searched for in the directories defined by the C environment
#pod variable.
#pod
#pod If the container cannot be found, throws an exception with a user-friendly
#pod error message.
#pod
#pod =cut

sub find_container_path {
    my ( $container ) = @_;
    my $path;
    if ( path( $container )->is_file ) {
        return path( $container );
    }

    my @dirs = ( "." );
    if ( $ENV{BEAM_PATH} ) {
        push @dirs, split /$PATHS_SEP/, $ENV{BEAM_PATH};
    }

    DIR: for my $dir ( @dirs ) {
        my $d = path( $dir );
        for my $ext ( @EXTS ) {
            my $f = $d->child( $container . $ext );
            if ( $f->exists ) {
                $path = $f;
                last DIR;
            }
        }
    }

    die sprintf qq{Could not find container "%s" in directories: %s\n},
        $container, join( $PATHS_SEP, @dirs )
        unless $path;

    return $path;
}

1;

__END__