File Coverage

blib/lib/Mail/DKIM/TextWrap.pm
Criterion Covered Total %
statement 72 73 98.6
branch 18 22 81.8
condition 14 14 100.0
subroutine 10 10 100.0
pod 5 6 83.3
total 119 125 95.2


line stmt bran cond sub pod time code
1             package Mail::DKIM::TextWrap;
2 2     2   62921 use strict;
  2         16  
  2         57  
3 2     2   13 use warnings;
  2         4  
  2         74  
4             our $VERSION = '1.20230630'; # VERSION
5             # ABSTRACT: text wrapping module written for use with DKIM
6              
7 2     2   12 use Carp;
  2         3  
  2         1745  
8              
9              
10             sub new {
11 9     9 1 7660 my $class = shift;
12 9         35 my %args = @_;
13 9         105 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 9   100     79 $self->{Output} ||= \*STDOUT;
26 9         55 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             #
46             sub _calculate_new_column {
47 446     446   718 my ( $cur, $text ) = @_;
48 446 50       778 confess "invalid argument" unless defined($text);
49              
50 446         1340 while ( $text =~ /^(.*?)([\n\r\t])(.*)$/s ) {
51 76         149 $cur += length($1);
52 76 100       166 if ( $2 eq "\t" ) {
53 18         41 $cur = ( int( $cur / 8 ) + 1 ) * 8;
54             }
55             else {
56 58         79 $cur = 0;
57             }
58 76         232 $text = $3;
59             }
60 446         600 $cur += length($text);
61 446         729 return $cur;
62             }
63              
64              
65             sub add {
66 122     122 1 6917 my ( $self, $text ) = @_;
67 122         175 my $break_after = $self->{Break};
68 122         151 my $break_before = $self->{BreakBefore};
69 122         156 my $swallow = $self->{Swallow};
70 122         187 $self->{word} .= $text;
71 122         251 while ( length $self->{word} ) {
72 471         578 my $word;
73 471 100 100     2996 if ( defined($break_before)
    100 100        
    100          
74             and $self->{word} =~ s/^(.+?)($break_before)/$2/s )
75             {
76             # note- $1 should have at least one character
77 16         38 $word = $1;
78             }
79             elsif ( defined($break_after)
80             and $self->{word} =~ s/^(.*?)($break_after)//s )
81             {
82 361         788 $word = $1 . $2;
83             }
84             elsif ( $self->{NoBuffering} ) {
85 22         37 $word = $self->{word};
86 22         36 $self->{word} = "";
87             }
88             else {
89 72         168 last;
90             }
91              
92 399 50       814 die "assertion failed" unless length($word) >= 1;
93              
94 399         490 my $next_soft_space;
95 399 100 100     1619 if ( defined($swallow) && $word =~ s/($swallow)$//s ) {
96 84         163 $next_soft_space = $1;
97             }
98             else {
99 315         482 $next_soft_space = "";
100             }
101              
102 399         702 my $to_print = $self->{soft_space} . $word;
103 399         676 my $new_pos = _calculate_new_column( $self->{cur}, $to_print );
104              
105 399 100 100     833 if ( $new_pos > $self->{Margin} && $self->{may_break} ) {
106              
107             # what would happen if we put the separator in?
108             my $w_sep =
109 47         100 _calculate_new_column( $self->{cur}, $self->{Separator} );
110 47 100       99 if ( $w_sep < $self->{cur} ) {
111              
112             # inserting the separator gives us more room,
113             # so do it
114 46         105 $self->output( $self->{Separator} );
115 46         70 $self->{soft_space} = "";
116 46         62 $self->{cur} = $w_sep;
117 46         89 $self->{word} = $word . $next_soft_space . $self->{word};
118 46         116 next;
119             }
120             }
121              
122 353         771 $self->output($to_print);
123 353         490 $self->{soft_space} = $next_soft_space;
124 353         449 $self->{cur} = $new_pos;
125 353         843 $self->{may_break} = 1;
126             }
127             }
128              
129              
130             sub finish {
131 12     12 1 45 my $self = shift;
132 12         37 $self->flush;
133 12         28 $self->reset;
134             }
135              
136              
137             sub flush {
138 30     30 1 54 my $self = shift;
139              
140 30         57 local $self->{NoBuffering} = 1;
141 30         63 local $self->{Swallow} = undef;
142 30         57 $self->add("");
143             }
144              
145             sub output {
146 399     399 1 509 my $self = shift;
147 399         555 my $to_print = shift;
148              
149 399         563 my $out = $self->{Output};
150 399 50       1046 if ( UNIVERSAL::isa( $out, "GLOB" ) ) {
    50          
151 0         0 print $out $to_print;
152             }
153             elsif ( UNIVERSAL::isa( $out, "SCALAR" ) ) {
154 399         683 $$out .= $to_print;
155             }
156             }
157              
158             sub reset {
159 12     12 0 18 my $self = shift;
160 12         19 $self->{cur} = 0;
161 12         17 $self->{soft_space} = "";
162 12         27 $self->{word} = "";
163             }
164              
165             1;
166              
167             __END__