Login
Further work on changing CONSTRUCTOR POD for policies to CONFIGURATION.
[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
a7340650 16our $VERSION = 0.22;
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
47e1ff34
CD
37sub isa {
38 my $self = shift;
39 return $self->SUPER::isa(@_) || ((ref $self) && $self->{_doc} && $self->{_doc}->isa(@_));
40}
41
42#----------------------------------------------------------------------------
43
5bf96118 44sub find {
58a9e587 45 my ($self, $wanted) = @_;
5bf96118 46
58a9e587
JRT
47 # This method can only find elements by their class names. For
48 # other types of searches, delegate to the PPI::Document
5bf96118
CD
49 if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) {
50 return $self->{_doc}->find($wanted, @_);
51 }
58a9e587
JRT
52
53 # Build the class cache if it doesn't exist. This happens at most
54 # once per Perl::Critic::Document instance. %elements of will be
55 # populated as a side-effect of calling the $finder_sub coderef
56 # that is produced by the caching_finder() closure.
5bf96118 57 if ( !$self->{_elements_of} ) {
58a9e587
JRT
58 my %cache = ( 'PPI::Document' => [ $self ] );
59 my $finder_coderef = _caching_finder( \%cache );
60 $self->{_doc}->find( $finder_coderef );
61 $self->{_elements_of} = \%cache;
62 }
63
64 # find() must return false-but-defined on fail
65 return $self->{_elements_of}->{$wanted} || q{};
66}
67
68#----------------------------------------------------------------------------
69
fb21e21e
CD
70sub find_first {
71 my ($self, $wanted) = @_;
72
73 # This method can only find elements by their class names. For
74 # other types of searches, delegate to the PPI::Document
75 if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) {
76 return $self->{_doc}->find_first($wanted, @_);
77 }
78
79 my $result = $self->find($wanted);
80 return $result ? $result->[0] : $result;
81}
82
83#----------------------------------------------------------------------------
84
f5eeac3b
CD
85sub find_any {
86 my ($self, $wanted) = @_;
87
88 # This method can only find elements by their class names. For
89 # other types of searches, delegate to the PPI::Document
90 if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) {
91 return $self->{_doc}->find_any($wanted, @_);
92 }
93
94 my $result = $self->find($wanted);
95 return $result ? 1 : $result;
96}
97
98#----------------------------------------------------------------------------
99
60108aef
CD
100sub filename {
101 my ($self) = @_;
102 return $self->{_doc}->can('filename') ? $self->{_doc}->filename : undef;
103}
104
105#----------------------------------------------------------------------------
106
58a9e587
JRT
107sub _caching_finder {
108
109 my $cache_ref = shift; # These vars will persist for the life
110 my %isa_cache = (); # of the code ref that this sub returns
111
112
113 # Gather up all the PPI elements and sort by @ISA. Note: if any
114 # instances used multiple inheritance, this implementation would
115 # lead to multiple copies of $element in the $elements_of lists.
116 # However, PPI::* doesn't do multiple inheritance, so we are safe
117
118 return sub {
119 my $element = $_[1];
120 my $classes = $isa_cache{ref $element};
121 if ( !$classes ) {
122 $classes = [ ref $element ];
123 # Use a C-style loop because we append to the classes array inside
124 for ( my $i = 0; $i < @{$classes}; $i++ ) { ## no critic(ProhibitCStyleForLoops)
125 no strict 'refs'; ## no critic(ProhibitNoStrict)
126 push @{$classes}, @{"$classes->[$i]::ISA"};
127 $cache_ref->{$classes->[$i]} ||= [];
5bf96118 128 }
58a9e587
JRT
129 $isa_cache{$classes->[0]} = $classes;
130 }
5bf96118 131
58a9e587
JRT
132 for my $class ( @{$classes} ) {
133 push @{$cache_ref->{$class}}, $element;
134 }
5bf96118 135
58a9e587
JRT
136 return 0; # 0 tells find() to keep traversing, but not to store this $element
137 };
5bf96118
CD
138}
139
58a9e587
JRT
140#----------------------------------------------------------------------------
141
5bf96118 1421;
58a9e587 143
5bf96118
CD
144__END__
145
a73f4a71
JRT
146=pod
147
148=for stopwords pre-caches
149
5bf96118
CD
150=head1 NAME
151
152Perl::Critic::Document - Caching wrapper around PPI::Document
153
154=head1 SYNOPSIS
155
156 use PPI::Document;
157 use Perl::Critic::Document;
158 my $doc = PPI::Document->new('Foo.pm');
159 $doc = Perl::Critic::Document->new($doc);
160 ## Then use the instance just like a PPI::Document
161
162=head1 DESCRIPTION
163
164Perl::Critic does a lot of iterations over the PPI document tree via
165the C<PPI::Document::find()> method. To save some time, this class
166pre-caches a lot of the common C<find()> calls in a single traversal.
167Then, on subsequent requests we return the cached data.
168
169This is implemented as a facade, where method calls are handed to the
170stored C<PPI::Document> instance.
171
172=head1 CAVEATS
173
174This facade does not implement the overloaded operators from
175L<PPI::Document> (that is, the C<use overload ...> work). Therefore,
176users of this facade must not rely on that syntactic sugar. So, for
177example, instead of C<my $source = "$doc";> you should write C<my
178$source = $doc->content();>
179
180Perhaps there is a CPAN module out there which implements a facade
181better than we do here?
182
183=head1 METHODS
184
185=over
186
7076e807
CD
187=item $pkg->new($doc)
188
189Create a new instance referencing a PPI::Document instance.
190
5bf96118
CD
191=item $self->find($wanted)
192
fb21e21e
CD
193=item $self->find_first($wanted)
194
f5eeac3b
CD
195=item $self->find_any($wanted)
196
fb21e21e 197If C<$wanted> is a simple PPI class name, then the cache is employed.
f5eeac3b
CD
198Otherwise we forward the call to the corresponding method of the
199C<PPI::Document> instance.
5bf96118 200
e7f2d995
CD
201=item $self->filename()
202
203Returns the filename for the source code if applicable
204(PPI::Document::File) or C<undef> otherwise (PPI::Document).
205
5bf96118
CD
206=back
207
208=head1 AUTHOR
209
210Chris Dolan <cdolan@cpan.org>
211
212=head1 COPYRIGHT
213
214Copyright (c) 2006 Chris Dolan. All rights reserved.
215
216This program is free software; you can redistribute it and/or modify
217it under the same terms as Perl itself. The full text of this license
218can be found in the LICENSE file included with this module.
219
220=cut
737d3b65
CD
221
222# Local Variables:
223# mode: cperl
224# cperl-indent-level: 4
225# fill-column: 78
226# indent-tabs-mode: nil
227# c-indentation-style: bsd
228# End:
dbb78cdc 229# ex: set ts=8 sts=4 sw=4 expandtab :