view release on metacpan or  search on metacpan

t/10-atom.t  view on Meta::CPAN

#!perl
use 5.010;
use strict;
use warnings;
use Test::More;
use POSIX ();
use Punk ();
use Punk::Plugin::Feed ();

our @ROWS;
our %OPTS;
my $N = 0;

# An application with one feed returning @main::ROWS, compiled and built.
sub app {
    my ($rows, %opts) = @_;
    local @ROWS = @$rows;
    local %OPTS = (title => 'Example', %opts);
    my $pkg = 'FeedAtom' . ++$N;
    my $extra = delete $OPTS{_extra} || '';
    eval "package $pkg;\nuse Punk;\nuse Punk::Plugin::Feed;\n"
       . "host 'https://example.com';\n"
       . "plugin 'Feed' => { \%main::OPTS };\n"
       . "feed sub { \@main::ROWS };\n"
       . "$extra\n1" or die $@;
    $pkg->to_app;
    return $pkg->punk_app;
}

sub atom { Punk::Plugin::Feed::_doc($_[0], $_[1], 'atom') }

my @ONE = ({ loc => '/p/1', title => 'First', updated => '2019-03-04T05:06:07Z' });

# ---- the document's frame --------------------------------------------------

{
    my $d = atom(app(\@ONE));

    is(index($d, '<?xml version="1.0" encoding="UTF-8"?>'), 0,
        'the prolog is the very first bytes - a BOM or a leading newline '
      . 'makes the document invalid');
    like($d, qr{<feed xmlns="http://www\.w3\.org/2005/Atom">},
        'the Atom namespace');
    like($d, qr{</feed>\s*\z}, 'and it closes');

    # everything Atom makes mandatory, at the feed level
    like($d, qr{<id>https://example\.com/feed\.xml</id>}, 'a feed id');
    like($d, qr{<title>Example</title>},                  'a feed title');
    like($d, qr{<updated>2019-03-04T05:06:07Z</updated>}, 'a feed updated');

    like($d, qr{<link rel="self" type="application/atom\+xml" href="https://example\.com/feed\.xml"/>},
        'a self link, naming the format it is');
    like($d, qr{<link rel="alternate" type="text/html" href="https://example\.com/"/>},
        'an alternate link to the site');
    like($d, qr{<generator uri="[^"]+" version="[^"]+">Punk::Feed</generator>},
        'a generator');

    # and at the entry level
    like($d, qr{<entry>.*<id>https://example\.com/p/1</id>.*</entry>}s,
        'an entry id, defaulting to the absolute URL');
    like($d, qr{<title>First</title>},                    'an entry title');
    like($d, qr{<entry>.*<updated>2019-03-04T05:06:07Z</updated>.*</entry>}s,
        'an entry updated');
}

# ---- the feed date is the newest entry's, never now -----------------------

{
    my $d = atom(app([
        { loc => '/old', title => 'o', updated => '2018-01-01T00:00:00Z' },
        { loc => '/new', title => 'n', updated => '2019-03-04T05:06:07Z' },
    ]));
    my ($feed_updated) = $d =~ m{<updated>([^<]+)</updated>};
    is($feed_updated, '2019-03-04T05:06:07Z',
        'the feed updated is the newest entry, not the build time');

    my $now_year = POSIX::strftime('%Y', gmtime);
    isnt(substr($feed_updated, 0, 4), $now_year,
        "  and demonstrably not now (this year is $now_year)");
}

# A rebuild that found nothing new must produce the same bytes, or every reader
# records a change on every TTL.
{
    my $a = atom(app(\@ONE));
    my $b = atom(app(\@ONE));
    is($a, $b, 'two builds of the same entries are byte-identical');
    is(Punk::Plugin::Feed::_etag(app(\@ONE), undef, 'atom'),
       Punk::Plugin::Feed::_etag(app(\@ONE), undef, 'atom'),
       '  and so are their ETags');
}

{
    my $x = Punk::Plugin::Feed::_etag(app(\@ONE), undef, 'atom');
    my $y = Punk::Plugin::Feed::_etag(
        app([ { loc => '/p/1', title => 'Changed',
                updated => '2019-03-04T05:06:07Z' } ]), undef, 'atom');
    isnt($x, $y, 'a changed entry changes the ETag');
    like($x, qr/\A"[0-9a-f]+-[0-9a-f]{8}"\z/, 'the ETag is a quoted strong tag');
}