diff options
Diffstat (limited to 'lib/Sietima/HeaderURI.pm')
| -rw-r--r-- | lib/Sietima/HeaderURI.pm | 198 |
1 files changed, 111 insertions, 87 deletions
diff --git a/lib/Sietima/HeaderURI.pm b/lib/Sietima/HeaderURI.pm index 347ca77..323b075 100644 --- a/lib/Sietima/HeaderURI.pm +++ b/lib/Sietima/HeaderURI.pm @@ -8,9 +8,103 @@ use Types::URI qw(Uri is_Uri); use Email::Address; use namespace::clean; -# VERSION +our $VERSION = '1.0.5'; # VERSION # ABSTRACT: annotated URI for list headers + +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; + # 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 { + 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; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::HeaderURI - annotated URI for list headers + +=head1 VERSION + +version 1.0.5 + =head1 SYNOPSIS around list_addresses => sub($orig,$self) { @@ -39,35 +133,21 @@ render itself as a string that can be used in a list management header All attributes are read-only. -=attr C<uri> +=head2 C<uri> Required L<< C<URI> >> object, coercible from a string or a hashref (see L<< C<Types::Uri> >> 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<comment> +=head2 C<comment> Optional string, will be added to the list management header as a comment (in parentheses). -=cut - -has comment => ( - is => 'ro', - isa => Str, -); +=head1 METHODS -=method C<new> +=head2 C<new> Sietima::HeaderURI->new({ uri => 'http://foo/', comment => 'a thing', @@ -97,50 +177,7 @@ either a L<< C<Email::Address> >> or a L<< C<URI> >>. Email addresse became C<mailto:> URIs, and the optional comment is preserved. -=for Pod::Coverage BUILDARGS - -=cut - -sub _args_from_address { - my ($address, $query) = @_; - $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 { - 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 }; - }; -}; - -=method C<new_from_address> +=head2 C<new_from_address> Sietima::HeaderURI->new_from_address( $email_address, @@ -156,20 +193,7 @@ you provide. It's a shortcut for: Common query keys are C<subject> and C<body>. See RFC 6068 ("The 'mailto' URI Scheme") for details. -=cut - -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)); -} - -=method C<as_header_raw> +=head2 C<as_header_raw> $mail->header_raw_set('List-Thing' => $headeruri->as_header_raw); @@ -194,17 +218,17 @@ Notice that, since the list management headers are I<structured>, they should always be set with L<< C<header_raw_set>|Email::Simple::Header/header_raw_set >>. -=cut +=for Pod::Coverage BUILDARGS -sub as_header_raw { - my ($self) = @_; +=head1 AUTHOR - my $str = sprintf '<%s>',$self->uri; - if (my $c = $self->comment) { - $str .= sprintf ' (%s)',$c; - } +Gianni Ceccarelli <dakkar@thenautilus.net> - return $str; -} +=head1 COPYRIGHT AND LICENSE -1; +This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut |