[-feature] Template filters [%|mailto%] and [%|mailtourl%] are introduced.

They use new functions encode_uri() and mailtourl() in Sympa::Tools::Text.


git-svn-id: https://subversion.renater.fr/sympa/branches/sympa-6.2-branch@12699 05aa8bb8-cd2b-0410-b1d7-8918dfa770ce

src/lib/Sympa/ModDef.pm

@@ -369,7 +369,7 @@ our %cpan_modules = (
         'gettext_id'     => 'used to get time with sub-second precision',
     },
     'URI::Escape' => {
-        required_version => '1.35',
+        required_version => '3.28', # Included in URI-1.35.
         package_name     => 'URI-Escape',
         mandatory        => 1,
         'gettext_id' =>

src/lib/Sympa/Template.pm

@@ -171,10 +171,42 @@ sub wrap {
     };
 }
 
+sub _mailto {
+    my ($context, $email, $query, $nodecode) = @_;
+
+    return sub {
+        my $text = shift;
+
+        unless ($text =~ /\S/) {
+            $text =
+                $nodecode ? Sympa::Tools::Text::encode_html($email) : $email;
+        }
+        return sprintf '<a href="%s">%s</a>',
+            Sympa::Tools::Text::encode_html(
+            Sympa::Tools::Text::mailtourl(
+                $email,
+                decode_html => !$nodecode,
+                query       => $query,
+            )
+            ),
+            $text;
+    };
+}
+
+sub _mailtourl {
+    my ($context, $query) = @_;
+
+    return sub {
+        my $text = shift;
+
+        return Sympa::Tools::Text::mailtourl($text, query => $query);
+    };
+}
+
 sub _obfuscate {
     my ($context, $mode) = @_;
 
-    return sub { shift }
+    return sub {shift}
         unless grep { $mode eq $_ } qw(at javascript);
 
     return sub {
@@ -228,6 +260,8 @@ sub parse {
             helploc  => [\&maketext, 1],
             locdt    => [\&locdatetime, 1],
             wrap         => [\&wrap,                           1],
+            mailto       => [\&_mailto,                        1],
+            mailtourl    => [\&_mailtourl,                     1],
             obfuscate    => [\&_obfuscate,                     1],
             optdesc      => [\&optdesc,                        1],
             qencode      => [\&qencode,                        0],
@@ -406,7 +440,8 @@ Escape quotation marks.
 
 =item escape_url
 
-Escape URL.
+Escapes URL.
+See also L<Sympa::Tools::Text/"escape_url">.
 
 =item escape_xml
 
@@ -438,9 +473,62 @@ A string representing date/time:
 
 =back
 
+=item mailto ( email, [ {key = val, ...}, [ nodecode ] ] )
+
+Generates HTML fragment linking to C<mailto:> URL,
+i.e. C<E<lt>a href="mailto:I<email>"E<gt>I<filtered text>E<lt>/aE<gt>>.
+
+=over
+
+=item Filtered text
+
+Content of linking element.
+If it does not contain nonspaces, e-mail address will be used.
+
+=item email
+
+E-mail address(es) to be linked.
+
+=item {key = val, ...}
+
+Optional query.
+
+=item nodecode
+
+If true, assumes arguments are not encoded as HTML entities.
+By default entities are decoded at first.
+
+This option does I<not> affect filtered text.
+
+=back
+
+Note:
+This filter was introduced by Sympa 6.2.14.
+
+=item mailtourl ( [ {key = val, ...} ] )
+
+Generates C<mailto:> URL.
+
+=over
+
+=item Filtered text
+
+E-mail address(es).
+Note that any characters must not be encoded as HTML entities.
+
+=item {key = val, ...}
+
+Optional query.
+Note that any characters must not be encoded as HTML entities.
+
+=back
+
+Note:
+This filter was introduced by Sympa 6.2.14.
+
 =item obfuscate ( mode )
 
-Obfuscates email addresses in the text according to mode.
+Obfuscates email addresses in the HTML text according to mode.
 
 =over
 

src/lib/Sympa/Tools/Text.pm

@@ -32,6 +32,7 @@ use Encode::MIME::Header;    # 'MIME-Q' encoding.
 use HTML::Entities qw();
 use MIME::EncWords;
 use Text::LineFold;
+use URI::Escape qw();
 use if (5.008 < $] && $] < 5.016), qw(Unicode::CaseFold fc);
 use if (5.016 <= $]), qw(feature fc);
 
@@ -158,6 +159,19 @@ sub encode_html {
     HTML::Entities::encode_entities($str, '<>&"');
 }
 
+sub encode_uri {
+    my $str     = shift;
+    my %options = @_;
+
+    # Note: URI-1.35 (URI::Escape 3.28) or later is required.
+    return Encode::encode_utf8(
+        URI::Escape::uri_escape_utf8(
+            Encode::decode_utf8($str),
+            '^-A-Za-z0-9._~' . (exists $options{omit} ? $options{omit} : '')
+        )
+    );
+}
+
 # Old name: tools::escape_chars().
 sub escape_chars {
     my $s          = shift;
@@ -187,6 +201,8 @@ sub escape_chars {
 }
 
 # Old name: tt2::escape_url().
+# Not recommended.  Use Sympa::Tools::Text::escape_uri() or
+# Sympa::Tools::Text::mailtourl().
 sub escape_url {
     my $string = shift;
 
@@ -216,6 +232,67 @@ sub foldcase {
     }
 }
 
+sub mailtourl {
+    my $text    = shift;
+    my %options = @_;
+
+    my $dtext =
+          (not defined $text)   ? ''
+        : $options{decode_html} ? Sympa::Tools::Text::decode_html($text)
+        :                         $text;
+    $dtext =~ s/\A\s+//;
+    $dtext =~ s/\s+\z//;
+    $dtext =~ s/(?:\r\n|\r|\n)(?=[ \t])//g;
+    $dtext =~ s/\r\n|\r|\n/ /g;
+
+    # The ``@'' in email address should not be encoded because some MUAs
+    # aren't able to decode ``%40'' in e-mail address of mailto: URL.
+    # Contrary, ``@'' in query component should be encoded because some
+    # MUAs take it for a delimiter to separate URL from the rest.
+    my ($format, $utext, $qsep);
+    if ($dtext =~ /[()<>\[\]:;,\"\s]/) {
+        # Use "to" header if source text includes any of RFC 5322
+        # "specials", minus ``@'' and ``\'', plus whitespaces.
+        $format = 'mailto:?to=%s%s';
+        $utext  = Sympa::Tools::Text::encode_uri($dtext);
+        $qsep   = '&';
+    } else {
+        $format = 'mailto:%s%s';
+        $utext  = Sympa::Tools::Text::encode_uri($dtext, omit => '@');
+        $qsep   = '?';
+    }
+
+    my $qstring;
+    my $query = $options{query};
+    unless (ref $query eq 'HASH' and %$query) {
+        $qstring = '';
+    } else {
+        $qstring = $qsep . join(
+            '&',
+            map {
+                my ($dkey, $dval) = map {
+                    (not defined $_) ? ''
+                        : $options{decode_html}
+                        ? Sympa::Tools::Text::decode_html($_)
+                        : $_;
+                } ($_, $query->{$_});
+                unless (lc $dkey eq 'body') {
+                    $dval =~ s/\A\s+//;
+                    $dval =~ s/\s+\z//;
+                    $dval =~ s/(?:\r\n|\r|\n)(?=[ \t])//g;
+                    $dval =~ s/\r\n|\r|\n/ /g;
+                }
+
+                sprintf '%s=%s',
+                    Sympa::Tools::Text::encode_uri($dkey),
+                    Sympa::Tools::Text::encode_uri($dval);
+                } sort keys %$query
+        );
+    }
+
+    return sprintf $format, $utext, $qstring;
+}
+
 # Old name: tools::qdecode_filename().
 sub qdecode_filename {
     my $filename = shift;
@@ -438,6 +515,30 @@ two hexdigits.
 
 Note that C<'/'> will also be encoded.
 
+=item encode_uri ( $str, [ omit => $chars ] )
+
+TBD
+
+Parameters:
+
+=over
+
+=item $str
+
+String to be encoded.
+
+=item omit =E<gt> $chars
+
+By default, all characters except those defined as "unreserved" in RFC 3986
+are encoded, that is, C<[^-A-Za-z0-9._~]>.
+If this parameter is given, it will prevent encoding additional characters.
+
+=back
+
+Returns:
+
+Encoded string, stripped C<utf8> flag if any.
+
 =item escape_chars ( $str )
 
 Escape weird characters.
@@ -449,6 +550,10 @@ L</encode_filesystem_safe>.
 
 Escapes string using URL encoding.
 
+Note:
+This is not recommended.
+Would be better to use L</"encode_uri"> or L</"mailtourl">.
+
 =item foldcase ( $str )
 
 I<Function>.
@@ -508,6 +613,7 @@ L<Sympa::Tools::Text> appeared on Sympa 6.2a.41.
 decode_filesystem_safe() and encode_filesystem_safe() were added
 on Sympa 6.2.10.
 
-decode_html() and encode_html() were added on Sympa 6.2.14.
+decode_html(), encode_html(), encode_uri() and mailtourl()
+were added on Sympa 6.2.14.
 
 =cut