view release on metacpan or  search on metacpan

t/fuguweb/index.t  view on Meta::CPAN

subtest 'a project path with a glob metacharacter still finds them' => sub {
	# Perl's glob splits on whitespace and reads [ ] { } ? ~, so a
	# reader that globbed would lose these manuals or collect a
	# sibling directory's.
	my $parent = tempdir( CLEANUP => 1 );

	for my $awkward ( 'a b', 'c[d]', 'e{f}', 'g?h', '~i' ) {
		my $root = build_root( $RC, "$parent/$awkward" );

		my $config = App::FuguWeb::Config->load( root => $root,
			error => \my $reason );
		ok( $config, "a root named '$awkward' loads" ) or next;

		my ($tool) = grep { $_->heading eq 'Tool' } $config->groups;
		is( scalar $tool->manuals, 3, 'and still finds its manuals' );
	}
};

subtest 'a modules group sorts by path and holds the umbrella' => sub {
	my ( $config, $reason ) = load($RC);
	ok( $config, 'the description loads' ) or diag $reason;

	my ($thing) = grep { $_->kind eq 'modules' } $config->groups;

	# A dot sorts before a slash, so the umbrella comes first and
	# Store.pod stays before Store/Memory.pod.
	is_deeply(
		[ map { $_->name } $thing->manuals ],
		[ 'Thing', 'Thing::Store', 'Thing::Store::Memory' ],
		'the sidecars come in path order'
	);
};

subtest 'the body lists every group and every manual' => sub {
	my ( $config, $reason ) = load($RC);
	ok( $config, 'the description loads' ) or diag $reason;

	my $body = App::FuguWeb::Index->new( config => $config )->body;

	like( $body, qr{^<h1>Manuals</h1>\n}, 'the title of the page block' );
	like( $body, qr{<a href="https://man\.openbsd\.org/">},
		'the opening names the manual host' );

	like( $body, qr{<h2 id="tool">Tool</h2>\n<dl>\n},
		'a heading carries the anchor' );
	my $entry = qq{<dt><a href="./tool.1.html">tool(1)</a></dt>\n}
	    . "<dd>the tool</dd>\n";
	like( $body, qr/\Q$entry\E/,
		'an entry carries the page, the name and the description' );
	like( $body, qr{</dl>\n\n}, 'a blank line closes a group' );

	# A browser reads a relative URL whose first segment holds a
	# colon as a scheme, so every local link keeps its './'.
	my @hrefs = $body =~ m{href="([^"]+)"}g;
	my @bad =
	    grep { /^[A-Za-z][A-Za-z0-9.+-]*:/ && !m{^https?:} } @hrefs;
	is( scalar @bad, 0, 'no link reads as a URL scheme' )
	    or diag "offenders: @bad";
};

subtest 'a page name reaches the href escaped' => sub {
	my $root = build_root($RC);

	# A quote in a manual name would end the attribute early and
	# everything after it would become markup.
	open my $fh, '>', "$root/man/tool/od\"d.1"
	    or plan skip_all => 'this filesystem takes no quote in a name';
	print {$fh} ".Sh NAME\n.Nd a quoted name\n";
	close $fh;

	my $config =
	    App::FuguWeb::Config->load( root => $root, error => \my $reason );
	ok( $config, 'the description loads' ) or diag $reason;

	my $body = App::FuguWeb::Index->new( config => $config )->body;
	like( $body, qr/href="\.\/od&quot;d\.1\.html"/,
		'the quote is escaped in the attribute' );
	unlike( $body, qr/href="\.\/od"d/, 'and the attribute is not broken' );
};

subtest 'a description is escaped' => sub {
	my $root = build_root($RC);
	open my $fh, '>', "$root/man/tool/tool.1"
	    or die "Cannot rewrite the source: $!";
	print {$fh} ".Sh NAME\n.Nd a & b < c\n";
	close $fh;

	my $config =
	    App::FuguWeb::Config->load( root => $root, error => \my $reason );
	ok( $config, 'the description loads' ) or diag $reason;

	my $body = App::FuguWeb::Index->new( config => $config )->body;
	like( $body, qr{<dd>a &amp; b &lt; c</dd>}, 'the entities' );
};

subtest 'an empty group leaves no heading behind' => sub {
	my ( $config, $reason ) = load( <<'RC' );
site = Example

page "manuals.html" {
	title = Manuals
	index = yes
}

manuals "Empty" {
	dir    = web
	anchor = empty
}
RC
	ok( $config, 'the description loads' ) or diag $reason;

	my $body = App::FuguWeb::Index->new( config => $config )->body;
	unlike( $body, qr/Empty/, 'no heading and no list' );
	like( $body, qr/<h1>Manuals<\/h1>/,
		'the opening still has the title' );
};

subtest 'two manuals may not become the same page' => sub {
	# Two sources that render to one name overwrite each other in
	# the staging directory and in the output, and the index then
	# shows two entries that lead to one page.
	my $root = build_root( <<'RC' );
site = Example

manuals "One" {
	dir    = man/tool
	anchor = one
}

manuals "Two" {
	dir    = man/copy
	anchor = two
}
RC
	make_path("$root/man/copy");
	open my $fh, '>', "$root/man/copy/tool.1"
	    or die "Cannot write the second source: $!";
	print {$fh} ".Sh NAME\n.Nd the other tool\n";
	close $fh;

	my $config =