diff options
Diffstat (limited to 'lib/Sietima/HeaderURI.pm')
-rw-r--r-- | lib/Sietima/HeaderURI.pm | 83 |
1 files changed, 83 insertions, 0 deletions
diff --git a/lib/Sietima/HeaderURI.pm b/lib/Sietima/HeaderURI.pm new file mode 100644 index 0000000..d9c1bb0 --- /dev/null +++ b/lib/Sietima/HeaderURI.pm @@ -0,0 +1,83 @@ +package Sietima::HeaderURI; +use Moo; +use Sietima::Policy; +use Sietima::Types qw(Address AddressFromStr is_Address); +use Types::Standard qw(Str ClassName HashRef Optional); +use Type::Params qw(compile); +use Types::URI qw(Uri is_Uri); +use namespace::clean; + +has uri => ( + is => 'ro', + isa => Uri, + required => 1, + coerce => 1, +); + +has comment => ( + is => 'ro', + isa => Str, +); + +# if it's not an Email::Address obect, we'll just take it as a string: +# it could be a non-mailto URI, see RFC 2369 "The Use of URLs as +# Meta-Syntax for Core Mail List Commands and their Transport through +# Message Header Fields" + +around BUILDARGS => sub { + my ($orig, $class, @args) = @_; + if (@args != 1 or ref($args[0]) eq 'HASH') { + return $class->$orig(@args); + } + + my $item = $args[0]; + if (is_Address($item)) { + return Sietima::HeaderURI->_args_from_address($item); + } + elsif (is_Uri($item)) { + return { uri => $item }; + } + elsif (my $address = AddressFromStr->coerce($item)) { + return Sietima::HeaderURI->_args_from_address($address); + } + else { + return { uri => $item }; + }; +}; + +sub _args_from_address { + my ($class, $address, $query) = @_; + $query ||= {}; + + my $uri = URI->new($address->address,'mailto'); + $uri->query_form($query->%*); + + return { + uri => $uri, + comment => $address->comment, + }; +} + +sub new_from_address { + state $check = compile( + ClassName, + Address->plus_coercions(AddressFromStr), + Optional[HashRef], + ); + my ($class, $address, $query) = $check->(@_); + + return $class->new($class->_args_from_address($address,$query)); +} + +sub as_header_raw { + my ($self) = @_; + + my $str = sprintf '<%s>',$self->uri; + if (my $c = $self->comment) { + $str .= ' '.$c; + } + + return $str; +} + +1; |