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   66787 use strict;
  2         16  
  2         62  
3 2     2   10 use warnings;
  2         4  
  2         81  
4             our $VERSION = '1.20230911'; # VERSION
5             # ABSTRACT: text wrapping module written for use with DKIM
6              
7 2     2   11 use Carp;
  2         3  
  2         1754  
8              
9              
10             sub new {
11 9     9 1 3296 my $class = shift;
12 9         29 my %args = @_;
13 9         103 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     86 $self->{Output} ||= \*STDOUT;
26 9         47 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   771 my ( $cur, $text ) = @_;
48 446 50       749 confess "invalid argument" unless defined($text);
49              
50 446         1320 while ( $text =~ /^(.*?)([\n\r\t])(.*)$/s ) {
51 76         137 $cur += length($1);
52 76 100       134 if ( $2 eq "\t" ) {
53 18         37 $cur = ( int( $cur / 8 ) + 1 ) * 8;
54             }
55             else {
56 58         82 $cur = 0;
57             }
58 76         235 $text = $3;
59             }
60 446         627 $cur += length($text);
61 446         710 return $cur;
62             }
63              
64              
65             sub add {
66 122     122 1 2483 my ( $self, $text ) = @_;
67 122         191 my $break_after = $self->{Break};
68 122         154 my $break_before = $self->{BreakBefore};
69 122         154 my $swallow = $self->{Swallow};
70 122         187 $self->{word} .= $text;
71 122         244 while ( length $self->{word} ) {
72 471         586 my $word;
73 471 100 100     3012 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         33 $word = $1;
78             }
79             elsif ( defined($break_after)
80             and $self->{word} =~ s/^(.*?)($break_after)//s )
81             {
82 361         793 $word = $1 . $2;
83             }
84             elsif ( $self->{NoBuffering} ) {
85 22         40 $word = $self->{word};
86 22         30 $self->{word} = "";
87             }
88             else {
89 72         167 last;
90             }
91              
92 399 50       804 die "assertion failed" unless length($word) >= 1;
93              
94 399         506 my $next_soft_space;
95 399 100 100     1606 if ( defined($swallow) && $word =~ s/($swallow)$//s ) {
96 84         165 $next_soft_space = $1;
97             }
98             else {
99 315         480 $next_soft_space = "";
100             }
101              
102 399         690 my $to_print = $self->{soft_space} . $word;
103 399         708 my $new_pos = _calculate_new_column( $self->{cur}, $to_print );
104              
105 399 100 100     899 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         98 _calculate_new_column( $self->{cur}, $self->{Separator} );
110 47 100       96 if ( $w_sep < $self->{cur} ) {
111              
112             # inserting the separator gives us more room,
113             # so do it
114 46         101 $self->output( $self->{Separator} );
115 46         68 $self->{soft_space} = "";
116 46         60 $self->{cur} = $w_sep;
117 46         92 $self->{word} = $word . $next_soft_space . $self->{word};
118 46         113 next;
119             }
120             }
121              
122 353         810 $self->output($to_print);
123 353         518 $self->{soft_space} = $next_soft_space;
124 353         442 $self->{cur} = $new_pos;
125 353         856 $self->{may_break} = 1;
126             }
127             }
128              
129              
130             sub finish {
131 12     12 1 48 my $self = shift;
132 12         40 $self->flush;
133 12         27 $self->reset;
134             }
135              
136              
137             sub flush {
138 30     30 1 52 my $self = shift;
139              
140 30         58 local $self->{NoBuffering} = 1;
141 30         59 local $self->{Swallow} = undef;
142 30         54 $self->add("");
143             }
144              
145             sub output {
146 399     399 1 580 my $self = shift;
147 399         541 my $to_print = shift;
148              
149 399         522 my $out = $self->{Output};
150 399 50       1151 if ( UNIVERSAL::isa( $out, "GLOB" ) ) {
    50          
151 0         0 print $out $to_print;
152             }
153             elsif ( UNIVERSAL::isa( $out, "SCALAR" ) ) {
154 399         707 $$out .= $to_print;
155             }
156             }
157              
158             sub reset {
159 12     12 0 19 my $self = shift;
160 12         19 $self->{cur} = 0;
161 12         17 $self->{soft_space} = "";
162 12         28 $self->{word} = "";
163             }
164              
165             1;
166              
167             __END__