File Coverage

blib/lib/Mojo/DOM58/Entities.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	6	6	100.0
condition	6	6	100.0
subroutine	8	8	100.0
pod	3	3	100.0
total	49	49	100.0

package Mojo::DOM58::Entities;

use strict;
use warnings;
use Exporter 'import';

our $VERSION = '3.000';

our @EXPORT_OK = qw(html_attr_unescape html_escape html_unescape);

# To generate a new HTML entity table run this command
# perl examples/entities.pl
my %ENTITIES;
for my $line (split "\n", join('', )) {
  next unless $line =~ /^(\S+)\s+U\+(\S+)(?:\s+U\+(\S+))?/;
  $ENTITIES{$1} = defined $3 ? (chr(hex $2) . chr(hex $3)) : chr(hex $2);
}
close DATA;

# Characters that should be escaped in HTML/XML
my %ESCAPE = (
  '&'  => '&',
  '<'  => '<',
  '>'  => '>',
  '"'  => '"',
  '\'' => '''
);

# HTML entities
my $ENTITY_RE = qr/&(?:\#((?:[0-9]{1,7}|x[0-9a-fA-F]{1,6}));|(\w+[;=]?))/;

sub html_escape {
  my $str = shift;
  $str =~ s/([&<>"'])/$ESCAPE{$1}/ge;
  return $str;
}

sub html_attr_unescape { _html(shift, 1) }
sub html_unescape      { _html(shift, 0) }

sub _entity {
  my ($point, $name, $attr) = @_;

  # Code point
  return chr($point !~ /^x/ ? $point : hex $point) unless defined $name;

  # Named character reference
  my $rest = my $last = '';
  while (length $name) {
    return $ENTITIES{$name} . reverse $rest
      if exists $ENTITIES{$name}
      && (!$attr || $name =~ /;$/ || $last !~ /[A-Za-z0-9=]/);
    $rest .= $last = chop $name;
  }
  return '&' . reverse $rest;
}

sub _html {
  my ($str, $attr) = @_;
  $str =~ s/$ENTITY_RE/_entity($1, $2, $attr)/geo;
  return $str;
}

1;

=encoding utf8

=head1 NAME

Mojo::DOM58::Entities - Escape or unescape HTML entities in strings

=head1 SYNOPSIS

  use Mojo::DOM58::Entities qw(html_escape html_unescape);

  my $str = 'foo & bar';
  $str = html_unescape $str; # "foo & bar"
  $str = html_escape $str; # "foo & bar"

=head1 DESCRIPTION

L contains functions for escaping and unescaping HTML
entities for L, based on functions from L. All
functions are exported on demand.

=head1 FUNCTIONS

=head2 html_attr_unescape

  my $str = html_attr_unescape $escaped;

Same as L, but handles special rules from the
L for HTML attributes.

  # "foo=bar<est=baz"
  html_attr_unescape 'foo=bar<est=baz';

  # "foo=bar
  html_attr_unescape 'foo=bar<est=baz';

=head2 html_escape

 my $escaped = html_escape $str;

Escape unsafe characters C<&>, C<< < >>, C<< > >>, C<">, and C<'> in string.

 html_escape ''; # "<div>"

=head2 html_unescape

 my $str = html_unescape $escaped;

Unescape all HTML entities in string, according to the
L.

 html_unescape '<div>'; # ""

=head1 BUGS

Report issues related to the format of this distribution or Perl 5.8 support to
the public bugtracker. Any other issues should be reported directly to the
upstream L issue tracker.

=head1 AUTHOR

Dan Book

Code and tests adapted from L, a set of utilities by the
L team.

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2008-2016 Sebastian Riedel and others.

Copyright (c) 2016 Dan Book for adaptation to standalone format.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)

=head1 SEE ALSO

L

=cut

__DATA__