kivitendo/SL/Presenter/Text.pm @ dd9732d8
| 4f15b8f0 | Moritz Bunkus | package SL::Presenter::Text;
|
||
use strict;
|
||||
| 0e5e3501 | Sven Schöling | use SL::Presenter::EscapedText qw(escape);
|
||
| a30abed7 | Moritz Bunkus | use SL::HTML::Restrict;
|
||
| 0d12df6d | Moritz Bunkus | use SL::HTML::Util;
|
||
| 4f15b8f0 | Moritz Bunkus | |||
use Exporter qw(import);
|
||||
| a30abed7 | Moritz Bunkus | our @EXPORT_OK = qw(format_man_days simple_format truncate restricted_html);
|
||
| 0e5e3501 | Sven Schöling | our %EXPORT_TAGS = (ALL => \@EXPORT_OK);
|
||
| 4f15b8f0 | Moritz Bunkus | |||
use Carp;
|
||||
| a30abed7 | Moritz Bunkus | my $html_cleaner;
|
||
| 4f15b8f0 | Moritz Bunkus | sub truncate {
|
||
| 0e5e3501 | Sven Schöling | my ($text, %params) = @_;
|
||
| 4f15b8f0 | Moritz Bunkus | |||
| 0e5e3501 | Sven Schöling | escape(Common::truncate($text, %params));
|
||
| 4f15b8f0 | Moritz Bunkus | }
|
||
sub simple_format {
|
||||
| 0e5e3501 | Sven Schöling | my ($text, %params) = @_;
|
||
| 4f15b8f0 | Moritz Bunkus | |||
$text = $::locale->quote_special_chars('HTML', $text || '');
|
||||
$text =~ s{\r\n?}{\n}g; # \r\n and \r -> \n
|
||||
$text =~ s{\n\n+}{</p>\n\n<p>}g; # 2+ newline -> paragraph
|
||||
$text =~ s{([^\n]\n)(?=[^\n])}{$1<br />}g; # 1 newline -> br
|
||||
return '<p>' . $text;
|
||||
}
|
||||
| ffae956c | Moritz Bunkus | sub format_man_days {
|
||
| 0e5e3501 | Sven Schöling | my ($value, %params) = @_;
|
||
| ffae956c | Moritz Bunkus | |||
return '---' if $params{skip_zero} && !$value;
|
||||
| 0e5e3501 | Sven Schöling | return escape($::locale->text('#1 h', $::form->format_amount(\%::myconfig, $value, 2))) if 8.0 > $value;
|
||
| ffae956c | Moritz Bunkus | |||
$value /= 8.0;
|
||||
my $output = $::locale->text('#1 MD', int($value));
|
||||
my $rest = ($value - int($value)) * 8.0;
|
||||
$output .= ' ' . $::locale->text('#1 h', $::form->format_amount(\%::myconfig, $rest)) if $rest > 0.0;
|
||||
| 0e5e3501 | Sven Schöling | escape($output);
|
||
| ffae956c | Moritz Bunkus | }
|
||
| a30abed7 | Moritz Bunkus | sub restricted_html {
|
||
my ($value) = @_;
|
||||
$html_cleaner //= SL::HTML::Restrict->create;
|
||||
return $html_cleaner->process($value);
|
||||
}
|
||||
| 0d12df6d | Moritz Bunkus | sub stripped_html {
|
||
my ($value) = @_;
|
||||
return SL::HTML::Util::strip($value);
|
||||
}
|
||||
| 4f15b8f0 | Moritz Bunkus | 1;
|
||
__END__
|
||||
=pod
|
||||
=encoding utf8
|
||||
=head1 NAME
|
||||
SL::Presenter::Text - Presenter module for assorted text helpers
|
||||
=head1 SYNOPSIS
|
||||
| d0785135 | Sven Schöling | use SL::Presenter::Text qw(truncate);
|
||
| 4f15b8f0 | Moritz Bunkus | my $long_text = "This is very, very long. Need shorter, surely.";
|
||
| d0785135 | Sven Schöling | my $truncated = truncate($long_text, at => 10);
|
||
| 4f15b8f0 | Moritz Bunkus | # Result: "This is..."
|
||
=head1 FUNCTIONS
|
||||
=over 4
|
||||
| ffae956c | Moritz Bunkus | =item C<format_man_days $value, [%params]>
|
||
C<$value> is interpreted to mean a number of hours (for C<$value> < 8)
|
||||
/ man days (if >= 8). Returns a translated, human-readable version of
|
||||
it, e.g. C<2 PT 2 h> for the value C<18> and German.
|
||||
If the parameter C<skip_zero> is trueish then C<---> is returned
|
||||
instead of the normal formatting if C<$value> equals 0.
|
||||
| 6794ddd4 | Moritz Bunkus | =item C<truncate $text, %params>
|
||
| 4f15b8f0 | Moritz Bunkus | |||
Returns the C<$text> truncated after a certain number of
|
||||
| 6794ddd4 | Moritz Bunkus | characters. See L<Common/truncate> for the actual implementation and
|
||
supported parameters.
|
||||
| 4f15b8f0 | Moritz Bunkus | |||
=item C<simple_format $text>
|
||||
Applies simple formatting rules to C<$text>: The text is put into
|
||||
paragraph HTML tags. Two consecutive newlines are interpreted as a
|
||||
paragraph change: they close the current paragraph tag and start a new
|
||||
one. Single newlines are converted to line breaks. Carriage returns
|
||||
are removed.
|
||||
| a30abed7 | Moritz Bunkus | =item C<restricted_html $unsafe_html>
|
||
Returns HTML code stripped from unwanted/unsupported content. This is
|
||||
done via the module L<SL::HTML::Restrict>.
|
||||
| 0d12df6d | Moritz Bunkus | =item C<stripped_html $html>
|
||
Returns the raw text with all HTML tags and comments stripped. This is
|
||||
done via L<SL::HTML::Util/strip>.
|
||||
| 4f15b8f0 | Moritz Bunkus | =back
|
||
=head1 BUGS
|
||||
Nothing here yet.
|
||||
=head1 AUTHOR
|
||||
Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
|
||||
=cut
|