view release on metacpan or  search on metacpan

xt/39-html-escaper.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;
use FindBin;
use File::Spec::Functions qw(catdir catfile updir);
use File::Find;
use Test::More;

# The HTML escaper for SNMP-sourced values in DataTables render callbacks
# is DataTable.util.escapeHtml, from the DataTables bundle already loaded
# on every page. he.js was removed because it duplicated that job at a
# cost of 26,948 gzipped bytes per page load. he.encode threw a
# TypeError on any input it could not coerce to a string, where the
# DataTables escaper instead joins an array with commas before
# escaping it, and passes any other non-string, non-array value
# through untouched.
#
# CONSTRAINT for future call sites: DataTable.util.escapeHtml escapes
# < > & " but NOT the single quote, where he.encode did. Every current
# insertion point is HTML text content, so this is safe today, but an
# escaped value placed inside a single-quoted HTML attribute would be
# unsafe. Do not put escaped values in single-quoted attributes.
#
# SCOPE: this guard checks for the specific library and call site
# removed here, by name (he.js, he.encode). It is not a general
# "only DataTable.util.escapeHtml is permitted" guard. A differently
# named duplicate escaper vendored later, for example html-entities.js
# exposing entities.encode(), would defeat every assertion below and
# would not be caught by this test.

my $root  = catdir( $FindBin::Bin, updir() );
my $share = catdir( $root, 'share' );

# Walk the tree in Perl rather than shelling out to grep, so a failed
# or unrun search cannot silently read as an empty, passing result.
# File::Find::find only *warns* on a directory it cannot descend into
# (permission denied, gone mid-walk, and so on): the walk continues
# past it as if it were never there, files inside it are never visited,
# and without this trap that reads as a clean, passing, empty result.
# Trapping the warnings and asserting there were none turns a silently
# skipped subtree into a hard test failure instead.
my @he_calls;
my @walk_errors;
{
    local $SIG{__WARN__} = sub { push @walk_errors, @_ };
    find(
        {
            wanted => sub {
                return unless -f $_;
                open my $fh, '<:raw', $_
                    or die "cannot read $File::Find::name: $!";
                local $/;
                my $content = <$fh>;
                push @he_calls, $File::Find::name
                    if $content =~ /he\.encode/;
            },
            no_chdir => 1,
        },
        $share
    );
}
is( scalar @walk_errors, 0, 'the walk read every directory under share/' )
    or diag "walk problems: @walk_errors";

is( scalar @he_calls, 0, 'no he.encode call sites remain under share/' )
    or diag "found in: @he_calls";

ok( ! -e catfile( $root, qw(share public javascripts he.js) ),
    'he.js is not shipped' );