package Sietima::HeaderURI;
use Moo;
use Sietima::Policy;
use Sietima::Types qw(Address AddressFromStr is_Address);
use Types::Standard qw(Str is_Str ClassName HashRef Optional);
use Type::Params qw(compile);
use Types::URI qw(Uri is_Uri);
use Email::Address;
use namespace::clean;
has uri => (
is => 'ro',
isa => Uri,
required => 1,
coerce => 1,
);
has comment => (
is => 'ro',
isa => Str,
);
sub _args_from_address {
my ($address, $query) = @_;
$query ||= {};
my $uri = URI->new($address->address,'mailto');
$uri->query_form($query->%*);
my $comment = $address->comment;
$comment =~ s{\A\((.*)\)\z}{$1} if $comment;
return {
uri => $uri,
comment => $comment,
};
}
around BUILDARGS => sub {
my ($orig, $class, @args) = @_;
if (@args != 1 or ref($args[0]) eq 'HASH' and $args[0]->{uri}) {
return $class->$orig(@args);
}
my $item = $args[0];
if (is_Address($item)) {
return _args_from_address($item);
}
elsif (is_Uri($item)) {
return { uri => $item };
}
elsif (is_Str($item) and my $address = AddressFromStr->coerce($item)) {
return _args_from_address($address);
}
else {
return { uri => $item };
};
};
sub new_from_address {
state $check = compile(
ClassName,
Address->plus_coercions(AddressFromStr),
Optional[HashRef],
);
my ($class, $address, $query) = $check->(@_);
return $class->new(_args_from_address($address,$query));
}
sub as_header_raw {
my ($self) = @_;
my $str = sprintf '<%s>',$self->uri;
if (my $c = $self->comment) {
$str .= sprintf ' (%s)',$c;
}
return $str;
}
1;