File Coverage

blib/lib/Devel/PerlySense/CallTree/Caller.pm
Criterion Covered Total %
statement 33 34 97.0
branch 7 10 70.0
condition n/a
subroutine 10 11 90.9
pod n/a
total 50 55 90.9


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Devel::PerlySense::CallTree::Caller - A method call
4              
5             =head1 DESCRIPTION
6              
7              
8             =cut
9              
10             package Devel::PerlySense::CallTree::Caller;
11             $Devel::PerlySense::CallTree::Caller::VERSION = '0.0218';
12 69     69   269 use strict;
  69         102  
  69         1723  
13 69     69   237 use warnings;
  69         105  
  69         1421  
14 69     69   250 use utf8;
  69         89  
  69         437  
15              
16              
17              
18 69     69   1179 use Moo;
  69         93  
  69         408  
19             # use Types::Standard qw(:all);
20              
21              
22             =head1 PROPERTIES
23              
24             =head2 line
25              
26             The source line describing this caller.
27              
28             =cut
29             has line => ( is => "ro" );
30              
31             has normal_line => ( is => "lazy" );
32             sub _build_normal_line {
33 58     58   470 my $self = shift;
34 58         58 my $line = $self->line;
35 58         187 $line =~ s/(\s*)#/$1 /;
36 58         261 return $line;
37             }
38              
39             has indentation => ( is => "lazy" );
40             sub _build_indentation {
41 56     56   512 my $self = shift;
42 56 50       657 $self->normal_line =~ / ^ (\s*) /x or return 0;
43 56         445 return length( $1 );
44             }
45              
46             has package => ( is => "lazy" );
47             sub _build_package {
48 19     19   359 my $self = shift;
49 19 50       217 $self->caller =~ /([\w:]+)->([\w]+)/ or return undef;
50 19         158 return $1;
51             }
52              
53             has method => ( is => "lazy" );
54             sub _build_method {
55 19     19   613 my $self = shift;
56 19 50       222 $self->caller =~ /([\w:]+)->([\w]+)/ or return undef;
57 19         182 return $2;
58             }
59              
60             has caller => (
61             is => "lazy",
62             # isa => "Str",
63             );
64             sub _build_caller {
65 58     58   469 my $self = shift;
66 58 100       644 $self->normal_line =~ /([\w:]+)->([\w]+)/ or return undef;
67 56         179 return "$1->$2";
68             }
69              
70             has id => ( is => "lazy" );
71             sub _build_id {
72 95     95   620 my $self = shift;
73 95 100       1108 my $id = $self->caller or return undef;
74 93         303 $id =~ s/::/_/g;
75 93         129 $id =~ s/->/__/g;
76 93         590 return lc( $id );
77             }
78              
79             has called_by => ( is => "lazy" );
80 0     0     sub _build_called_by { [ ] }
81              
82              
83              
84             1;
85              
86              
87              
88              
89             __END__
90              
91             =encoding utf8
92              
93             =head1 AUTHOR
94              
95             Johan Lindstrom, C<< <johanl@cpan.org> >>
96              
97             =head1 BUGS
98              
99             Please report any bugs or feature requests to
100             C<bug-devel-perlysense@rt.cpan.org>, or through the web interface at
101             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel-PerlySense>.
102             I will be notified, and then you'll automatically be notified of progress on
103             your bug as I make changes.
104              
105             =head1 ACKNOWLEDGEMENTS
106              
107             =head1 COPYRIGHT & LICENSE
108              
109             Copyright 2005 Johan Lindstrom, All Rights Reserved.
110              
111             This program is free software; you can redistribute it and/or modify it
112             under the same terms as Perl itself.
113              
114             =cut