File Coverage

blib/lib/Mail/DKIM/MessageParser.pm
Criterion Covered Total %
statement 56 65 86.1
branch 16 20 80.0
condition n/a
subroutine 8 14 57.1
pod 0 8 0.0
total 80 107 74.7


line stmt bran cond sub pod time code
1             package Mail::DKIM::MessageParser;
2 14     14   120 use strict;
  14         28  
  14         406  
3 14     14   66 use warnings;
  14         23  
  14         557  
4             our $VERSION = '1.20230630'; # VERSION
5             # ABSTRACT: Signs/verifies Internet mail with DKIM/DomainKey signatures
6              
7             # Copyright 2005 Messiah College. All rights reserved.
8             # Jason Long
9              
10             # Copyright (c) 2004 Anthony D. Urso. All rights reserved.
11             # This program is free software; you can redistribute it and/or
12             # modify it under the same terms as Perl itself.
13              
14 14     14   75 use Carp;
  14         27  
  14         9787  
15              
16             sub new_object {
17 1238     1238 0 2933 my $class = shift;
18 1238         2595 return $class->TIEHANDLE(@_);
19             }
20              
21             sub new_handle {
22 0     0 0 0 my $class = shift;
23 0         0 local *TMP;
24 0         0 tie *TMP, $class, @_;
25 0         0 return *TMP;
26             }
27              
28             sub TIEHANDLE {
29 1238     1238   1801 my $class = shift;
30 1238         3628 my %args = @_;
31 1238         2447 my $self = bless \%args, $class;
32 1238         3611 $self->init;
33 1236         5493 return $self;
34             }
35              
36             sub init {
37 1238     1238 0 1809 my $self = shift;
38              
39 1238         1835 my $buf = '';
40 1238         2261 $self->{buf_ref} = \$buf;
41 1238         2690 $self->{in_header} = 1;
42             }
43              
44             sub PRINT {
45 293     293   21887 my $self = shift;
46 293         565 my $buf_ref = $self->{buf_ref};
47 293 50       1784 $$buf_ref .= @_ == 1 ? $_[0] : join( '', @_ ) if @_;
    50          
48              
49 293 50       727 if ( $self->{in_header} ) {
50 293         1005 local $1; # avoid polluting a global $1
51 293         719 while ( $$buf_ref ne '' ) {
52 3674 100       8189 if ( substr( $$buf_ref, 0, 2 ) eq "\015\012" ) {
53 288         523 substr( $$buf_ref, 0, 2 ) = '';
54 288         868 $self->finish_header();
55 288         580 $self->{in_header} = 0;
56 288         946 last;
57             }
58 3386 100       14310 if ( $$buf_ref !~ /^(.+?\015\012)[^\ \t]/s ) {
59 4         18 last;
60             }
61 3382         8194 my $header = $1;
62 3382         9034 $self->add_header($header);
63 3382         9905 substr( $$buf_ref, 0, length($header) ) = '';
64             }
65             }
66              
67 293 100       700 if ( !$self->{in_header} ) {
68 288         632 my $j = rindex( $$buf_ref, "\015\012" );
69 288 100       608 if ( $j >= 0 ) {
70              
71             # avoid copying a large buffer: the unterminated
72             # last line is typically short compared to the rest
73              
74 287         647 my $carry = substr( $$buf_ref, $j + 2 );
75 287         589 substr( $$buf_ref, $j + 2 ) = ''; # shrink to last CRLF
76 287         1052 $self->add_body($$buf_ref); # must end on CRLF
77 287         591 $$buf_ref = $carry; # restore unterminated last line
78             }
79             }
80 293         728 return 1;
81             }
82              
83             sub CLOSE {
84 293     293   1142 my $self = shift;
85 293         496 my $buf_ref = $self->{buf_ref};
86              
87 293 100       682 if ( $self->{in_header} ) {
88 5 100       24 if ( $$buf_ref ne '' ) {
89              
90             # A line of header text ending CRLF would not have been
91             # processed yet since before we couldn't tell if it was
92             # the complete header. Now that we're in CLOSE, we can
93             # finish the header...
94 4         20 $$buf_ref =~ s/\015\012\z//s;
95 4         25 $self->add_header("$$buf_ref\015\012");
96             }
97 5         33 $self->finish_header;
98 5         18 $self->{in_header} = 0;
99             }
100             else {
101 288 50       688 if ( $$buf_ref ne '' ) {
102 0         0 $self->add_body($$buf_ref);
103             }
104             }
105 293         528 $$buf_ref = '';
106 293         920 $self->finish_body;
107 293         698 return 1;
108             }
109              
110             sub add_header {
111 0     0 0   die 'add_header not implemented';
112             }
113              
114             sub finish_header {
115 0     0 0   die 'finish_header not implemented';
116             }
117              
118             sub add_body {
119 0     0 0   die 'add_body not implemented';
120             }
121              
122       0 0   sub finish_body {
123              
124             # do nothing by default
125             }
126              
127             sub reset {
128 0     0 0   carp 'reset not implemented';
129             }
130              
131             1;
132              
133             __END__