← 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:14 2021

Filename/usr/local/lib/perl5/site_perl/Mail/AuthenticationResults/FoldableHeader.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMail::AuthenticationResults::FoldableHeader::::BEGIN@10Mail::AuthenticationResults::FoldableHeader::BEGIN@10
0000s0sMail::AuthenticationResults::FoldableHeader::::BEGIN@11Mail::AuthenticationResults::FoldableHeader::BEGIN@11
0000s0sMail::AuthenticationResults::FoldableHeader::::BEGIN@12Mail::AuthenticationResults::FoldableHeader::BEGIN@12
0000s0sMail::AuthenticationResults::FoldableHeader::::BEGIN@13Mail::AuthenticationResults::FoldableHeader::BEGIN@13
0000s0sMail::AuthenticationResults::FoldableHeader::::BEGIN@14Mail::AuthenticationResults::FoldableHeader::BEGIN@14
0000s0sMail::AuthenticationResults::FoldableHeader::::BEGIN@5Mail::AuthenticationResults::FoldableHeader::BEGIN@5
0000s0sMail::AuthenticationResults::FoldableHeader::::BEGIN@6Mail::AuthenticationResults::FoldableHeader::BEGIN@6
0000s0sMail::AuthenticationResults::FoldableHeader::::BEGIN@8Mail::AuthenticationResults::FoldableHeader::BEGIN@8
0000s0sMail::AuthenticationResults::FoldableHeader::::__ANON__Mail::AuthenticationResults::FoldableHeader::__ANON__ (xsub)
0000s0sMail::AuthenticationResults::FoldableHeader::::as_stringMail::AuthenticationResults::FoldableHeader::as_string
0000s0sMail::AuthenticationResults::FoldableHeader::::assignmentMail::AuthenticationResults::FoldableHeader::assignment
0000s0sMail::AuthenticationResults::FoldableHeader::::commentMail::AuthenticationResults::FoldableHeader::comment
0000s0sMail::AuthenticationResults::FoldableHeader::::eolMail::AuthenticationResults::FoldableHeader::eol
0000s0sMail::AuthenticationResults::FoldableHeader::::force_fold_atMail::AuthenticationResults::FoldableHeader::force_fold_at
0000s0sMail::AuthenticationResults::FoldableHeader::::indentMail::AuthenticationResults::FoldableHeader::indent
0000s0sMail::AuthenticationResults::FoldableHeader::::newMail::AuthenticationResults::FoldableHeader::new
0000s0sMail::AuthenticationResults::FoldableHeader::::separatorMail::AuthenticationResults::FoldableHeader::separator
0000s0sMail::AuthenticationResults::FoldableHeader::::set_eolMail::AuthenticationResults::FoldableHeader::set_eol
0000s0sMail::AuthenticationResults::FoldableHeader::::set_force_fold_atMail::AuthenticationResults::FoldableHeader::set_force_fold_at
0000s0sMail::AuthenticationResults::FoldableHeader::::set_indentMail::AuthenticationResults::FoldableHeader::set_indent
0000s0sMail::AuthenticationResults::FoldableHeader::::set_sub_indentMail::AuthenticationResults::FoldableHeader::set_sub_indent
0000s0sMail::AuthenticationResults::FoldableHeader::::set_try_fold_atMail::AuthenticationResults::FoldableHeader::set_try_fold_at
0000s0sMail::AuthenticationResults::FoldableHeader::::spaceMail::AuthenticationResults::FoldableHeader::space
0000s0sMail::AuthenticationResults::FoldableHeader::::stringMail::AuthenticationResults::FoldableHeader::string
0000s0sMail::AuthenticationResults::FoldableHeader::::sub_indentMail::AuthenticationResults::FoldableHeader::sub_indent
0000s0sMail::AuthenticationResults::FoldableHeader::::try_fold_atMail::AuthenticationResults::FoldableHeader::try_fold_at
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Mail::AuthenticationResults::FoldableHeader;
2# ABSTRACT: Class for modelling a foldable header string
3
4require 5.008;
5use strict;
6use warnings;
7our $VERSION = '2.20210112'; # VERSION
8use Carp;
9
10use Mail::AuthenticationResults::Token::String;
11use Mail::AuthenticationResults::Token::Space;
12use Mail::AuthenticationResults::Token::Separator;
13use Mail::AuthenticationResults::Token::Comment;
14use Mail::AuthenticationResults::Token::Assignment;
15
16
17sub new {
18 my ( $class, $args ) = @_;
19
20 my $self = {};
21 bless $self, $class;
22
23 $self->{ 'string' } = [];
24
25 return $self;
26}
27
28
29sub eol {
30 my ( $self ) = @_;
31 return $self->{ 'eol' } if exists ( $self->{ 'eol' } );
32 return "\n";
33}
34
35
36sub set_eol {
37 my ( $self, $eol ) = @_;
38 $self->{ 'eol' } = $eol;
39 return $self;
40}
41
42
43sub indent {
44 my ( $self ) = @_;
45 return $self->{ 'indent' } if exists ( $self->{ 'indent' } );
46 return ' ';
47}
48
49
50sub set_indent {
51 my ( $self, $indent ) = @_;
52 $self->{ 'indent' } = $indent;
53 return $self;
54}
55
56
57sub sub_indent {
58 my ( $self ) = @_;
59 return $self->{ 'sub_indent' } if exists ( $self->{ 'sub_indent' } );
60 return ' ';
61}
62
63
64sub set_sub_indent {
65 my ( $self, $indent ) = @_;
66 $self->{ 'sub_indent' } = $indent;
67 return $self;
68}
69
70
71sub try_fold_at {
72 my ( $self ) = @_;
73 return $self->{ 'try_fold_at' } if exists ( $self->{ 'try_fold_at' } );
74 return 800;
75}
76
77
78sub set_try_fold_at {
79 my ( $self, $length ) = @_;
80 $self->{ 'try_fold_at' } = $length;
81 return $self;
82}
83
84
85sub force_fold_at {
86 my ( $self ) = @_;
87 return $self->{ 'force_fold_at' } if exists ( $self->{ 'force_fold_at' } );
88 return 900;
89}
90
91
92sub set_force_fold_at {
93 my ( $self, $length ) = @_;
94 $self->{ 'force_fold_at' } = $length;
95 return $self;
96}
97
98
99sub string {
100 my( $self, $string ) = @_;
101 push @{ $self->{ 'string' } }, Mail::AuthenticationResults::Token::String->new_from_value( $string );
102 return $self;
103}
104
105
106sub space {
107 my ( $self, $string ) = @_;
108 push @{ $self->{ 'string' } }, Mail::AuthenticationResults::Token::Space->new_from_value( $string );
109 return $self;
110}
111
112
113sub separator {
114 my ( $self, $string ) = @_;
115 push @{ $self->{ 'string' } }, Mail::AuthenticationResults::Token::Separator->new_from_value( $string );
116 return $self;
117}
118
119
120sub comment {
121 my ( $self, $string ) = @_;
122 push @{ $self->{ 'string' } }, Mail::AuthenticationResults::Token::Comment->new_from_value( $string );
123 return $self;
124}
125
126
127sub assignment {
128 my ( $self, $string ) = @_;
129 push @{ $self->{ 'string' } }, Mail::AuthenticationResults::Token::Assignment->new_from_value( $string );
130 return $self;
131}
132
133
134sub as_string {
135 my ( $self ) = @_;
136
137 my $string = q{};
138 my $string_length = 0;
139 my $content_added = 0;
140
141 my $sections = [];
142 my $stack = [];
143 my $last_type;
144
145 foreach my $part ( @{ $self->{ 'string' } } ) {
146 if ( $part->is() eq 'space' && $last_type ne 'space' ) {
147 # We have a folding space
148 push @$sections, $stack if @$stack;
149 $stack = [];
150 }
151 push @$stack, $part;
152 $last_type = $part->is();
153 }
154 push @$sections, $stack if @$stack;
155
156 my $eol = $self->eol();;
157 my $indent = $self->indent();
158 my $sub_indent = $self->sub_indent();
159
160 my $fold_length = 0;
161 SECTION:
162 while ( my $section = shift @$sections ) {
163 if ( $section->[0]->is() eq 'space' && $section->[0]->value() eq $eol ) {
164 # This section starts a new line
165 $fold_length = 0;
166 if ( ! exists( $section->[0]->{ '_folded' } ) ) {
167 if ( $section->[1]->is() eq 'space' ) {
168 # Take the last indent value for the fold indent
169 $indent = $section->[1]->value();
170 }
171 }
172 }
173
174 my $section_string = join( q{}, map { $_->value() } @$section );
175 my $section_length = length( $section_string );
176
177 if ( $fold_length + $section_length > $self->try_fold_at() ) {
178if ( $fold_length > 0 ) {
179 # Remove whitespace tokens at beginning of section
180 while ( $section->[0]->is() eq 'space' ) {
181 shift @$section;
182 }
183 # Insert new folding whitespace at beginning of section
184 unshift @$section, Mail::AuthenticationResults::Token::Space->new_from_value( $indent . $sub_indent );
185 unshift @$section, Mail::AuthenticationResults::Token::Space->new_from_value( $eol );
186 $section->[0]->{ '_folded' } = 1;
187 unshift @$sections, $section;
188 next SECTION;
189 }
190 else {
191 # ToDo:
192 # This section alone is over the line limit
193 # It already starts with a fold, so we need to remove
194 # some of it to a new line if we can.
195
196 # Strategy 1: Fold at a relevant token boundary
197 my $first_section = [];
198 my $second_section = [];
199 push @$second_section, Mail::AuthenticationResults::Token::Space->new_from_value( $eol );
200 push @$second_section, Mail::AuthenticationResults::Token::Space->new_from_value( $indent . $sub_indent );
201 $second_section->[0]->{ '_folded' } = 1;
202 my $first_section_length = 0;
203 foreach my $part ( @$section ) {
204 my $part_length = length $part->value();
205 if ( $part_length + $first_section_length < $self->try_fold_at() ) {
206 push @$first_section, $part;
207 $first_section_length += $part_length;
208 }
209 else {
210 push @$second_section, $part;
211 $first_section_length = $self->try_fold_at() + 1; # everything from this point goes onto second
212 }
213 }
214 # Do we have a first and second section with actual content?
215 if ( ( grep { $_->is() ne 'space' } @$first_section ) &&
216 ( grep { $_->is() ne 'space' } @$second_section ) ) {
217 unshift @$sections, $second_section;
218 unshift @$sections, $first_section;
219 next SECTION;
220 }
221
222 # We MUST fold at $self->force_fold_at();
223 # Strategy 2: Force fold at a space within a string
224 # Strategy 3: Force fold anywhere
225
226 # We assume that force fold is greater than try fold
227 }
228 }
229
230 $string .= $section_string;
231 $fold_length += $section_length;
232 }
233
234 return $string;
235}
236
2371;
238
239__END__