/usr/share/perl5/Pod/Elemental/PerlMunger.pm is in libpod-elemental-perlmunger-perl 0.200003-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 | package Pod::Elemental::PerlMunger;
# ABSTRACT: a thing that takes a string of Perl and rewrites its documentation
$Pod::Elemental::PerlMunger::VERSION = '0.200003';
use Moose::Role;
#pod =head1 OVERVIEW
#pod
#pod This role is to be included in classes that rewrite the documentation of a Perl
#pod document, stripping out all the Pod, munging it, and replacing it into the
#pod Perl.
#pod
#pod The only relevant method is C<munge_perl_string>, which must be implemented
#pod with a different interface than will be exposed.
#pod
#pod When calling the C<munge_perl_string> method, arguments should be passed like
#pod this:
#pod
#pod $object->munge_perl_string($perl_string, \%arg);
#pod
#pod C<$perl_string> should be a character string containing Perl source code.
#pod
#pod C<%arg> may contain any input for the underlying procedure. The only key with
#pod associated meaning is C<filename> which may be omitted. If given, it should be
#pod the name of the file whose contents are being munged.
#pod
#pod The method will return a character string containing the rewritten and combined
#pod document.
#pod
#pod Classes including this role must implement a C<munge_perl_string> that expects
#pod to be called like this:
#pod
#pod $object->munge_perl_string(\%doc, \%arg);
#pod
#pod C<%doc> will have two entries:
#pod
#pod ppi - a PPI::Document of the Perl document with all its Pod removed
#pod pod - a Pod::Elemental::Document with no transformations yet performed
#pod
#pod This C<munge_perl_string> method should return a hashref in the same format as
#pod C<%doc>.
#pod
#pod =cut
use namespace::autoclean;
use Encode ();
use List::Util 1.33 qw(any max);
use Params::Util qw(_INSTANCE);
use PPI;
requires 'munge_perl_string';
around munge_perl_string => sub {
my ($orig, $self, $perl, $arg) = @_;
my $perl_utf8 = Encode::encode('utf-8', $perl, Encode::FB_CROAK);
my $ppi_document = PPI::Document->new(\$perl_utf8);
confess(PPI::Document->errstr) unless $ppi_document;
my $last_code_elem;
my $code_elems = $ppi_document->find(sub {
return if grep { $_[1]->isa("PPI::Token::$_") }
qw(Comment Pod Whitespace Separator Data End);
return 1;
});
$code_elems ||= [];
for my $elem (@$code_elems) {
# Really, we might get two elements on the same line, and one could be
# later in position because it could have a later column — but we don't
# care, because we're only thinking about Pod, which is linewise.
next if $last_code_elem
and $elem->line_number <= $last_code_elem->line_number;
$last_code_elem = $elem;
}
my @pod_tokens;
{
my @queue = $ppi_document->children;
while (my $element = shift @queue) {
if ($element->isa('PPI::Token::Pod')) {
my $after_last = $last_code_elem
&& $last_code_elem->line_number > $element->line_number;
my @replacements = $self->_replacements_for($element, $after_last);
# save the text for use in building the Pod-only document
push @pod_tokens, "$element";
my $last = $element;
while (my $next = shift @replacements) {
my $ok = $last->insert_after($next);
confess("error inserting replacement!") unless $ok;
$last = $next;
}
$element->delete;
next;
}
if ( _INSTANCE($element, 'PPI::Node') ) {
# Depth-first keeps the queue size down
unshift @queue, $element->children;
}
}
}
my $finder = sub {
my $node = $_[1];
return 0 unless any { $node->isa($_) }
qw( PPI::Token::Quote PPI::Token::QuoteLike PPI::Token::HereDoc );
return 1 if $node->content =~ /^=[a-z]/m;
return 0;
};
if ($ppi_document->find_first($finder)) {
$self->log(
sprintf "can't invoke %s on %s: there is POD inside string literals",
$self->plugin_name,
(defined $arg->{filename} ? $arg->{filename} : 'input')
);
}
# TODO: I should add a $weaver->weave_* like the Linewise methods to take the
# input, get a Document, perform the stock transformations, and then weave.
# -- rjbs, 2009-10-24
my $pod_str = join "\n", @pod_tokens;
my $pod_document = Pod::Elemental->read_string($pod_str);
my $doc = $self->$orig(
{
ppi => $ppi_document,
pod => $pod_document,
},
$arg,
);
my $new_pod = $doc->{pod}->as_pod_string;
my $end_finder = sub {
return 1 if $_[1]->isa('PPI::Statement::End')
|| $_[1]->isa('PPI::Statement::Data');
return 0;
};
my $end = do {
my $end_elem = $doc->{ppi}->find($end_finder);
# If there's nothing after __END__, we can put the POD there:
if (not $end_elem or (@$end_elem == 1 and
$end_elem->[0]->isa('PPI::Statement::End') and
$end_elem->[0] =~ /^__END__\s*\z/)) {
$end_elem = [];
}
@$end_elem ? join q{}, @$end_elem : undef;
};
$doc->{ppi}->prune($end_finder);
my $new_perl = Encode::decode(
'utf-8',
$doc->{ppi}->serialize,
Encode::FB_CROAK,
);
s/\n\s*\z// for $new_perl, $new_pod;
return defined $end
? "$new_perl\n\n$new_pod\n\n$end"
: "$new_perl\n\n__END__\n\n$new_pod\n";
};
#pod =attr replacer
#pod
#pod The replacer is either a method name or code reference used to produces PPI
#pod elements used to replace removed Pod. By default, it is
#pod C<L</replace_with_nothing>>, which just removes Pod tokens entirely. This
#pod means that the line numbers of the code in the newly-produced document are
#pod changed, if the Pod had been interleaved with the code.
#pod
#pod See also C<L</replace_with_comment>> and C<L</replace_with_blank>>.
#pod
#pod If no further code follows the Pod being replaced, C<L</post_code_replacer>> is
#pod used instead.
#pod
#pod =attr post_code_replacer
#pod
#pod This attribute is used just like C<L</replacer>>, and defaults to its value,
#pod but is used for building replacements for Pod removed after the last hunk of
#pod code. The idea is that if you're only concerned about altering your code's
#pod line numbers, you can stop replacing stuff after there's no more code to be
#pod affected.
#pod
#pod =cut
has replacer => (
is => 'ro',
default => 'replace_with_nothing',
);
has post_code_replacer => (
is => 'ro',
lazy => 1,
default => sub { $_[0]->replacer },
);
sub _replacements_for {
my ($self, $element, $after_last) = @_;
my $replacer = $after_last ? $self->replacer : $self->post_code_replacer;
return $self->$replacer($element);
}
#pod =method replace_with_nothing
#pod
#pod This method returns nothing. It's the default C<L</replacer>>. It's not very
#pod interesting.
#pod
#pod =cut
sub replace_with_nothing { return }
#pod =method replace_with_comment
#pod
#pod This replacer replaces removed Pod elements with a comment containing their
#pod text. In other words:
#pod
#pod =head1 A header!
#pod
#pod This is great!
#pod
#pod =cut
#pod
#pod ...is replaced with:
#pod
#pod # =head1 A header!
#pod #
#pod # This is great!
#pod #
#pod # =cut
#pod
#pod =cut
sub replace_with_comment {
my ($self, $element) = @_;
my $text = "$element";
(my $pod = $text) =~ s/^(.)/#pod $1/mg;
$pod =~ s/^$/#pod/mg;
my $commented_out = PPI::Token::Comment->new($pod);
return $commented_out;
}
#pod =method replace_with_blank
#pod
#pod This replacer replaces removed Pod elements with vertical whitespace of equal
#pod line count. In other words:
#pod
#pod =head1 A header!
#pod
#pod This is great!
#pod
#pod =cut
#pod
#pod ...is replaced with five blank lines.
#pod
#pod =cut
sub replace_with_blank {
my ($self, $element) = @_;
my $text = "$element";
my @lines = split /\n/, $text;
my $blank = PPI::Token::Whitespace->new("\n" x (@lines));
return $blank;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Pod::Elemental::PerlMunger - a thing that takes a string of Perl and rewrites its documentation
=head1 VERSION
version 0.200003
=head1 OVERVIEW
This role is to be included in classes that rewrite the documentation of a Perl
document, stripping out all the Pod, munging it, and replacing it into the
Perl.
The only relevant method is C<munge_perl_string>, which must be implemented
with a different interface than will be exposed.
When calling the C<munge_perl_string> method, arguments should be passed like
this:
$object->munge_perl_string($perl_string, \%arg);
C<$perl_string> should be a character string containing Perl source code.
C<%arg> may contain any input for the underlying procedure. The only key with
associated meaning is C<filename> which may be omitted. If given, it should be
the name of the file whose contents are being munged.
The method will return a character string containing the rewritten and combined
document.
Classes including this role must implement a C<munge_perl_string> that expects
to be called like this:
$object->munge_perl_string(\%doc, \%arg);
C<%doc> will have two entries:
ppi - a PPI::Document of the Perl document with all its Pod removed
pod - a Pod::Elemental::Document with no transformations yet performed
This C<munge_perl_string> method should return a hashref in the same format as
C<%doc>.
=head1 ATTRIBUTES
=head2 replacer
The replacer is either a method name or code reference used to produces PPI
elements used to replace removed Pod. By default, it is
C<L</replace_with_nothing>>, which just removes Pod tokens entirely. This
means that the line numbers of the code in the newly-produced document are
changed, if the Pod had been interleaved with the code.
See also C<L</replace_with_comment>> and C<L</replace_with_blank>>.
If no further code follows the Pod being replaced, C<L</post_code_replacer>> is
used instead.
=head2 post_code_replacer
This attribute is used just like C<L</replacer>>, and defaults to its value,
but is used for building replacements for Pod removed after the last hunk of
code. The idea is that if you're only concerned about altering your code's
line numbers, you can stop replacing stuff after there's no more code to be
affected.
=head1 METHODS
=head2 replace_with_nothing
This method returns nothing. It's the default C<L</replacer>>. It's not very
interesting.
=head2 replace_with_comment
This replacer replaces removed Pod elements with a comment containing their
text. In other words:
=head1 A header!
This is great!
=cut
...is replaced with:
# =head1 A header!
#
# This is great!
#
# =cut
=head2 replace_with_blank
This replacer replaces removed Pod elements with vertical whitespace of equal
line count. In other words:
=head1 A header!
This is great!
=cut
...is replaced with five blank lines.
=head1 AUTHOR
Ricardo SIGNES <rjbs@cpan.org>
=head1 CONTRIBUTORS
=for stopwords Christopher J. Madsen Dave Rolsky Karen Etheridge
=over 4
=item *
Christopher J. Madsen <perl@cjmweb.net>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Karen Etheridge <ether@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Ricardo SIGNES.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|