view release on metacpan or  search on metacpan

lib/App/DocKnot/Spin/Sitemap.pm  view on Meta::CPAN

            my $indent = length($1);
            while (@indents && $indents[-1]->[0] > $indent) {
                pop(@indents);
            }
            if (@indents) {
                $indents[-1]->[2] = undef;
            }
            next;
        }

        # Regular line.  Parse it.
        my ($spaces, $url, $desc)
          = $line =~ m{ \A ([ ]*) /([^\s:]*): \s+ (.+) \z}xms;
        if (!defined($desc)) {
            die "invalid line $. in $path\n";
        }

        # Error on duplicate lines.
        if ($seen{$url}) {
            die "duplicate entry for /$url in $path (line $.)\n";
        }
        $seen{$url} = 1;

        # Open or close indentation levels.
        my $indent = length($spaces);
        if (!@indents || $indent > $indents[-1]->[0]) {
            my $prev = @indents ? $indents[-1]->[2] : undef;
            push(@indents, [$indent, $prev, undef]);
        } else {
            while ($indents[-1]->[0] > $indent) {
                pop(@indents);
            }
        }

        # Store this page information in the object.
        $self->{pagedesc}{$url} = $desc;
        push($self->{sitemap}->@*, [$indent, $url, $desc]);

        # Create the links.  Gather all of the parent links to create the
        # links for this page, set this as the next URL of the previous URL if
        # any, and indicate that this page should be the previous page for the
        # next page on the same level.
        my @parents = map { $_->[1] } @indents;
        shift(@parents);
        $self->{links}{$url} = [$indents[-1]->[2], undef, reverse(@parents)];
        if (defined($indents[-1]->[2])) {
            $self->{links}{ $indents[-1]->[2] }[1] = $url;
        }
        $indents[-1]->[2] = $url;
    }
    close($fh);
    return;
}

##############################################################################
# Utility methods
##############################################################################

# Escape a page description so that it can be put in HTML output.
#
# $desc    - The string to escape
# $is_attr - If true, escape for putting in an HTML attribute
#
# Returns: $desc escaped so that it's safe to interpolate into an attribute
sub _escape {
    my ($desc, $is_attr) = @_;
    $desc =~ s{ & }{&}xmsg;
    $desc =~ s{ < }{&lt;}xmsg;
    $desc =~ s{ > }{&gt;}xmsg;
    if ($is_attr) {
        $desc =~ s{ \" }{&quot;}xmsg;
    }
    return $desc;
}

# Given the partial URL (relative to the top of the site) to the current page
# and the partial URL to another page, generate a URL to the second page
# relative to the first.
#
# $origin - The current page
# $dest   - A partial URL of another page
#
# Returns: A relative link from $origin to $dest
sub _relative {
    my ($origin, $dest) = @_;
    my @origin = split(qr{ / }xms, $origin, -1);
    my @dest = split(qr{ / }xms, $dest, -1);

    # Remove the common prefix.
    while (@origin && @dest && $origin[0] eq $dest[0]) {
        shift(@origin);
        shift(@dest);
    }

    # If there are the same number of components in both links, the link
    # should be relative to the current directory.  Otherwise, ascend to the
    # common prefix and then descend to the dest link.
    if (@origin == 1 && @dest <= 1) {
        return (@dest && length($dest[0])) > 0 ? $dest[0] : q{./};
    } else {
        return ('../' x $#origin) . join(q{/}, @dest);
    }
}

# Return the link data for a given page.
#
# $path - Path to the output, relative to the top of the web site
#
# Returns: List of links, each of which is a tuple of the relative URL and
#          the description (escaped for safe interpolation as an attribute).
#          The relative URL and description may be undef if missing.
sub _page_links {
    my ($self, $path) = @_;
    my $key;
    if ($path->basename() eq 'index.html') {
        $key = $path->parent() . q{/};
    } else {
        $key = "$path";
    }

    # If the page is not present in the sitemap, return nothing.  There are
    # also no meaningful links to generate for the top page.
    return () if ($key eq q{/} || !$self->{links}{$key});

    # Convert all the links to relative and add the page descriptions.
    return
      map { defined ? [_relative($path, $_), $self->{pagedesc}{$_}] : undef }
      $self->{links}{$key}->@*;
}

##############################################################################
# Public interface
##############################################################################

# Parse a .versions file into a new App::DocKnot::Spin::Sitemap object.
#
# $path - Path to the .sitemap file
#
# Returns: Newly created object
#  Throws: Text exception on failure to parse the file
#          autodie exception on failure to read the file
sub new {
    my ($class, $path) = @_;

    # Create an empty object.
    #
    # sitemap is an array of anonymous arrays holding the complete site map.
    # Each element represents a page.  The element will contain three
    # elements: the numeric indent level, the partial output URL, and the
    # description.
    #
    # pagedesc maps partial URLs to page descriptions used for links to that
    # page.
    #
    # links maps partial URLs to a list of other partial URLs (previous, next,
    # and then the full upwards hierarchy to the top of the site) used for
    # interpage links.
    my $self = {
        links    => {},
        pagedesc => {},
        sitemap  => [],
    };
    bless($self, $class);

    # Parse the file into the newly-created object.
    $self->_read_data(path($path));

    # Return the populated object.
    return $self;
}

# Return the <link> tags for a given output file, suitable for its <head>
# section.
#
# $path - Path to the output file relative to the top of the output tree
#
# Returns: List of lines to add to the <head> section
sub links {
    my ($self, $path) = @_;
    my @links = $self->_page_links(path($path));
    return () if !@links;

    # We only care about the first parent, not the rest of the chain to the
    # top of the site.  Add the names of the link types.
    my @types = qw(previous next up);
    @links = @links[0 .. 2];
    @links = pairwise { defined($b) ? [$a, $b->@*] : undef } @types, @links;

    # Generate the HTML for those links.
    my @output;
    for my $link (@links) {
        next unless defined($link);
        my ($type, $url, $desc) = $link->@*;
        $desc = _escape($desc, 1);

        # Break the line if it would be longer than 79 characters.
        my $line = qq{  <link rel="$type" href="$url"};
        if (length($line) + length($desc) + 12 > 79) {
            push(@output, $line . "\n");
            $line = (q{ } x 8) . qq{title="$desc"};
        } else {
            $line .= qq{ title="$desc"};
        }
        push(@output, $line . " />\n");
    }

    # Add the link to the top-level page.
    my $url = _relative($path, q{});
    push(@output, qq{  <link rel="top" href="$url" />\n});

    # Return the results.
    return @output;
}

# Return the navigation bar for a given output file.
#
# $path - Path to the output file relative to the top of the output tree
#
# Returns: List of lines that create the navbar
sub navbar {
    my ($self, $path) = @_;
    my ($prev, $next, @parents) = $self->_page_links(path($path));
    return () if !@parents;

    # Construct the left and right links (previous and next).
    my $prev_link = q{  <td class="navleft">};
    if (defined($prev)) {
        my ($url, $desc) = $prev->@*;
        $desc = _escape($desc);
        $prev_link .= qq{&lt;&nbsp;<a href="$url">$desc</a>};
    }
    $prev_link .= "</td>\n";
    my $next_link = q{  <td class="navright">};
    if (defined($next)) {
        my ($url, $desc) = $next->@*;
        $desc = _escape($desc);
        $next_link .= qq{<a href="$url">$desc</a>&nbsp;&gt;};
    }
    $next_link .= "</td>\n";

    # Construct the bread crumbs for the page hierarchy.
    my @breadcrumbs = ("  <td>\n");
    my $first = 1;
    for my $parent (reverse(@parents)) {
        my ($url, $desc) = $parent->@*;
        my $prefix = q{ } x 4;
        if ($first) {
            $first = 0;
        } else {
            $prefix .= '&gt; ';
        }
        push(@breadcrumbs, $prefix . qq{<a href="$url">$desc</a>\n});
    }
    push(@breadcrumbs, "  </td>\n");

    # Generate the HTML for the navbar.
    return (
        qq{<table class="navbar"><tr>\n},
        $prev_link,
        @breadcrumbs,
        $next_link,
        "</tr></table>\n",
    );
}

# Return the sitemap formatted as HTML.  The resulting HTML will only be valid
# from a page at the top of the output tree due to the relative links.
#
# Returns: List of lines presenting the sitemap in HTML
sub sitemap {
    my ($self) = @_;
    my @output;
    my @indents = (0);

    # Build the sitemap as nested unordered lists.
    for my $page ($self->{sitemap}->@*) {
        my ($indent, $url, $desc) = $page->@*;

        # Skip the top page.
        next if $indent == 0;

        # Open or close <ul> elements as needed by the indentation.
        if ($indent > $indents[-1]) {
            push(@output, (q{ } x $indent) . "<ul>\n");
            push(@indents, $indent);
        } else {
            while ($indent < $indents[-1]) {
                push(@output, (q{ } x $indents[-1]) . "</ul>\n");
                pop(@indents);
            }
        }

        # Add the <li> for this page.
        my $spaces = q{ } x $indent;
        push(@output, $spaces . qq(<li><a href="$url">$desc</a></li>\n));
    }