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;