/usr/share/perl5/DhMakePerl/PodParser.pm is in dh-make-perl 0.84-2+deb8u1.
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 | package DhMakePerl::PodParser;
use strict;
use warnings;
our $VERSION = '0.51';
use base qw(Pod::Parser);
=head1 NAME
DhMakePerl::PodParser - internal helper module for DhMakePerl
=head1 SYNOPSIS
DhMakePerl::PodParser is used by DhMakePerl to extract some
information from the module-to-be-packaged. It sub-classes from
L<Pod::Parser> - Please refer to it for further documentation.
=head1 METHODS
=over
=item set_names
Defines the names of the sections that should be fetched from the POD
=cut
sub set_names {
my ( $parser, @names ) = @_;
foreach my $n (@names) {
$parser->{_deb_}->{$n} = undef;
}
}
=item get
Gets the contents for the specified POD section. The single argument should be
one of the values given to L</set_names>.
=cut
sub get {
my ( $parser, $name ) = @_;
$parser->{_deb_}->{$name};
}
=item cleanup
Empties the information held by the parser object
=cut
sub cleanup {
my $parser = shift;
delete $parser->{_current_};
foreach my $k ( keys %{ $parser->{_deb_} } ) {
$parser->{_deb_}->{$k} = undef;
}
}
=item command
Overrides base class' L<Pod::Parser> L<command|Pod::Parser/command> method.
Gets each of the POD's commands
(sections), and defines how it should react to each of them. In this
particular implementation, it basically filters out anything except
for the C<=head> sections defined in L</set_names>.
=cut
sub command {
my ( $parser, $command, $paragraph, $line_num ) = @_;
$paragraph =~ s/\s+$//s;
if ( $command =~ /head/ && exists( $parser->{_deb_}->{$paragraph} ) ) {
$parser->{_current_} = $paragraph;
$parser->{_lineno_} = $line_num;
}
else {
delete $parser->{_current_};
}
#print "GOT: $command -> $paragraph\n";
}
=item add_text
Hands back the text it received as it occurred in the input stream (see the
L<Pod::Parser>'s documentation for L<verbatim|Pod::Parser/verbatim>,
L<textblock|Pod::Parser/textblock> and
L<interior_sequence|Pod::Parser/interior_sequence>).
Content is ignored if more than 15 lines away from the section start.
=cut
sub add_text {
my ( $parser, $paragraph, $line_num ) = @_;
return unless exists $parser->{_current_};
return if ( $line_num - $parser->{_lineno_} > 15 );
$paragraph =~ s/^\s+//s;
$paragraph =~ s/\s+$//s;
$paragraph = $parser->interpolate( $paragraph, $line_num );
$parser->{_deb_}->{ $parser->{_current_} } .= "\n\n" . $paragraph;
#print "GOT: $paragraph'\n";
}
=item verbatim
Called by L<Pod::Parser> for verbatim paragraphs. Redirected to L</add_text>.
=cut
sub verbatim { shift->add_text(@_) }
=item textblock
Called by L<Pod::Parser> for ordinary text paragraphs. Redirected to
L</add_text>.
=cut
sub textblock { shift->add_text(@_) }
=item interior_sequence
L<interior_sequence()|Pod::Parser/interior_sequence()> is called by
L<Pod::Parser> when, eh, an interior sequence occurs in the text. Interior
sequences are things like IE<lt>...E<gt>.
This implementation decodes C<gt>, C<lt>, C<sol>, C<verbar> and numeric
character codes, all used by C<E> escape.
=cut
sub interior_sequence {
my ( $parser, $seq_command, $seq_argument ) = @_;
if ( $seq_command eq 'E' ) {
my %map = ( 'gt' => '>', 'lt' => '<', 'sol' => '/', 'verbar' => '|' );
return $map{$seq_argument} if exists $map{$seq_argument};
return chr($seq_argument) if ( $seq_argument =~ /^\d+$/ );
# html names...
}
return $seq_argument;
}
1;
=back
=head1 SEE ALSO
L<Pod::Parser>
=head1 AUTHOR
=over 4
=item Paolo Molaro
=item Documentation added by Gunnar Wolf and Damyan Ivanov
=back
=head1 COPYRIGHT & LICENSE
=over 4
=item Copyright (C) 2001, Paolo Molaro <lupus@debian.org>
=item Copyright (C) 2008, Gunnar Wolf <gwolf@debian.org>
=item Copyright (C) 2008, Damyan Ivanov <dmn@debian.org>
=back
This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License version 2 as published by the Free
Software Foundation.
This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
Street, Fifth Floor, Boston, MA 02110-1301 USA.
=cut
|