← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:13 2021

Filename/usr/local/lib/perl5/site_perl/HTML/FormatText.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sHTML::FormatText::::BEGIN@14HTML::FormatText::BEGIN@14
0000s0sHTML::FormatText::::BEGIN@6HTML::FormatText::BEGIN@6
0000s0sHTML::FormatText::::BEGIN@7HTML::FormatText::BEGIN@7
0000s0sHTML::FormatText::::BEGIN@8HTML::FormatText::BEGIN@8
0000s0sHTML::FormatText::::adjust_lmHTML::FormatText::adjust_lm
0000s0sHTML::FormatText::::adjust_rmHTML::FormatText::adjust_rm
0000s0sHTML::FormatText::::beginHTML::FormatText::begin
0000s0sHTML::FormatText::::bulletHTML::FormatText::bullet
0000s0sHTML::FormatText::::configureHTML::FormatText::configure
0000s0sHTML::FormatText::::default_valuesHTML::FormatText::default_values
0000s0sHTML::FormatText::::endHTML::FormatText::end
0000s0sHTML::FormatText::::goto_lmHTML::FormatText::goto_lm
0000s0sHTML::FormatText::::header_endHTML::FormatText::header_end
0000s0sHTML::FormatText::::header_startHTML::FormatText::header_start
0000s0sHTML::FormatText::::hr_startHTML::FormatText::hr_start
0000s0sHTML::FormatText::::nlHTML::FormatText::nl
0000s0sHTML::FormatText::::outHTML::FormatText::out
0000s0sHTML::FormatText::::pre_outHTML::FormatText::pre_out
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package HTML::FormatText;
2
3# ABSTRACT: Format HTML as plaintext
4
5
6use 5.006_001;
7use strict;
8use warnings;
9
10# We now use Smart::Comments in place of the old DEBUG framework.
11# this should be commented out in release versions....
12##use Smart::Comments;
13
14use base 'HTML::Formatter';
15
16our $VERSION = '2.12'; # VERSION
17our $AUTHORITY = 'cpan:NIGELM'; # AUTHORITY
18
19# ------------------------------------------------------------------------
20sub default_values {
21 ( shift->SUPER::default_values(),
22 lm => 3, # left margin
23 rm => 72, # right margin (actually, maximum text width)
24 );
25}
26
27# ------------------------------------------------------------------------
28sub configure {
29 my ( $self, $hash ) = @_;
30
31 my $lm = $self->{lm};
32 my $rm = $self->{rm};
33
34 $lm = delete $hash->{lm} if exists $hash->{lm};
35 $lm = delete $hash->{leftmargin} if exists $hash->{leftmargin};
36 $rm = delete $hash->{rm} if exists $hash->{rm};
37 $rm = delete $hash->{rightmargin} if exists $hash->{rightmargin};
38
39 my $width = $rm - $lm;
40 if ( $width < 1 ) {
41 warn "Bad margins, ignored" if $^W;
42 return;
43 }
44 if ( $width < 20 ) {
45 warn "Page probably too narrow" if $^W;
46 }
47
48 for ( keys %$hash ) {
49 warn "Unknown configure option '$_'" if $^W;
50 }
51
52 $self->{lm} = $lm;
53 $self->{rm} = $rm;
54 $self;
55}
56
57# ------------------------------------------------------------------------
58sub begin {
59 my $self = shift;
60
61 $self->SUPER::begin;
62 $self->{curpos} = 0; # current output position.
63 $self->{maxpos} = 0; # highest value of $pos (used by header underliner)
64 $self->{hspace} = 0; # horizontal space pending flag
65}
66
67# ------------------------------------------------------------------------
68sub end {
69 shift->collect("\n");
70}
71
72# ------------------------------------------------------------------------
73sub header_start {
74 my ( $self, $level ) = @_;
75
76 $self->vspace( 1 + ( 6 - $level ) * 0.4 );
77 $self->{maxpos} = 0;
78 1;
79}
80
81# ------------------------------------------------------------------------
82sub header_end {
83 my ( $self, $level ) = @_;
84
85 if ( $level <= 2 ) {
86 my $line;
87 $line = '=' if $level == 1;
88 $line = '-' if $level == 2;
89 $self->vspace(0);
90 $self->out( $line x ( $self->{maxpos} - $self->{lm} ) );
91 }
92 $self->vspace(1);
93 1;
94}
95
96# ------------------------------------------------------------------------
97sub bullet {
98 my $self = shift;
99
100 $self->SUPER::bullet( $_[0] . ' ' );
101}
102
103# ------------------------------------------------------------------------
104sub hr_start {
105 my $self = shift;
106
107 $self->vspace(1);
108 $self->out( '-' x ( $self->{rm} - $self->{lm} ) );
109 $self->vspace(1);
110}
111
112# ------------------------------------------------------------------------
113sub pre_out {
114 my $self = shift;
115
116 # should really handle bold/italic etc.
117 if ( defined $self->{vspace} ) {
118 if ( $self->{out} ) {
119 $self->nl() while $self->{vspace}-- >= 0;
120 $self->{vspace} = undef;
121 }
122 }
123 my $indent = ' ' x $self->{lm};
124 my $pre = shift;
125 $pre =~ s/^/$indent/mg;
126 $self->collect($pre);
127 $self->{out}++;
128}
129
130# ------------------------------------------------------------------------
131sub out {
132 my $self = shift;
133 my $text = shift;
134
135 $text =~ tr/\xA0\xAD/ /d;
136
137 if ( $text =~ /^\s*$/ ) {
138 $self->{hspace} = 1;
139 return;
140 }
141
142 if ( defined $self->{vspace} ) {
143 if ( $self->{out} ) {
144 $self->nl while $self->{vspace}-- >= 0;
145 }
146 $self->goto_lm;
147 $self->{vspace} = undef;
148 $self->{hspace} = 0;
149 }
150
151 if ( $self->{hspace} ) {
152 if ( $self->{curpos} + length($text) > $self->{rm} ) {
153
154 # word will not fit on line; do a line break
155 $self->nl;
156 $self->goto_lm;
157 }
158 else {
159
160 # word fits on line; use a space
161 $self->collect(' ');
162 ++$self->{curpos};
163 }
164 $self->{hspace} = 0;
165 }
166
167 $self->collect($text);
168 my $pos = $self->{curpos} += length $text;
169 $self->{maxpos} = $pos if $self->{maxpos} < $pos;
170 $self->{'out'}++;
171}
172
173# ------------------------------------------------------------------------
174sub goto_lm {
175 my $self = shift;
176
177 my $pos = $self->{curpos};
178 my $lm = $self->{lm};
179 if ( $pos < $lm ) {
180 $self->{curpos} = $lm;
181 $self->collect( " " x ( $lm - $pos ) );
182 }
183}
184
185# ------------------------------------------------------------------------
186sub nl {
187 my $self = shift;
188
189 $self->{'out'}++;
190 $self->{curpos} = 0;
191 $self->collect("\n");
192}
193
194# ------------------------------------------------------------------------
195sub adjust_lm {
196 my $self = shift;
197
198 $self->{lm} += $_[0];
199 $self->goto_lm;
200}
201
202# ------------------------------------------------------------------------
203sub adjust_rm {
204 shift->{rm} += $_[0];
205}
206
207
2081;
209
210__END__