projekt kivitendo

  require SL::HTML::Util;

    return $self->$attribute(SL::HTML::Util->strip($value)) if @_ > 1;

    return SL::HTML::Util->strip($self->$attribute);

  require SL::HTML::Restrict;

  my $cleaner = SL::HTML::Restrict->create(%params);

package SL::HTML::Restrict;

use strict;

use warnings;

use HTML::Restrict ();

sub create {

  my ($class, %params)    = @_;

  $params{allowed_tags} //= { map { ($_ => ['/']) } qw(b strong i em u ul ol li sub sup s strike br p div) };

  return HTML::Restrict->new(rules => $params{allowed_tags});

}

1;

__END__

=pod

=encoding utf8

=head1 NAME

SL::HTML::Restrict - Restrict HTML tags to set of allowed tags

=head1 SYNOPSIS

  my $cleaner = SL::HTML::Restrict->create;

  my $cleaned = $cleaner->process($unsafe_html);

=head1

Often you want to allow a fixed set of well-known HTML tags to be used

– but nothing else. This is a thin wrapper providing a default set of

the following elements:

C<b br div em i li ol p s strike strong sub sup u ul>

This list can be overwritten.

=head1 FUNCTIONS

=over 4

=item C<create [%params]>

Creates and returns a new instance of L<HTML::Restrict>. The optional

parameter C<allowed_tags> must be an array reference of allowed tag

names. If it's missing then the default set will be used (see above).

Returns an instance of L<HTML::Restrict>.

=back

=head1 BUGS

Nothing here yet.

=head1 AUTHOR

Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>

=cut

package SL::HTML::Util;

use strict;

use warnings;

use HTML::Parser;

my %stripper;

sub strip {

  my ($class_or_value) = @_;

  my $value = !ref($class_or_value) && (($class_or_value // '') eq 'SL::HTML::Util') ? $_[1] : $class_or_value;

  if (!%stripper) {

    %stripper = ( parser => HTML::Parser->new );

    $stripper{parser}->handler(text => sub { $stripper{text} .= $_[1]; });

  }

  $stripper{text} = '';

  $stripper{parser}->parse($value);

  $stripper{parser}->eof;

  return delete $stripper{text};

}

1;

__END__

=pod

=encoding utf8

=head1 NAME

SL::HTML::Util - Utility functions dealing with HTML

=head1 SYNOPSIS

  my $plain_text = SL::HTML::Util->strip('<h1>Hello World</h1>');

=head1 FUNCTIONS

=over 4

=item C<strip $html_content>

Removes all HTML elements and tags from C<$html_content> and returns

the remaining plain text.

=back

=head1 BUGS

Nothing here yet.

=head1 AUTHOR

Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>

=cut

use SL::HTML::Restrict;

our @EXPORT = qw(html_tag input_tag man_days_tag name_to_id select_tag stringify_attributes restricted_html);

my $html_restricter;

sub restricted_html {

  my ($self, $value) = @_;

  $html_restricter ||= SL::HTML::Restrict->create;

  return $html_restricter->process($value);

}

=item C<restricted_html $html>

Returns HTML stripped of unknown tags. See L<SL::HTML::Restrict>.