package Dancer2::Plugin::Menu;
$Dancer2::Plugin::Menu::VERSION = '0.009';
use 5.010; use strict; use warnings;

# ABSTRACT: Automatically generate an HTML menu for your Dancer2 app

use Storable     'dclone';
use Data::Dumper 'Dumper';
use HTML::Element;
use Dancer2::Plugin;
use MooX::HandlesVia;
use Dancer2::Core::Hook;

plugin_keywords qw ( menu_item );

# _tree has nodes generated by menu_item function; used to generate menu items
# _html_cache contains generated HTML for each route
has '_tree'       => ( is => 'rw', default => sub { { '/' => { children => {} } } } );
has '_html_cache' => ( is => 'rw', default => sub { {} }, handles_via => 'Hash',
                       handles => { get_html_cache => 'get', set_html_cache => 'set' } );

# sets up before_template hook to generate HTML from a modified copy of the tree
sub BUILD {
  my $s = shift;

  $s->app->add_hook (Dancer2::Core::Hook->new (
    name => 'before_template',
    code => sub {
      my $tokens = shift;
      my $route  = $tokens->{request}->route->spec_route;

      # send cached html to template if it exists
      if (my $html = $s->get_html_cache($route)) {
        $tokens->{menu} = $html;
        return;
      }

      # set active menu items on a copy of the tree
      my $new_tree = dclone $s->_tree->{'/'};
      my $tree     = $new_tree;
      my @nodes    = split /\//, $route;

      foreach my $node (@nodes[1 .. @nodes-1]) {
        $tree->{children}{$node}{active} = 1;
        $tree = $tree->{children}{$node};
      }

      # generate html, send to template, save to cache
      my $html_elem   = _get_html($new_tree, HTML::Element->new('ul'));
      my $html        = $html_elem->as_HTML('', "\t", {});
      $tokens->{menu} = $html;
      $s->set_html_cache($route, $html);
    }
  ));
}

# Builds tree and associates menu item data with each node in the tree. Called
# once for each route wrapped in the "menu_item" keyword.
sub menu_item {
  my $s        = shift;
  my $mi_data  = shift; # menu item data
  my $route    = shift;
  my $tree     = $s->_tree;
  my @nodes    = split /\//, $route->spec_route;
  $nodes[0]    = '/'; # replace blank node with root node

  # add node for each segment of the path and associate data with it
  while (my $node = shift @nodes) {
    # set menu item data
    my $title            = ucfirst($node);
    my $weight           = 5;
    if (!@nodes) {
      $mi_data->{title}         //= $title;
      $mi_data->{weight}        //= $weight;
    }

    # more nodes after this one so extend tree if next node doesn't already exist
    if (@nodes) {
      if (!$tree->{$node}{children}) {
        $tree->{$node}{children} = {};
      }
    # add mi_data if we are at the end of a path and therefore route
    } elsif (!$tree->{$node}{children}) {
      $tree->{$node}              = $mi_data;
      $tree->{$node}{protected}   = 1;  # don't let new routes clobber node
      next; # we can bail early on iteration and save 2 zillionths of a second
    }

    # add data to a node that is not at end of existing path
    if (!$tree->{$node}{protected}) {
      # if at node at end of route, add mi_data; otherwise defaults are used
      if (!@nodes) {
        ($title, $weight)           = ($mi_data->{title}, $mi_data->{weight});
        $tree->{$node}{protected}   = 1;
      }
      $tree->{$node}{title}       = $title;
      $tree->{$node}{weight}      = $weight;
    }
    $tree = $tree->{$node}{children};
  }
}

# generate HTML menu from tree
sub _get_html {
  my ($tree, $element) = @_;

  # sort sibling menu items by weight and then by name
  foreach my $child (
    sort { ( $tree->{children}{$a}{weight} <=> $tree->{children}{$b}{weight} )
      ||   ( $tree->{children}{$a}{title}  cmp $tree->{children}{$b}{title}  )
         } keys %{$tree->{children}} ) {

    # create menu item list element with classes for css styling
    my $li_this = HTML::Element->new('li');
    $li_this->attr(class => $tree->{children}{$child}{active} ? 'active' : '');

    # add HTML elements for each menu item; recurse if menu item has children
    $li_this->push_content($tree->{children}{$child}{title});
    if ($tree->{children}{$child}{children}) {
      my $ul = HTML::Element->new('ul');
      $li_this->push_content($ul);
      $element->push_content($li_this);
      _get_html($tree->{children}{$child}, $ul)
    } else {
      $element->push_content($li_this);
    }
  }
  return $element;
}

1; # Magic true value

__END__

=pod

=head1 NAME

Dancer2::Plugin::Menu - Automatically generate an HTML menu for your Dancer2 app

=head1 VERSION

version 0.009

=head1 SYNOPSIS

In your app:

  use Dancer2;
  use Dancer2::Plugin::Menu;

  menu_item(
    { title => 'My Parent Item', weight => 3 },
    get 'path' => sub { template },
  );

  menu_item(
    { title => 'My Child1 Item', weight => 3 },
    get 'path/menu1' => sub { template },
  );

  menu_item(
    { title => 'My Child2 Item', weight => 4 },
    get 'path/menu2' => sub { template },
  );

In your template file:

  <% menu %>

This will generate a hierarchical menu that will look like this when the
C<path/menu1> route is visited:

  <ul><li class="active">Path
      <ul><li class="active">My Child1 Item</li>
          <li>My Child2 Item</li>
      </ul>
  </ul>

=head1 DESCRIPTION

This module generates HTML for routes wrapped in the C<menu_item> keyword. Menu
items will be injected into the template wherever the C<E<lt>% menu %E<gt>> tag
is located. Child menu items are wrapped in C<E<lt>liE<gt>> HTML tags which are
themselves wrapped in a C<E<lt>ulE<gt>> tag associated with the parent menu
item. Menu items within the current route are given the C<active> class so they
can be styled.

The module is in early development stages and currently has few options. It has
not been heavily tested and there are likely bugs especially with dynamic paths
which are completely untested at this time. The module should work and be
adequate for simple menu structures, however.

=head2 KEYWORDS

=head3 menu_item( { [title => $str], [weight => $num] }, C<ROUTE METHOD> C<REGEXP>, C<CODE>)

Wraps a conventional route handler preceded by a required hash reference
containing data that will be applied to the route's endpoint.

Two keys can be supplied in the hash reference: a C<title> for the menu item and
a C<weight>. The C<title> will be used as the content for the menu items. The
C<weight> will determine the order of the menu items. Heavier items (with larger
values) will "sink" to the bottom compared to sibling menu items. If two sibling
menu items have the same weight, the menu items will be ordered alphabetically.

Menu items that are not endpoints in the route or that don't have a C<title>,
will automatically generate a title according to the path segment's name. For
example, the route C</categories/fun food/desserts> is converted to a hierarchy
of menu items entitled C<Categories>, C<Fun food>, and C<Desserts>. Note that
capitalization is automatically added.  Automatic titles will be overridden with
endpoint specific titles if they are supplied in a later C<menu_item> call.

If the C<weight> is not supplied it will default to a value of C<5>.

=head1 CONFIGURATION

Add a C<E<lt>% menu %E<gt>> tag in the appropriate location within your Dancer2
template files. If desired, add css for C<E<lt>liE<gt>> tags in the C<active>
class.

=head1 REQUIRES

=over 4

=item * L<Dancer2::Core::Hook|Dancer2::Core::Hook>

=item * L<Dancer2::Plugin|Dancer2::Plugin>

=item * L<Data::Dumper|Data::Dumper>

=item * L<HTML::Element|HTML::Element>

=item * L<MooX::HandlesVia|MooX::HandlesVia>

=item * L<Storable|Storable>

=item * L<strict|strict>

=item * L<warnings|warnings>

=back

=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan

=head1 SUPPORT

=head2 Perldoc

You can find documentation for this module with the perldoc command.

  perldoc Dancer2::Plugin::Menu

=head2 Websites

The following websites have more information about this module, and may be of help to you. As always,
in addition to those websites please use your favorite search engine to discover more resources.

=over 4

=item *

MetaCPAN

A modern, open-source CPAN search engine, useful to view POD in HTML format.

L<https://metacpan.org/release/Dancer2-Plugin-Menu>

=back

=head2 Source Code

The code is open to the world, and available for you to hack on. Please feel free to browse it and play
with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull
from your repository :)

L<https://github.com/sdondley/Dancer2-Plugin-Menu>

  git clone git://github.com/sdondley/Dancer2-Plugin-Menu.git

=head1 BUGS AND LIMITATIONS

You can make new bug reports, and view existing ones, through the
web interface at L<https://github.com/sdondley/Dancer2-Plugin-Menu/issues>.

=head1 INSTALLATION

See perlmodinstall for information and options on installing Perl modules.

=head1 SEE ALSO

L<Dancer2>

=head1 AUTHOR

Steve Dondley <s@dondley.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2018 by Steve Dondley.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
