File Coverage

blib/lib/Dancer2/Core/Role/HasLocation.pm

Criterion	Covered	Total	%
statement	32	32	100.0
branch	8	8	100.0
condition	11	11	100.0
subroutine	6	6	100.0
pod			n/a
total	57	57	100.0

package Dancer2::Core::Role::HasLocation;
# ABSTRACT: Role for application location "guessing"
$Dancer2::Core::Role::HasLocation::VERSION = '1.0.0';
use Moo::Role;
use Dancer2::Core::Types;
use Dancer2::FileUtils;
use File::Spec;
use Sub::Quote 'quote_sub';

# the path to the caller script/app
# Note: to remove any ambiguity between the accessor for the
# 'caller' attribute and the core function caller(), explicitly
# specify we want the function 'CORE::caller' as the default for
# the attribute.
has caller => (
    is      => 'ro',
    isa     => Str,
    default => quote_sub( q{
                my ( $caller, $script ) = CORE::caller;
                $script = File::Spec->abs2rel( $script ) if File::Spec->file_name_is_absolute( $script );
                $script;
        } ),
);

has location => (
    is      => 'ro',
    builder => '_build_location',
);

# FIXME: i hate you most of all -- Sawyer X
sub _build_location {
    my $self   = shift;
    my $script = $self->caller;

    # default to the dir that contains the script...
    my $location = Dancer2::FileUtils::dirname($script);

    #we try to find bin and lib
    my $subdir       = $location;
    my $subdir_found = 0;

    #maximum of 10 iterations, to prevent infinite loop
    for ( 1 .. 10 ) {

        #try to find libdir and bindir to determine the root of dancer app
        my $libdir = Dancer2::FileUtils::path( $subdir, 'lib' );
        my $bindir = Dancer2::FileUtils::path( $subdir, 'bin' );

        #try to find .dancer_app file to determine the root of dancer app
        my $dancerdir = Dancer2::FileUtils::path( $subdir, '.dancer' );

        # if one of them is found, keep that; but skip ./blib since both lib and bin exist
        # under it, but views and public do not.
        if (
            ( $subdir !~ m![\\/]blib[\\/]?$! && -d $libdir && -d $bindir ) ||
            ( -f $dancerdir )
        ) {
            $subdir_found = 1;
            last;
        }

        $subdir = Dancer2::FileUtils::path( $subdir, '..' ) || '.';
        last if File::Spec->rel2abs($subdir) eq File::Spec->rootdir;

    }

    my $path = $subdir_found ? $subdir : $location;

    # return if absolute
    File::Spec->file_name_is_absolute($path)
        and return $path;

    # convert relative to absolute
    return File::Spec->rel2abs($path);
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Dancer2::Core::Role::HasLocation - Role for application location "guessing"

=head1 VERSION

version 1.0.0

=head1 AUTHOR

Dancer Core Developers

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2023 by Alexis Sukrieh.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut