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

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

use Dancer2::Plugin;
use Dancer2::Core::Hook;
use Data::Dumper qw(Dumper);
use Storable qw (dclone);
use HTML::Element;
use List::Util 'first';

plugin_keywords qw ( menu_item );

has 'tree'       => ( is => 'rw', default => sub { { '/' => { children => {} } } } );
has 'html'       => ( is => 'rw', predicate => 1,);
has 'clean_tree' => ( is => 'rw', predicate => 1,);

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;
      if (!$s->has_clean_tree) {
        $s->clean_tree(dclone $s->tree);
      } else {
        $s->tree(dclone $s->clean_tree);
      }
      my @segments = split /\//, $route->spec_route;
      shift @segments;

      # set active
      my $tree = $s->tree->{'/'};
      foreach my $segment (@segments) {
        $tree->{children}{$segment}{active} = 1;
        $tree = $tree->{children}{$segment};
      }

      # generate html
      $s->html( HTML::Element->new('ul') );
      _get_menu($s->tree->{'/'}, $s->html);
      $tokens->{menu} = $s->html->as_HTML('', "\t", {});
    }
  ));
}

sub menu_item {
  my ($s, $xt_data, $route) = @_;
  my @segments = split /\//, $route->spec_route;
  my $tree = $s->tree;
  $segments[0] = '/';
  while (my $segment = shift @segments) {
    if ($s->tree->{$segment}) {
      if (!@segments) {
        if ($xt_data) {
          $tree->{$segment} = $xt_data;
        } else {
          $tree->{$segment}{title} = ucfirst($segment);
        }
      }
      $tree = $tree->{$segment}{children};
    } else {
      if (!$tree->{$segment}{children}) {
        $tree->{$segment}{children} = {};
        if (!@segments) {
          if ($xt_data) {
            $tree->{$segment} = $xt_data;
          } else {
            $tree->{$segment}{title} = ucfirst($segment);
          }
        } else {
          $tree->{$segment}{title} = ucfirst($segment) if !$tree->{$segment}{title};
        }
      }
      $tree = $tree->{$segment}{children};
    }
  }
}

sub _get_menu {
  my ($tree, $element) = @_;

  foreach my $child ( sort { ($tree->{children}{$a}{weight} || 5) <=> ($tree->{children}{$b}{weight} || 5)
                      || $tree->{children}{$a}{title} cmp $tree->{children}{$b}{title} } keys %{$tree->{children}} ) {

    my $li_this = HTML::Element->new('li');

    # set classes for breadcrumbs and css styling
    $li_this->attr(class => $tree->{children}{$child}{active} ? 'active' : '');

    # recurse
    if ($tree->{children}{$child}{children}) {
      $li_this->push_content($tree->{children}{$child}{title});
      my $ul      = HTML::Element->new('ul');
      $li_this->push_content($ul);
      $element->push_content($li_this);
      _get_menu($tree->{children}{$child}, $ul)
    } else {
      $li_this->push_content($tree->{children}{$child}{title});
      $element->push_content($li_this);
    }
  }
  return $element;
}


1; # Magic true value
# ABSTRACT: this is what the module does

__END__

=pod

=head1 NAME

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

=head1 VERSION

version 0.002

=head1 KEYWORDS

=head2 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 weight. The title will be used as the content for the menu items. The weight
will determine the order of the menu items. Heavier items (with larger values)
will "sink" to the bottom compared to sibling menu items sharing the same level
within the hierarchy. 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 are not supplied with a
title, will have a title automatically generated according to their segment
name. For example, this route:

  /categories/fun food/desserts

Will be converted to a hierachy of menu items entitled C<Categories>, C<Fun
food>, and C<Desserts>. Note that captialization is automatically added.
Automatic titles will be overridden with endpoint specific titles if they are
supplied later in the app.

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

=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<List::Util|List::Util>

=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 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
