File Coverage

lib/Mail/AuthenticationResults/Token/Comment.pm

Criterion	Covered	Total	%
statement	36	36	100.0
branch	10	10	100.0
condition			n/a
subroutine	6	6	100.0
pod	2	2	100.0
total	54	54	100.0

package Mail::AuthenticationResults::Token::Comment;
# ABSTRACT: Class for modelling AuthenticationResults Header parts detected as comments

require 5.008;
use strict;
use warnings;
our $VERSION = '2.20210914'; # VERSION
use Carp;

use base 'Mail::AuthenticationResults::Token';


sub is {
    my ( $self ) = @_;
    return 'comment';
}

sub parse {
    my ($self) = @_;

    my $header = $self->{ 'header' };
    my $value = q{};
    my $depth = 0;

    my $first = substr( $header,0,1 );
    if ( $first ne '(' ) {
        croak 'Not a comment';
    }

    while ( length $header > 0 ) {
        my $first = substr( $header,0,1 );
        $header   = substr( $header,1 );
        $value .= $first;
        if ( $first eq '(' ) {
            $depth++;
        }
        elsif ( $first eq ')' ) {
            $depth--;
            last if $depth == 0;
        }
    }

    if ( $depth != 0 ) {
        croak 'Mismatched parens in comment';
    }

    $value =~ s/^\(//;
    $value =~ s/\)$//;

    $self->{ 'value' } = $value;
    $self->{ 'header' } = $header;

    return;
}

1;

__END__