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; |