Login
Minor code cleanup; document use of string eval
[gknop/Perl-Critic.git] / lib / Perl / Critic / Document.pm
CommitLineData
58a9e587 1########################################################################
a73f4a71
JRT
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
5bf96118
CD
6########################################################################
7
8package Perl::Critic::Document;
9
5bf96118 10use strict;
58a9e587 11use warnings;
5bf96118
CD
12use PPI::Document;
13
58a9e587
JRT
14#----------------------------------------------------------------------------
15
14e65e8f 16our $VERSION = 0.20;
5bf96118
CD
17
18#----------------------------------------------------------------------------
19
20our $AUTOLOAD;
21sub AUTOLOAD { ## no critic(ProhibitAutoloading)
22 my ( $function_name ) = $AUTOLOAD =~ m/ ([^:\']+) \z /xms;
23 return if $function_name eq 'DESTROY';
24 my $self = shift;
25 return $self->{_doc}->$function_name(@_);
26}
27
58a9e587 28#----------------------------------------------------------------------------
5bf96118 29
58a9e587
JRT
30sub new {
31 my ($class, $doc) = @_;
5bf96118
CD
32 return bless { _doc => $doc }, $class;
33}
34
58a9e587
JRT
35#----------------------------------------------------------------------------
36
5bf96118 37sub find {
58a9e587 38 my ($self, $wanted) = @_;
5bf96118 39
58a9e587
JRT
40 # This method can only find elements by their class names. For
41 # other types of searches, delegate to the PPI::Document
5bf96118
CD
42 if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) {
43 return $self->{_doc}->find($wanted, @_);
44 }
58a9e587
JRT
45
46 # Build the class cache if it doesn't exist. This happens at most
47 # once per Perl::Critic::Document instance. %elements of will be
48 # populated as a side-effect of calling the $finder_sub coderef
49 # that is produced by the caching_finder() closure.
5bf96118 50 if ( !$self->{_elements_of} ) {
58a9e587
JRT
51 my %cache = ( 'PPI::Document' => [ $self ] );
52 my $finder_coderef = _caching_finder( \%cache );
53 $self->{_doc}->find( $finder_coderef );
54 $self->{_elements_of} = \%cache;
55 }
56
57 # find() must return false-but-defined on fail
58 return $self->{_elements_of}->{$wanted} || q{};
59}
60
61#----------------------------------------------------------------------------
62
fb21e21e
CD
63sub find_first {
64 my ($self, $wanted) = @_;
65
66 # This method can only find elements by their class names. For
67 # other types of searches, delegate to the PPI::Document
68 if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) {
69 return $self->{_doc}->find_first($wanted, @_);
70 }
71
72 my $result = $self->find($wanted);
73 return $result ? $result->[0] : $result;
74}
75
76#----------------------------------------------------------------------------
77
f5eeac3b
CD
78sub find_any {
79 my ($self, $wanted) = @_;
80
81 # This method can only find elements by their class names. For
82 # other types of searches, delegate to the PPI::Document
83 if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) {
84 return $self->{_doc}->find_any($wanted, @_);
85 }
86
87 my $result = $self->find($wanted);
88 return $result ? 1 : $result;
89}
90
91#----------------------------------------------------------------------------
92
58a9e587
JRT
93sub _caching_finder {
94
95 my $cache_ref = shift; # These vars will persist for the life
96 my %isa_cache = (); # of the code ref that this sub returns
97
98
99 # Gather up all the PPI elements and sort by @ISA. Note: if any
100 # instances used multiple inheritance, this implementation would
101 # lead to multiple copies of $element in the $elements_of lists.
102 # However, PPI::* doesn't do multiple inheritance, so we are safe
103
104 return sub {
105 my $element = $_[1];
106 my $classes = $isa_cache{ref $element};
107 if ( !$classes ) {
108 $classes = [ ref $element ];
109 # Use a C-style loop because we append to the classes array inside
110 for ( my $i = 0; $i < @{$classes}; $i++ ) { ## no critic(ProhibitCStyleForLoops)
111 no strict 'refs'; ## no critic(ProhibitNoStrict)
112 push @{$classes}, @{"$classes->[$i]::ISA"};
113 $cache_ref->{$classes->[$i]} ||= [];
5bf96118 114 }
58a9e587
JRT
115 $isa_cache{$classes->[0]} = $classes;
116 }
5bf96118 117
58a9e587
JRT
118 for my $class ( @{$classes} ) {
119 push @{$cache_ref->{$class}}, $element;
120 }
5bf96118 121
58a9e587
JRT
122 return 0; # 0 tells find() to keep traversing, but not to store this $element
123 };
5bf96118
CD
124}
125
58a9e587
JRT
126#----------------------------------------------------------------------------
127
5bf96118 1281;
58a9e587 129
5bf96118
CD
130__END__
131
a73f4a71
JRT
132=pod
133
134=for stopwords pre-caches
135
5bf96118
CD
136=head1 NAME
137
138Perl::Critic::Document - Caching wrapper around PPI::Document
139
140=head1 SYNOPSIS
141
142 use PPI::Document;
143 use Perl::Critic::Document;
144 my $doc = PPI::Document->new('Foo.pm');
145 $doc = Perl::Critic::Document->new($doc);
146 ## Then use the instance just like a PPI::Document
147
148=head1 DESCRIPTION
149
150Perl::Critic does a lot of iterations over the PPI document tree via
151the C<PPI::Document::find()> method. To save some time, this class
152pre-caches a lot of the common C<find()> calls in a single traversal.
153Then, on subsequent requests we return the cached data.
154
155This is implemented as a facade, where method calls are handed to the
156stored C<PPI::Document> instance.
157
158=head1 CAVEATS
159
160This facade does not implement the overloaded operators from
161L<PPI::Document> (that is, the C<use overload ...> work). Therefore,
162users of this facade must not rely on that syntactic sugar. So, for
163example, instead of C<my $source = "$doc";> you should write C<my
164$source = $doc->content();>
165
166Perhaps there is a CPAN module out there which implements a facade
167better than we do here?
168
169=head1 METHODS
170
171=over
172
7076e807
CD
173=item $pkg->new($doc)
174
175Create a new instance referencing a PPI::Document instance.
176
5bf96118
CD
177=item $self->find($wanted)
178
fb21e21e
CD
179=item $self->find_first($wanted)
180
f5eeac3b
CD
181=item $self->find_any($wanted)
182
fb21e21e 183If C<$wanted> is a simple PPI class name, then the cache is employed.
f5eeac3b
CD
184Otherwise we forward the call to the corresponding method of the
185C<PPI::Document> instance.
5bf96118
CD
186
187=back
188
189=head1 AUTHOR
190
191Chris Dolan <cdolan@cpan.org>
192
193=head1 COPYRIGHT
194
195Copyright (c) 2006 Chris Dolan. All rights reserved.
196
197This program is free software; you can redistribute it and/or modify
198it under the same terms as Perl itself. The full text of this license
199can be found in the LICENSE file included with this module.
200
201=cut