File Coverage

blib/lib/HTML/Widgets/NavMenu/ToJSON.pm
Criterion Covered Total %
statement 41 41 100.0
branch 6 8 75.0
condition n/a
subroutine 10 10 100.0
pod 1 1 100.0
total 58 60 96.6


line stmt bran cond sub pod time code
1             package HTML::Widgets::NavMenu::ToJSON;
2             $HTML::Widgets::NavMenu::ToJSON::VERSION = '0.0.8';
3 2     2   112489 use 5.008;
  2         24  
4              
5 2     2   11 use strict;
  2         3  
  2         50  
6 2     2   9 use warnings FATAL => 'all';
  2         5  
  2         64  
7              
8 2     2   9 use Carp;
  2         12  
  2         117  
9              
10 2     2   784 use parent 'HTML::Widgets::NavMenu::Object';
  2         489  
  2         9  
11              
12 2     2   6768 use JSON::MaybeXS 1.002002 ();
  2         13382  
  2         685  
13              
14              
15             __PACKAGE__->mk_acc_ref(
16             [
17             qw(
18             _data_persistence_store
19             _tree_contents
20             ),
21             ]
22             );
23              
24             sub _init
25             {
26 1     1   431 my ($self, $args) = @_;
27              
28             $self->_data_persistence_store(
29 1 50       7 $args->{'data_persistence_store'}
30             ) or Carp::confess("No data_persistence_store specified.");
31              
32             $self->_tree_contents(
33 1 50       4 $args->{'tree_contents'}
34             ) or Carp::confess("No tree_contents specified.");
35              
36 1         2 return;
37             }
38              
39             sub _get_id_for_url
40             {
41 9     9   16 my ($self, $url) = @_;
42 9         20 return $self->_data_persistence_store->get_id_for_url($url);
43             }
44              
45              
46             sub output_as_json
47             {
48 1     1 1 256 my $self = shift;
49              
50 1         3 my $persistence = $self->_data_persistence_store();
51              
52 1         5 $persistence->load;
53              
54 1         2 my $process_sub_tree;
55              
56             $process_sub_tree = sub
57             {
58 10     10   31 my ($sub_tree) = @_;
59              
60 10         13 my @keys = (grep { $_ ne 'subs' } keys %{$sub_tree});
  31         53  
  10         20  
61              
62 10         16 my $has_subs = exists($sub_tree->{subs});
63              
64             return
65             {
66             (exists($sub_tree->{url})
67             ? (id => $self->_get_id_for_url($sub_tree->{url}), )
68             : ()
69             ),
70 28         82 (map { $_ => $sub_tree->{$_} } @keys),
71             $has_subs
72 9         16 ? (subs => [ map { $process_sub_tree->($_) }
73 9         16 grep { ! exists($_->{separator}) }
74 10 100       20 @{$sub_tree->{subs}}
  3 100       5  
75             ])
76             : (),
77             };
78 1         5 };
79              
80             my $ret = JSON::MaybeXS->new(utf8 => 1, canonical => 1)->encode(
81 1         7 $process_sub_tree->($self->_tree_contents)->{'subs'}
82             );
83              
84 1         10 $persistence->save;
85              
86 1         4 return $ret;
87             }
88              
89              
90             1; # End of HTML::Widgets::NavMenu::ToJSON
91              
92             __END__