File Coverage

lib/Mail/DMARC/Report/URI.pm

Criterion	Covered	Total	%
statement	36	40	90.0
branch	16	22	72.7
condition	4	6	66.6
subroutine	7	7	100.0
pod	0	3	0.0
total	63	78	80.7

package Mail::DMARC::Report::URI;
use strict;
use warnings;

our $VERSION = '1.20210927';

use Carp;
use URI;

sub new {
    my $class = shift;
    return bless {}, $class;
}

sub parse {
    my $self = shift;
    my $str = shift or croak "URI string is required!";

    my @valids = ();
    foreach my $raw ( split /,/, $str ) {
#       warn "raw: $raw\n";
        my ( $u, $size_f ) = split /!/, $raw;
        my $bytes = $self->get_size_limit($size_f);
        my $uri = URI->new($u) or do {
            carp "can't parse URI from $u";
            next;
        };
        my $scheme = $uri->scheme or next;
        if ( $scheme eq 'mailto' && lc substr( $u, 0, 7 ) eq 'mailto:' ) {
            push @valids, { max_bytes => $bytes, uri => $uri };
            next;
        }
        if ( $scheme =~ /^http(s)?/x && lc substr( $u, 0, 4 ) eq 'http' ) {
            push @valids, { max_bytes => $bytes, uri => $uri };
            next;
        }

#       print "invalid URI scheme: $scheme in $u\n";
 # 12.1 Discovery - URI schemes found in "rua" tag that are not implemented by
 #                  a Mail Receiver MUST be ignored.
    }
    return \@valids;
}

sub get_size_limit {
    my ( $self, $size ) = @_;
    return 0 if !defined $size;          # no limit
    return $size if $size =~ /^\d+$/;    # no units, raw byte count

# 6.3 Formal Definition
# units are considered to be powers of two; a kilobyte is 2^10, a megabyte is 2^20,
    my $unit = lc chop $size;
    return $size * ( 2**10 ) if 'k' eq $unit;
    return $size * ( 2**20 ) if 'm' eq $unit;
    return $size * ( 2**30 ) if 'g' eq $unit;
    return $size * ( 2**40 ) if 't' eq $unit;
    croak "unrecognized unit ($unit) in size ($size)";
}

1;

__END__