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


line stmt bran cond sub pod time code
1             package Dancer2::Core::Role::HasLocation;
2             # ABSTRACT: Role for application location "guessing"
3             $Dancer2::Core::Role::HasLocation::VERSION = '1.0.0';
4 146     146   90048 use Moo::Role;
  146         470  
  146         1042  
5 146     146   68947 use Dancer2::Core::Types;
  146         556  
  146         1144  
6 146     146   1899537 use Dancer2::FileUtils;
  146         491  
  146         6320  
7 146     146   1152 use File::Spec;
  146         479  
  146         5398  
8 146     146   1032 use Sub::Quote 'quote_sub';
  146         368  
  146         54230  
9              
10             # the path to the caller script/app
11             # Note: to remove any ambiguity between the accessor for the
12             # 'caller' attribute and the core function caller(), explicitly
13             # specify we want the function 'CORE::caller' as the default for
14             # the attribute.
15             has caller => (
16             is => 'ro',
17             isa => Str,
18             default => quote_sub( q{
19             my ( $caller, $script ) = CORE::caller;
20             $script = File::Spec->abs2rel( $script ) if File::Spec->file_name_is_absolute( $script );
21             $script;
22             } ),
23             );
24              
25             has location => (
26             is => 'ro',
27             builder => '_build_location',
28             );
29              
30             # FIXME: i hate you most of all -- Sawyer X
31             sub _build_location {
32 241     241   26644 my $self = shift;
33 241         1304 my $script = $self->caller;
34              
35             # default to the dir that contains the script...
36 241         1296 my $location = Dancer2::FileUtils::dirname($script);
37              
38             #we try to find bin and lib
39 241         1010 my $subdir = $location;
40 241         641 my $subdir_found = 0;
41              
42             #maximum of 10 iterations, to prevent infinite loop
43 241         1082 for ( 1 .. 10 ) {
44              
45             #try to find libdir and bindir to determine the root of dancer app
46 2339         8135 my $libdir = Dancer2::FileUtils::path( $subdir, 'lib' );
47 2339         5350 my $bindir = Dancer2::FileUtils::path( $subdir, 'bin' );
48              
49             #try to find .dancer_app file to determine the root of dancer app
50 2339         5559 my $dancerdir = Dancer2::FileUtils::path( $subdir, '.dancer' );
51              
52             # if one of them is found, keep that; but skip ./blib since both lib and bin exist
53             # under it, but views and public do not.
54 2339 100 100     67415 if (
      100        
      100        
55             ( $subdir !~ m![\\/]blib[\\/]?$! && -d $libdir && -d $bindir ) ||
56             ( -f $dancerdir )
57             ) {
58 8         31 $subdir_found = 1;
59 8         24 last;
60             }
61              
62 2331   100     9128 $subdir = Dancer2::FileUtils::path( $subdir, '..' ) || '.';
63 2331 100       53435 last if File::Spec->rel2abs($subdir) eq File::Spec->rootdir;
64              
65             }
66              
67 241 100       1958 my $path = $subdir_found ? $subdir : $location;
68              
69             # return if absolute
70 241 100       1602 File::Spec->file_name_is_absolute($path)
71             and return $path;
72              
73             # convert relative to absolute
74 236         9259 return File::Spec->rel2abs($path);
75             }
76              
77             1;
78              
79             __END__
80              
81             =pod
82              
83             =encoding UTF-8
84              
85             =head1 NAME
86              
87             Dancer2::Core::Role::HasLocation - Role for application location "guessing"
88              
89             =head1 VERSION
90              
91             version 1.0.0
92              
93             =head1 AUTHOR
94              
95             Dancer Core Developers
96              
97             =head1 COPYRIGHT AND LICENSE
98              
99             This software is copyright (c) 2023 by Alexis Sukrieh.
100              
101             This is free software; you can redistribute it and/or modify it under
102             the same terms as the Perl 5 programming language system itself.
103              
104             =cut