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 -sigs; use Types::URI qw(Uri is_Uri); use Email::Address; use namespace::clean; # VERSION # ABSTRACT: annotated URI for list headers =head1 SYNOPSIS around list_addresses => sub($orig,$self) { return +{ $self->$orig->%*, one => Sietima::HeaderURI->new({ uri => 'http://foo/', comment => 'a thing', }), two => Sietima::HeaderURI->new_from_address( $self->owner, { subject => 'Hello' }, ), three => Sietima::HeaderURI->new('http://some/url'), four => Sietima::HeaderURI->new('(comment) address@example.com'), }; } =head1 DESCRIPTION This class pairs a L<< C >> with a comment, and knows how to render itself as a string that can be used in a list management header (see L<< C >>). =head1 ATTRIBUTES All attributes are read-only. =attr C Required L<< C >> object, coercible from a string or a hashref (see L<< C >> for the details). This is the URI that users should follow to perform the action implied by the list management header. =cut has uri => ( is => 'ro', isa => Uri, required => 1, coerce => 1, ); =attr C Optional string, will be added to the list management header as a comment (in parentheses). =cut has comment => ( is => 'ro', isa => Str, ); =method C Sietima::HeaderURI->new({ uri => 'http://foo/', comment => 'a thing', }); Sietima::HeaderURI->new( Email::Address->parse('(comment) address@example.com'), ); Sietima::HeaderURI->new( '(comment) address@example.com' ); Sietima::HeaderURI->new( URI->new('http://some/url'), ); Sietima::HeaderURI->new( 'http://some/url' ); Objects of this class can be constructed in several ways. You can pass a hashref with URI (or something that L<< C >> can coerce into a URI) and a comment string, as in the first example. Or you can pass a single value that can be (or can be coerced into) either a L<< C >> or a L<< C >>. Email addresse became C URIs, and the optional comment is preserved. =for Pod::Coverage BUILDARGS =cut sub _args_from_address($address, $query={}) { my $uri = URI->new($address->address,'mailto'); $uri->query_form($query->%*); my $comment = $address->comment; # Email::Address::comment always returns a string in paretheses, # but we don't want that, since we add them back in as_header_raw $comment =~ s{\A$(.*)$\z}{$1} if $comment; return { uri => $uri, comment => $comment, }; } around BUILDARGS => sub($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 }; }; }; =method C Sietima::HeaderURI->new_from_address( $email_address, \%query, ); This constructor builds a complex C URI with the query hash you provide. It's a shortcut for: my $uri = URI->new("mailto:$email_address"); $uri->query_form(\%query); Common query keys are C and C. See RFC 6068 ("The 'mailto' URI Scheme") for details. =cut signature_for new_from_address => ( method => Str, positional => [ Address->plus_coercions(AddressFromStr), Optional[HashRef], ], ); sub new_from_address($class, $address, $query={}) { return $class->new(_args_from_address($address,$query)); } =method C $mail->header_raw_set('List-Thing' => $headeruri->as_header_raw); This method returns a string representation of the L and L in the format specified by RFC 2369 ("The Use of URLs as Meta-Syntax for Core Mail List Commands and their Transport through Message Header Fields"). For example: Sietima::HeaderURI->new({ uri => 'http://foo/', comment => 'a thing', })->as_header_raw eq ' (a thing)'; Sietima::HeaderURI->new( '(comment) address@example.com' ) ->as_header_raw eq ' (comment)'; Sietima::HeaderURI->new( 'http://some/url' ) ->as_header_raw eq ''; Notice that, since the list management headers are I, they should always be set with L<< C|Email::Simple::Header/header_raw_set >>. =cut sub as_header_raw($self) { my $str = sprintf '<%s>',$self->uri; if (my $c = $self->comment) { $str .= sprintf ' (%s)',$c; } return $str; } 1;