File Coverage

blib/lib/Web/PerlDistSite/MenuItem.pm
Criterion Covered Total %
statement 18 114 15.7
branch 0 38 0.0
condition 0 22 0.0
subroutine 6 18 33.3
pod 0 7 0.0
total 24 199 12.0


line stmt bran cond sub pod time code
1             package Web::PerlDistSite::MenuItem;
2: use utf8;
3:
4: our $VERSION = '0.001010';
5:
6: use Moo;
7: use Web::PerlDistSite::Common -lexical, -all;
8:
9: use HTML::HTML5::Writer;
10: use HTML::HTML5::Sanity;
11: use XML::LibXML::PrettyPrint;
12:
13: has project => (
14: is => 'rw',
15: isa => Object,
16: weak_ref => true,
17: trigger => sub ( $self, $new_val, $old_val=undef ) {
18: $_->project( $new_val ) for $self->children->@*;
19: },
20: );
21:
22: has name => (
23: is => 'ro',
24: isa => Str,
25: required => true,
26: );
27:
28: has title => (
29: is => 'ro',
30: isa => Str,
31: required => true,
32: );
33:
34: has href => (
35: is => 'lazy',
36: isa => Str,
37: builder => true,
38: );
39:
40: has rel => (
41: is => 'ro',
42: isa => Str,
43: default => 'related',
44: );
45:
46: has target => (
47: is => 'ro',
48: isa => Str,
49: default => '_self',
50: );
51:
52: has icon => (
53: is => 'ro',
54: isa => Str,
55: );
56:
57: has children => (
58: is => 'rw',
59: isa => ArrayRef->of(
60: InstanceOf
61: ->of( 'Web::PerlDistSite::MenuItem' )
62: ->plus_constructors( HashRef, 'from_hashref' )
63: ),
64: coerce => true,
65: default => sub { [] },
66: );
67:
68: sub from_hashref ( $class, $hashref ) {
69:
70: if ( exists $hashref->{divider} ) {
71: $class .= '::Divider';
72: }
73: elsif ( exists $hashref->{pod} ) {
74: $class .= '::Pod';
75: }
76: elsif ( exists $hashref->{source} and $hashref->{source} =~ /.pod/ ) {
77: $class .= '::PodFile';
78: }
79: elsif ( exists $hashref->{source} and $hashref->{source} =~ /.md/ ) {
80: $class .= '::MarkdownFile';
81: }
82: elsif ( exists $hashref->{source} and $hashref->{source} =~ /.html/ ) {
83: $class .= '::HTMLFile';
84: }
85:
86: return Module::Runtime::use_module( $class )->new( $hashref );
87: }
88:
89: sub system_path ( $self ) {
90: path( $self->project->dist_dir )->child( $self->name . '.html' )
91: }
92:
93: sub write_page ( $self ) {
94: return $self;
95: }
96:
97: sub write_pages ( $self ) {
98: $self->write_page;
99: $_->write_pages for $self->children->@*;
100: }
101:
102: sub _build_href ( $self ) {
103: if ( $self->name ) {
104: if ( $self->name eq 'github' ) {
105: return $self->project->github;
106: }
107: if ( $self->name eq 'metacpan' ) {
108: return 'https://metacpan.org/dist/' . $self->project->name;
109: }
110: if ( $self->name eq 'issues' ) {
111: return $self->project->issues // ( $self->project->github . '/issues' );
112: }
113: }
114: return $self->project->root_url . $self->name . '.html';
115: }
116:
117: sub _make_safe_class ( $self, $classname ) {
118: ( $classname = lc( $classname ) )
119: =~ s{\W+}{-}g;
120: return $classname;
121: }
122:
123: sub _compile_dom ( $self, $dom ) {
124: my $body = $dom->getElementsByTagName( 'body' )->shift;
125: $body->setAttribute(
126: 'class',
127: join(
128: ' ',
129: grep { defined($_) && length($_) }
130: $body->getAttribute( 'class' ),
131: $self->_make_safe_class( 'pagetype-' . ref($self) ),
132: $self->_make_safe_class( 'page-' . $self->name ),
133: ),
134: );
135:
136: state $p = do {
137: my $pp = XML::LibXML::PrettyPrint->new;
138: push $pp->{element}{preserves_whitespace}->@*, sub ( $node ) {
139: return undef unless $node->can( 'tagName' );
140: return 1 if $node->tagName eq 'code' and $node->parentNode->tagName eq 'pre';
141: return undef;
142: };
143: unshift $pp->{element}{inline}->@*, sub ( $node ) {
144: return undef unless $node->can( 'tagName' );
145: return 1 if $node->tagName eq 'pre' and $node->getElementsByTagName( 'code' )->size;
146: return undef;
147: };
148: unshift $pp->{element}{compact}->@*, 'a';
149: $pp;
150: };
151: state $w = HTML::HTML5::Writer->new( markup => 'xhtml', polyglot => true );
152: my $sane = fix_document( $dom );
153: $p->pretty_print( $sane );
154: return $w->document( $sane );
155: }
156:
157: sub nav_item ( $self, $active_item ) {
158: my $icon = $self->icon // '';
159: if ( length $icon ) {
160: $icon .= ' ';
161: }
162:
163: if ( $self->children->@* ) {
164: my @items = map $_->dropdown_item( $active_item ), $self->children->@*;
165: return sprintf(
166: '<li class="nav-item dropdown"><a class="nav-link dropdown-toggle" href="#" role="button" data-bs-toggle="dropdown" aria-expanded="false">%s%s</a><ul class="dropdown-menu">%s</ul></li>',
167: $icon,
168: esc_html( $self->title ),
169: join( q{}, @items ),
170: );
171: }
172: elsif ( $self == $active_item ) {
173: return sprintf(
174: '<li class="nav-item"><a class="nav-link active" rel="%s" target="%s" href="%s">%s%s</a></li>',
175: esc_html( $self->rel ),
176: esc_html( $self->target ),
177: esc_html( $self->href ),
178: $icon,
179: esc_html( $self->title ),
180: );
181: }
182: else {
183: return sprintf(
184: '<li class="nav-item"><a class="nav-link" rel="%s" target="%s" href="%s">%s%s</a></li>',
185: esc_html( $self->rel ),
186: esc_html( $self->target ),
187: esc_html( $self->href ),
188: $icon,
189: esc_html( $self->title ),
190: );
191: }
192: }
193:
194: sub dropdown_item ( $self, $active_item ) {
195: my $icon = $self->icon // '';
196: if ( length $icon ) {
197: $icon .= ' ';
198: }
199:
200: if ( $self == $active_item ) {
201: return sprintf(
202: '<li><a class="dropdown-item active" rel="%s" target="%s" href="%s">%s%s</a></li>',
203: esc_html( $self->rel ),
204: esc_html( $self->target ),
205: esc_html( $self->href ),
206: $icon,
207: esc_html( $self->title ),
208: );
209: }
210: else {
211: return sprintf(
212: '<li><a class="dropdown-item" rel="%s" target="%s" href="%s">%s%s</a></li>',
213: esc_html( $self->rel ),
214: esc_html( $self->target ),
215: esc_html( $self->href ),
216: $icon,
217: esc_html( $self->title ),
218: );
219: }
220: }
221:
222: sub page_title ( $self ) {
223: return sprintf( '%s — %s', $self->project->name, $self->title );
224: }
225:
226: 1;
227: