← 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/DKIM/TextWrap.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMail::DKIM::TextWrap::::BEGIN@2Mail::DKIM::TextWrap::BEGIN@2
0000s0sMail::DKIM::TextWrap::::BEGIN@3Mail::DKIM::TextWrap::BEGIN@3
0000s0sMail::DKIM::TextWrap::::BEGIN@7Mail::DKIM::TextWrap::BEGIN@7
0000s0sMail::DKIM::TextWrap::::_calculate_new_columnMail::DKIM::TextWrap::_calculate_new_column
0000s0sMail::DKIM::TextWrap::::addMail::DKIM::TextWrap::add
0000s0sMail::DKIM::TextWrap::::finishMail::DKIM::TextWrap::finish
0000s0sMail::DKIM::TextWrap::::flushMail::DKIM::TextWrap::flush
0000s0sMail::DKIM::TextWrap::::newMail::DKIM::TextWrap::new
0000s0sMail::DKIM::TextWrap::::outputMail::DKIM::TextWrap::output
0000s0sMail::DKIM::TextWrap::::resetMail::DKIM::TextWrap::reset
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Mail::DKIM::TextWrap;
2use strict;
3use warnings;
4our $VERSION = '1.20200907'; # VERSION
5# ABSTRACT: text wrapping module written for use with DKIM
6
7use Carp;
8
9
10sub new {
11 my $class = shift;
12 my %args = @_;
13 my $self = {
14 Margin => 72,
15 Break => qr/\s/,
16 BreakBefore => undef,
17 Swallow => qr/\s/,
18 Separator => "\n",
19 cur => 0,
20 may_break => 0,
21 soft_space => "",
22 word => "",
23 %args,
24 };
25 $self->{Output} ||= \*STDOUT;
26 return bless $self, $class;
27}
28
29# Internal properties:
30#
31# cur - the last known column position
32#
33# may_break - nonzero if the current location allows a linebreak
34#
35# soft_space - contains added text that will not be printed if a linebreak
36# occurs
37#
38# word - contains the current word
39
40# Internal methods:
41#
42# _calculate_new_column() - determine where cur would be after adding some text
43#
44# my $new_cur = _calculate_new_column($cur, "some additional\ntext");
45#
46sub _calculate_new_column {
47 my ( $cur, $text ) = @_;
48 confess "invalid argument" unless defined($text);
49
50 while ( $text =~ /^(.*?)([\n\r\t])(.*)$/s ) {
51 $cur += length($1);
52 if ( $2 eq "\t" ) {
53 $cur = ( int( $cur / 8 ) + 1 ) * 8;
54 }
55 else {
56 $cur = 0;
57 }
58 $text = $3;
59 }
60 $cur += length($text);
61 return $cur;
62}
63
64
65sub add {
66 my ( $self, $text ) = @_;
67 my $break_after = $self->{Break};
68 my $break_before = $self->{BreakBefore};
69 my $swallow = $self->{Swallow};
70 $self->{word} .= $text;
71 while ( length $self->{word} ) {
72 my $word;
73 if ( defined($break_before)
74 and $self->{word} =~ s/^(.+?)($break_before)/$2/s )
75 {
76 # note- $1 should have at least one character
77 $word = $1;
78 }
79 elsif ( defined($break_after)
80 and $self->{word} =~ s/^(.*?)($break_after)//s )
81 {
82 $word = $1 . $2;
83 }
84 elsif ( $self->{NoBuffering} ) {
85 $word = $self->{word};
86 $self->{word} = "";
87 }
88 else {
89 last;
90 }
91
92 die "assertion failed" unless length($word) >= 1;
93
94 my $next_soft_space;
95 if ( defined($swallow) && $word =~ s/($swallow)$//s ) {
96 $next_soft_space = $1;
97 }
98 else {
99 $next_soft_space = "";
100 }
101
102 my $to_print = $self->{soft_space} . $word;
103 my $new_pos = _calculate_new_column( $self->{cur}, $to_print );
104
105 if ( $new_pos > $self->{Margin} && $self->{may_break} ) {
106
107 # what would happen if we put the separator in?
108 my $w_sep =
109 _calculate_new_column( $self->{cur}, $self->{Separator} );
110 if ( $w_sep < $self->{cur} ) {
111
112 # inserting the separator gives us more room,
113 # so do it
114 $self->output( $self->{Separator} );
115 $self->{soft_space} = "";
116 $self->{cur} = $w_sep;
117 $self->{word} = $word . $next_soft_space . $self->{word};
118 next;
119 }
120 }
121
122 $self->output($to_print);
123 $self->{soft_space} = $next_soft_space;
124 $self->{cur} = $new_pos;
125 $self->{may_break} = 1;
126 }
127}
128
129
130sub finish {
131 my $self = shift;
132 $self->flush;
133 $self->reset;
134}
135
136
137sub flush {
138 my $self = shift;
139
140 local $self->{NoBuffering} = 1;
141 local $self->{Swallow} = undef;
142 $self->add("");
143}
144
145sub output {
146 my $self = shift;
147 my $to_print = shift;
148
149 my $out = $self->{Output};
150 if ( UNIVERSAL::isa( $out, "GLOB" ) ) {
151 print $out $to_print;
152 }
153 elsif ( UNIVERSAL::isa( $out, "SCALAR" ) ) {
154 $$out .= $to_print;
155 }
156}
157
158sub reset {
159 my $self = shift;
160 $self->{cur} = 0;
161 $self->{soft_space} = "";
162 $self->{word} = "";
163}
164
1651;
166
167__END__