view release on metacpan or  search on metacpan

t/cookbook_examples.t  view on Meta::CPAN

ok(
    !(grep { $_->{class} eq 'Contacts::Typed::View::HTML::Badge' } @{$typed->factory_calls}),
    'preconstructed typed child bypasses the view factory',
);

sub read_file {
    my ($path) = @_;
    open my $fh, '<', $path or die "Cannot read $path: $!";
    local $/;
    my $content = <$fh>;
    close $fh or die "Cannot close $path: $!";
    return $content;
}

sub malformed_labeled_verbatim_lines {
    my ($pod) = @_;
    my @lines = split /\n/, $pod, -1;
    my @malformed;

    for my $index (0 .. $#lines) {
        next unless $lines[$index] =~ /^B<(?:Fragment:|Complete scratch file:)/;
        push @malformed, $index + 1
            unless ($lines[$index + 1] // '') eq ''
                && ($lines[$index + 2] // '') =~ /^  \S/;
    }

    return \@malformed;
}

sub pod_html {
    my ($pod) = @_;
    my $html = '';
    my $parser = Pod::Simple::HTML->new;
    $parser->output_string(\$html);
    $parser->parse_string_document($pod);
    return $html;
}

sub write_fixture {
    my ($root, $identifier, $content) = @_;
    my @parts = split m{/}, "$identifier.epl";
    my $path = File::Spec->catfile($root, @parts);
    my (undef, $directory) = File::Spec->splitpath($path);

    make_path($directory);
    open my $fh, '>', $path or die "Cannot write $path: $!";
    print {$fh} $content;
    close $fh or die "Cannot close $path: $!";

    return $path;
}

my $dist_ini = read_file(File::Spec->catfile($root, 'dist.ini'));
like(
    $dist_ini,
    qr/^\[MetaNoIndex\]\ndirectory = examples$/m,
    'distribution metadata excludes shipped examples from PAUSE indexing',
);

SKIP: {
    my $built_meta_path = $ENV{TEMPLATE_EMBEDDED_PERL_BUILT_META};
    skip 'built META.json path was not provided', 2 unless defined $built_meta_path;

    ok(-f $built_meta_path, 'built META.json exists');
    skip 'built META.json is unavailable', 1 unless -f $built_meta_path;
    my $built_meta = decode_json(read_file($built_meta_path));
    is_deeply(
        $built_meta->{no_index},
        {directory => ['examples']},
        'built metadata excludes the examples directory from indexing',
    );
}

my $typed_app_path = File::Spec->catfile(
    $typed_root, qw(lib Contacts Typed App.pm),
);
my $typed_app_source = read_file($typed_app_path);
unlike(
    $typed_app_source,
    qr/preamble\s*=>\s*['"]use v5\.40;/,
    'typed Contacts application does not require Perl 5.40 for templates',
);

my $typed_contact_list_path = File::Spec->catfile(
    $typed_root, qw(templates html contact_list.epl),
);
my $typed_contact_list = read_file($typed_contact_list_path);
unlike(
    $typed_contact_list,
    qr/sub\s*\(\s*\$page\s*\)/,
    'typed wrapper callback avoids version-specific signature syntax',
);
like(
    $typed_contact_list,
    qr/%\s+my\s+\(\$page\)\s*=\s*\@_;/,
    'typed wrapper callback unpacks its wrapper argument portably',
);
like(
    $typed_contact_list,
    qr/display_heading\s+\$page->title/,
    'typed wrapper callback uses its wrapper argument without changing output',
);

my $tutorial_path = File::Spec->catfile(
    $root, qw(lib Template EmbeddedPerl Tutorial.pod),
);
ok(-e $tutorial_path, 'installed tutorial POD exists');

my $tutorial = -e $tutorial_path ? read_file($tutorial_path) : '';
is_deeply(
    malformed_labeled_verbatim_lines($tutorial),
    [],
    "$tutorial_path separates labeled examples from verbatim blocks",
);
like(
    pod_html($tutorial),
    qr{<p><b>Fragment: application fixture</b></p>\s*<pre>\s*sub contacts \{},
    'rendered tutorial separates the fragment label from its code block',
);
for my $heading (
    'FIRST TEMPLATE',