File Coverage

lib/Mail/AuthenticationResults/Token/String.pm
Criterion Covered Total %
statement 41 41 100.0
branch 21 26 80.7
condition 18 30 60.0
subroutine 6 6 100.0
pod 2 2 100.0
total 88 105 83.8


line stmt bran cond sub pod time code
1             package Mail::AuthenticationResults::Token::String;
2             # ABSTRACT: Class for modelling AuthenticationResults Header parts detected as strings
3              
4             require 5.008;
5 29     29   546 use strict;
  29         53  
  29         812  
6 29     29   134 use warnings;
  29         50  
  29         1117  
7             our $VERSION = '2.20210915'; # VERSION
8 29     29   175 use Carp;
  29         51  
  29         1920  
9              
10 29     29   176 use base 'Mail::AuthenticationResults::Token';
  29         52  
  29         11194  
11              
12              
13             sub is {
14 4043     4043 1 5488 my ( $self ) = @_;
15 4043         8670 return 'string';
16             }
17              
18             sub parse {
19 613     613 1 895 my ($self) = @_;
20              
21 613         888 my $header = $self->{ 'header' };
22 613         785 my $value = q{};
23              
24 613 100       1251 croak 'Not a string' if $header =~ /^"/;
25 612 100       1090 croak 'Not a string' if $header =~ /^\(/;
26              
27             # Parse differently if we are post assignment (we are a value) or not (we are likely a key or key part)
28 611         788 my $is_value = 0;
29 611         696 my $is_first = 0;
30 611 100       1045 if ( exists ( $self->{ 'args' }->{ 'last_non_comment_type' } ) ) {
31 552 100       1035 if ( $self->{ 'args' }->{ 'last_non_comment_type' }->is() eq 'assignment' ) {
32 303 100       747 if ( $self->{ 'args' }->{ 'last_non_comment_type' }->value() eq '=' ) {
33 226         378 $is_value = 1;
34             }
35             }
36             }
37             else {
38 59         101 $is_first = 1;
39             }
40              
41 611         1310 while ( length $header > 0 ) {
42 4966         6685 my $first = substr( $header,0,1 );
43 4966 100       8311 last if $first =~ /\s/;
44 4772 100       7151 last if $first eq ';';
45 4679 0 33     7257 last if $first eq '"' && ! $is_value && ! $is_first;
      33        
46 4679 0 33     7329 last if $first eq '(' && ! $is_value && ! $is_first;
      33        
47 4679 100 100     7807 last if $first eq '=' && ! $is_value && ! $is_first;
      66        
48 4459 50 66     6951 last if $first eq '/' && ! $is_value && ! $is_first;
      33        
49 4459 100 100     7700 last if $first eq '.' && ! $is_value && ! $is_first;
      100        
50              
51 4389         5273 $value .= $first;
52 4389         8439 $header = substr( $header,1 );
53             }
54              
55 611 100       1125 croak 'Not a string' if $value eq q{};
56              
57 606         1079 $self->{ 'value' } = $value;
58 606         801 $self->{ 'header' } = $header;
59              
60 606         1083 return;
61             }
62              
63             1;
64              
65             __END__