Commit | Line | Data |
351625bd |
1 | |
2 | require 5; |
3 | package Pod::Simple::DumpAsText; |
4 | $VERSION = '2.02'; |
5 | use Pod::Simple (); |
6 | BEGIN {@ISA = ('Pod::Simple')} |
7 | |
8 | use strict; |
9 | |
10 | use Carp (); |
11 | |
12 | BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG } |
13 | |
14 | sub new { |
15 | my $self = shift; |
16 | my $new = $self->SUPER::new(@_); |
17 | $new->{'output_fh'} ||= *STDOUT{IO}; |
18 | $new->accept_codes('VerbatimFormatted'); |
19 | return $new; |
20 | } |
21 | |
22 | #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ |
23 | |
24 | sub _handle_element_start { |
25 | # ($self, $element_name, $attr_hash_r) |
26 | my $fh = $_[0]{'output_fh'}; |
27 | my($key, $value); |
28 | DEBUG and print "++ $_[1]\n"; |
29 | |
30 | print $fh ' ' x ($_[0]{'indent'} || 0), "++", $_[1], "\n"; |
31 | $_[0]{'indent'}++; |
32 | while(($key,$value) = each %{$_[2]}) { |
33 | unless($key =~ m/^~/s) { |
34 | next if $key eq 'start_line' and $_[0]{'hide_line_numbers'}; |
35 | _perly_escape($key); |
36 | _perly_escape($value); |
37 | printf $fh qq{%s \\ "%s" => "%s"\n}, |
38 | ' ' x ($_[0]{'indent'} || 0), $key, $value; |
39 | } |
40 | } |
41 | return; |
42 | } |
43 | |
44 | sub _handle_text { |
45 | DEBUG and print "== \"$_[1]\"\n"; |
46 | |
47 | if(length $_[1]) { |
48 | my $indent = ' ' x $_[0]{'indent'}; |
49 | my $text = $_[1]; |
50 | _perly_escape($text); |
51 | $text =~ # A not-totally-brilliant wrapping algorithm: |
52 | s/( |
53 | [^\n]{55} # Snare some characters from a line |
54 | [^\n\ ]{0,50} # and finish any current word |
55 | ) |
56 | \x20{1,10}(?!\n) # capture some spaces not at line-end |
57 | /$1"\n$indent . "/gx # => line-break here |
58 | ; |
59 | |
60 | print {$_[0]{'output_fh'}} $indent, '* "', $text, "\"\n"; |
61 | } |
62 | return; |
63 | } |
64 | |
65 | sub _handle_element_end { |
66 | DEBUG and print "-- $_[1]\n"; |
67 | print {$_[0]{'output_fh'}} |
68 | ' ' x --$_[0]{'indent'}, "--", $_[1], "\n"; |
69 | return; |
70 | } |
71 | |
72 | # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . |
73 | |
74 | sub _perly_escape { |
75 | foreach my $x (@_) { |
76 | $x =~ s/([^\x00-\xFF])/sprintf'\x{%X}',ord($1)/eg; |
77 | # Escape things very cautiously: |
78 | $x =~ s/([^-\n\t \&\<\>\'!\#\%\(\)\*\+,\.\/\:\;=\?\~\[\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf'\x%02X',ord($1)/eg; |
79 | } |
80 | return; |
81 | } |
82 | |
83 | #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ |
84 | 1; |
85 | |
86 | |
87 | __END__ |
88 | |
89 | =head1 NAME |
90 | |
91 | Pod::Simple::DumpAsText -- dump Pod-parsing events as text |
92 | |
93 | =head1 SYNOPSIS |
94 | |
95 | perl -MPod::Simple::DumpAsText -e \ |
96 | "exit Pod::Simple::DumpAsText->filter(shift)->any_errata_seen" \ |
97 | thingy.pod |
98 | |
99 | =head1 DESCRIPTION |
100 | |
101 | This class is for dumping, as text, the events gotten from parsing a Pod |
102 | document. This class is of interest to people writing Pod formatters |
103 | based on Pod::Simple. It is useful for seeing exactly what events you |
104 | get out of some Pod that you feed in. |
105 | |
106 | This is a subclass of L<Pod::Simple> and inherits all its methods. |
107 | |
108 | =head1 SEE ALSO |
109 | |
110 | L<Pod::Simple::DumpAsXML> |
111 | |
112 | L<Pod::Simple> |
113 | |
114 | =head1 COPYRIGHT AND DISCLAIMERS |
115 | |
116 | Copyright (c) 2002 Sean M. Burke. All rights reserved. |
117 | |
118 | This library is free software; you can redistribute it and/or modify it |
119 | under the same terms as Perl itself. |
120 | |
121 | This program is distributed in the hope that it will be useful, but |
122 | without any warranty; without even the implied warranty of |
123 | merchantability or fitness for a particular purpose. |
124 | |
125 | =head1 AUTHOR |
126 | |
127 | Sean M. Burke C<sburke@cpan.org> |
128 | |
129 | =cut |
130 | |