Commit 28f61f12 authored by sikeda's avatar sikeda
Browse files

[-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
parent a3a0fdb0
......@@ -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' =>
......
......@@ -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
......
......@@ -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
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment