File Coverage

blib/lib/MVC/Neaf/Util/Base.pm
Criterion Covered Total %
statement 32 34 94.1
branch 6 8 75.0
condition 2 3 66.6
subroutine 9 9 100.0
pod 4 4 100.0
total 53 58 91.3


line stmt bran cond sub pod time code
1             package MVC::Neaf::Util::Base;
2              
3 110     110   50453 use strict;
  110         224  
  110         3134  
4 110     110   591 use warnings;
  110         215  
  110         4893  
5             our $VERSION = '0.2901';
6              
7             =head1 NAME
8              
9             MVC::Neaf::Util::Base - base class for other Not Even A Framework classes.
10              
11             =head1 DESCRIPTION
12              
13             This is an internal package providing some utility methods for Neaf itself.
14              
15             See L for public interface.
16              
17             =head1 METHODS
18              
19             =cut
20              
21 110     110   722 use Carp;
  110         246  
  110         5910  
22 110     110   726 use File::Spec;
  110         289  
  110         47352  
23              
24             =head2 new( %options )
25              
26             Will happily accept any args and pack them into self.
27              
28             =cut
29              
30             sub new {
31 192     192 1 2041 my ($class, %opt) = @_;
32              
33 192         1541 return bless \%opt, $class;
34             };
35              
36             # NOTE My bad! The first method in this package was prefixed with my_
37             # Please prefix new methods with neaf_ instead, if possible.
38              
39             =head2 my_croak( $message )
40              
41             Like croak() from Carp, but the message is prefixed
42             with self's package and the name of method
43             in which error occurred.
44              
45             =cut
46              
47             sub my_croak {
48 30     30 1 96 my ($self, $msg) = @_;
49              
50 30         106 my $sub = [caller(1)]->[3];
51 30         1385 $sub =~ s/.*:://;
52              
53 30   66     1047 croak join "", (ref $self || $self),"->",$sub,": ",$msg;
54             };
55              
56             =head2 dir ($path || [$path, ...])
57              
58             For every given path, return $path if it starts with a '/',
59             or canonized concatenation of $self->neaf_base_dir and $path
60             otherwise.
61              
62             Dies if C is not set.
63              
64             B Please use this method whenever your Neaf extension/plugin
65             is given a path, do not rely on '.' to be set correctly!
66              
67             =cut
68              
69             sub dir {
70 24     24 1 77 my $self = shift;
71              
72             # Cannot use Carp as it will likely point to the wrong location
73             # TODO Only calculate this when needed
74 24         179 my @stack = caller(1);
75              
76             # cache root so we only calculate it once
77 24         354 my $root;
78              
79             # recursive handler sub that maps arrayrefs through itself
80             my $handler;
81             $handler = sub {
82 26 100   26   174 return [map { $handler->() } @$_] if ref $_ eq 'ARRAY';
  2         7  
83 11 100       147 return File::Spec->canonpath($_)
84             if File::Spec->file_name_is_absolute($_);
85 6 50       26 if (!defined $root) {
86 6         38 $root = $self->neaf_base_dir;
87 6 50       29 unless (defined $root) {
88 0         0 warn ((ref $self)."->path(...) was called, but neaf_base_dir was never set at $stack[1] line $stack[2].\n");
89 0         0 $root = '.';
90             };
91             };
92 6         68 return File::Spec->canonpath("$root/$_");
93 24         167 };
94              
95 24         69 local $_ = shift;
96 24         68 return $handler->();
97             };
98              
99             =head2 neaf_base_dir()
100              
101             Dumb accessor that returns C<$self-E{neaf_base_dir}>.
102              
103             Used by C (see above).
104              
105             =cut
106              
107             # Dumb accessor
108             sub neaf_base_dir {
109 4     4 1 23 return $_[0]->{neaf_base_dir};
110             }
111              
112             =head1 LICENSE AND COPYRIGHT
113              
114             This module is part of L suite.
115              
116             Copyright 2016-2023 Konstantin S. Uvarin C.
117              
118             This program is free software; you can redistribute it and/or modify it
119             under the terms of either: the GNU General Public License as published
120             by the Free Software Foundation; or the Artistic License.
121              
122             See L for more information.
123              
124             =cut
125              
126             1;