view release on metacpan or  search on metacpan

lib/App/FuguWeb/Check.pm  view on Meta::CPAN

#	The rules read the source directory and not the output, so the
#	answer does not depend on a build having run. A stray key file
#	and a stale digest are faults of the checkout.
sub _check_keys ($self)
{
	my $config = $self->{config};

	return map {
		App::FuguWeb::Keys->new( config => $config, dir => $_ )
		    ->problems
	} $config->keys_dirs;
}

# $self->_check_inventory:
#	Every page and asset exists and is not empty, and the output
#	holds nothing else: no staging directory, no editor backup, no
#	stray source.
sub _check_inventory ($self)
{
	my @problems;

	unless ( -d $self->{out} ) {
		return "$self->{out}: the site is not built";
	}

	my @expected = $self->{config}->inventory;
	for my $name (@expected) {
		my $path = $self->{out} . "/$name";
		push @problems, "$name: missing from the output"
		    unless -e $path;
		push @problems, "$name: empty" if -e $path && !-s $path;
	}

	# The walk reads the whole tree. A site is one flat directory,
	# and the key directory is the one part below it. A walk of one
	# level would take every published key for a stray file.
	my $entries = App::FuguWeb::list_tree( $self->{out} )
	    or return "$self->{out}: cannot read the output directory: $!";

	my %expected = map { $_ => 1 } @expected;
	push @problems, "$_: in the output but not in the site"
	    for grep { !$expected{$_} } @$entries;

	return @problems;
}

# $self->_check_page($page):
#	Everything that one page must be true of.
sub _check_page ( $self, $page )
{
	my $html = Fugu::File->read( $self->{out} . "/$page" ) // '';
	my @problems;

	my ($title) = $html =~ m{<title>([^<]*)</title>};
	push @problems, "$page: has no title"
	    unless defined $title && length $title;

	for my $entry ( $self->{config}->nav ) {
		my $href = $entry->{href};

		# The chrome escapes an attribute on its way out, so the
		# search has to escape it the same way. A page below the
		# root also carries the step back, so the search reads
		# the same form that App::FuguWeb::Page writes.
		my $written = App::FuguWeb::escape_attr($href);
		$written = _base_of($page) . $written
		    unless $href =~ m{\A(?:[A-Za-z][A-Za-z0-9.+-]*:|/|\#)};

		push @problems,
		    "$page: does not carry the navigation" . " entry $href"
		    unless index( $html, qq{href="$written"} ) >= 0;
	}

	push @problems, $self->_check_references( $page, $html );

	return @problems;
}

# $self->_check_references($page, $html):
#	Every href and src of one page.
sub _check_references ( $self, $page, $html )
{
	my @problems;

	for my $ref ( map { _unescape($_) }
		$html =~ m{(?:href|src)="([^"]+)"}g )
	{

		# The host may serve the site from a path below the
		# root, where a leading slash leaves the site entirely.
		if ( $ref =~ m{^/} ) {
			push @problems, "$page: $ref is root-absolute";
			next;
		}
		if ( $ref =~ m{^file:}i ) {
			push @problems, "$page: $ref is a file: URL";
			next;
		}
		if ( $ref =~ m{^https?://} ) {
			$self->{external}{$ref} = 1;
			next;
		}
		next if $ref =~ m{^(?:mailto|news|ftp):}i;

		# A browser reads a relative URL whose first segment
		# holds a colon as a scheme, so a page named
		# Fugu::Daemon.3p.html needs its './'.
		if ( $ref =~ /^[A-Za-z][A-Za-z0-9.+-]*:/ ) {
			push @problems, "$page: $ref reads as a URL scheme;"
			    . ' a local link needs its ./';
			next;
		}

		my ( $path, $fragment ) = split /#/, $ref, 2;
		if ( defined $path && length $path ) {
			$path = _resolve( $page, $path );
			unless ( defined $path ) {
				push @problems,
				    "$page: $ref names no page of the site";
				next;
			}
		}
		else {
			$path = $page;
		}

		unless ( -e $self->{out} . "/$path" ) {
			push @problems, "$page: $ref leads nowhere";
			next;
		}
		next unless defined $fragment && length $fragment;

		my $target = Fugu::File->read( $self->{out} . "/$path" ) // '';
		push @problems, "$page: $ref has no such anchor"
		    unless $target =~ /\bid="\Q$fragment\E"/;
	}

	return @problems;
}

# _base_of($page):
#	The step back from a page to the site root. It is the empty
#	string for a page of the root, and one '../' for each
#	directory below it. App::FuguWeb::Page writes the same step in
#	front of every relative link of the chrome.
sub _base_of ($page)
{
	my $depth = () = $page =~ m{/}g;

	return '../' x $depth;
}

# _resolve($page, $ref):
#	One relative reference of a page, as a path below the output
#	directory. A site is one flat directory, so most references
#	resolve to themselves. The key directory sits below the root,
#	and a reference there is relative to its own page.
sub _resolve ( $page, $ref )
{
	my @parts = split m{/}, $page;
	pop @parts;

	for my $step ( split m{/}, $ref, -1 ) {
		next if $step eq '' || $step eq '.';
		if ( $step eq '..' ) {

			# A step above the site root names no file of
			# the output. A pop of an empty list does
			# nothing, so the reference would clamp to the
			# root and read like a link that resolves.
			return unless @parts;
			pop @parts;
			next;
		}
		push @parts, $step;
	}

	# A reference of './' names the directory of its own page, and
	# a directory is no page of a site. An empty answer also reads
	# as false in the walk of the reachability check. The walk
	# would then stop at the first page that holds one.
	return unless @parts;

	return join '/', @parts;
}

# _unescape($text):
#	Turn the four attribute entities back into their characters. A
#	reference is compared against a file name, and the file holds
#	the character and not the entity.
sub _unescape ($text)
{
	my $plain = $text;
	$plain =~ s/&lt;/</g;
	$plain =~ s/&gt;/>/g;
	$plain =~ s/&quot;/"/g;
	$plain =~ s/&amp;/&/g;

	return $plain;
}

# $self->_check_reachable:
#	Every page is reachable from the entry page. A page that no
#	other page links to declares itself unlinked, as a 404 page
#	does: the host serves that one for an unknown path.
sub _check_reachable ($self)
{
	my $entry = $self->{config}->entry;
	return "$entry: the entry page is missing"
	    unless -f $self->{out} . "/$entry";

	my %seen  = ( $entry => 1 );
	my @queue = ($entry);

	while ( my $page = shift @queue ) {
		next unless $page =~ /\.html$/;

		my $html = Fugu::File->read( $self->{out} . "/$page" ) // '';
		for my $ref ( map { _unescape($_) }
			$html =~ m{(?:href|src)="([^"]+)"}g )
		{
			next if $ref =~ m{^[A-Za-z][A-Za-z0-9.+-]*:};

			my ($path) = split /#/, $ref, 2;
			next unless defined $path && length $path;
			$path = _resolve( $page, $path );
			next unless defined $path;

			next if $seen{$path}++;
			push @queue, $path;
		}
	}

	my %unlinked = map { $_->{file} => 1 }
	    grep { $_->{unlinked} } $self->{config}->pages;

	return map { "$_: no page links to it" }
	    grep { !$seen{$_} && !$unlinked{$_} } $self->pages;
}

1;