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   50396 use strict;
  110         257  
  110         3163  
4 110     110   562 use warnings;
  110         216  
  110         4480  
5             our $VERSION = '0.29';
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   761 use Carp;
  110         244  
  110         5985  
22 110     110   818 use File::Spec;
  110         258  
  110         47812  
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 1910 my ($class, %opt) = @_;
32              
33 192         1416 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         1408 $sub =~ s/.*:://;
52              
53 30   66     1190 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 74 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         171 my @stack = caller(1);
75              
76             # cache root so we only calculate it once
77 24         372 my $root;
78              
79             # recursive handler sub that maps arrayrefs through itself
80             my $handler;
81             $handler = sub {
82 26 100   26   182 return [map { $handler->() } @$_] if ref $_ eq 'ARRAY';
  2         6  
83 11 100       76 return $_ if $_ =~ /^\//;
84 6 50       20 if (!defined $root) {
85 6         45 $root = $self->neaf_base_dir;
86 6 50       31 unless (defined $root) {
87 0         0 warn ((ref $self)."->path(...) was called, but neaf_base_dir was never set at $stack[1] line $stack[2].\n");
88 0         0 $root = '.';
89             };
90             };
91 6         85 return File::Spec->canonpath("$root/$_");
92 24         169 };
93              
94 24         63 local $_ = shift;
95 24         71 return $handler->();
96             };
97              
98             =head2 neaf_base_dir()
99              
100             Dumb accessor that returns C<$self-E{neaf_base_dir}>.
101              
102             Used by C (see above).
103              
104             =cut
105              
106             # Dumb accessor
107             sub neaf_base_dir {
108 4     4 1 27 return $_[0]->{neaf_base_dir};
109             }
110              
111             =head1 LICENSE AND COPYRIGHT
112              
113             This module is part of L suite.
114              
115             Copyright 2016-2023 Konstantin S. Uvarin C.
116              
117             This program is free software; you can redistribute it and/or modify it
118             under the terms of either: the GNU General Public License as published
119             by the Free Software Foundation; or the Artistic License.
120              
121             See L for more information.
122              
123             =cut
124              
125             1;