File Coverage

blib/lib/Web/PerlDistSite/MenuItem.pm
Criterion Covered Total %
statement 18 122 14.7
branch 0 40 0.0
condition 0 24 0.0
subroutine 6 19 31.5
pod 0 7 0.0
total 24 212 11.3


line stmt bran cond sub pod time code
1             package Web::PerlDistSite::MenuItem;
2: use utf8;
3:
4: our $VERSION = '0.001011';
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: has meta => (
69: init_arg => undef,
70: is => 'lazy',
71: isa => ArrayRef->of( HashRef ),
72: builder => true,
73: );
74:
75: has _meta_merge => (
76: init_arg => 'meta',
77: is => 'ro',
78: isa => ArrayRef->of( HashRef ),
79: );
80:
81: sub from_hashref ( $class, $hashref ) {
82:
83: if ( exists $hashref->{divider} ) {
84: $class .= '::Divider';
85: }
86: elsif ( exists $hashref->{pod} ) {
87: $class .= '::Pod';
88: }
89: elsif ( exists $hashref->{source} and $hashref->{source} =~ /.pod/ ) {
90: $class .= '::PodFile';
91: }
92: elsif ( exists $hashref->{source} and $hashref->{source} =~ /.md/ ) {
93: $class .= '::MarkdownFile';
94: }
95: elsif ( exists $hashref->{source} and $hashref->{source} =~ /.html/ ) {
96: $class .= '::HTMLFile';
97: }
98:
99: return Module::Runtime::use_module( $class )->new( $hashref );
100: }
101:
102: sub system_path ( $self ) {
103: path( $self->project->dist_dir )->child( $self->name . '.html' )
104: }
105:
106: sub write_page ( $self ) {
107: return $self;
108: }
109:
110: sub write_pages ( $self ) {
111: $self->write_page;
112: $_->write_pages for $self->children->@*;
113: }
114:
115: sub _build_href ( $self ) {
116: if ( $self->name ) {
117: if ( $self->name eq 'github' ) {
118: return $self->project->github;
119: }
120: if ( $self->name eq 'metacpan' ) {
121: return 'https://metacpan.org/dist/' . $self->project->name;
122: }
123: if ( $self->name eq 'issues' ) {
124: return $self->project->issues // ( $self->project->github . '/issues' );
125: }
126: }
127: return $self->project->root_url . $self->name . '.html';
128: }
129:
130: sub _make_safe_class ( $self, $classname ) {
131: ( $classname = lc( $classname ) )
132: =~ s{\W+}{-}g;
133: return $classname;
134: }
135:
136: sub _compile_dom ( $self, $dom ) {
137: my $body = $dom->getElementsByTagName( 'body' )->shift;
138: $body->setAttribute(
139: 'class',
140: join(
141: ' ',
142: grep { defined($_) && length($_) }
143: $body->getAttribute( 'class' ),
144: $self->_make_safe_class( 'pagetype-' . ref($self) ),
145: $self->_make_safe_class( 'page-' . $self->name ),
146: ),
147: );
148:
149: state $p = do {
150: my $pp = XML::LibXML::PrettyPrint->new;
151: push $pp->{element}{preserves_whitespace}->@*, sub ( $node ) {
152: return undef unless $node->can( 'tagName' );
153: return 1 if $node->tagName eq 'code' and $node->parentNode->tagName eq 'pre';
154: return undef;
155: };
156: unshift $pp->{element}{inline}->@*, sub ( $node ) {
157: return undef unless $node->can( 'tagName' );
158: return 1 if $node->tagName eq 'pre' and $node->getElementsByTagName( 'code' )->size;
159: return undef;
160: };
161: unshift $pp->{element}{compact}->@*, 'a';
162: $pp;
163: };
164: state $w = HTML::HTML5::Writer->new( markup => 'xhtml', polyglot => true );
165: my $sane = fix_document( $dom );
166: $p->pretty_print( $sane );
167: return $w->document( $sane );
168: }
169:
170: sub nav_item ( $self, $active_item ) {
171: my $icon = $self->icon // '';
172: if ( length $icon ) {
173: $icon .= ' ';
174: }
175:
176: if ( $self->children->@* ) {
177: my @items = map $_->dropdown_item( $active_item ), $self->children->@*;
178: return sprintf(
179: '<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>',
180: $icon,
181: esc_html( $self->title ),
182: join( q{}, @items ),
183: );
184: }
185: elsif ( $self == $active_item ) {
186: return sprintf(
187: '<li class="nav-item"><a class="nav-link active" rel="%s" target="%s" href="%s">%s%s</a></li>',
188: esc_html( $self->rel ),
189: esc_html( $self->target ),
190: esc_html( $self->href ),
191: $icon,
192: esc_html( $self->title ),
193: );
194: }
195: else {
196: return sprintf(
197: '<li class="nav-item"><a class="nav-link" rel="%s" target="%s" href="%s">%s%s</a></li>',
198: esc_html( $self->rel ),
199: esc_html( $self->target ),
200: esc_html( $self->href ),
201: $icon,
202: esc_html( $self->title ),
203: );
204: }
205: }
206:
207: sub dropdown_item ( $self, $active_item ) {
208: my $icon = $self->icon // '';
209: if ( length $icon ) {
210: $icon .= ' ';
211: }
212:
213: if ( $self == $active_item ) {
214: return sprintf(
215: '<li><a class="dropdown-item active" rel="%s" target="%s" href="%s">%s%s</a></li>',
216: esc_html( $self->rel ),
217: esc_html( $self->target ),
218: esc_html( $self->href ),
219: $icon,
220: esc_html( $self->title ),
221: );
222: }
223: else {
224: return sprintf(
225: '<li><a class="dropdown-item" rel="%s" target="%s" href="%s">%s%s</a></li>',
226: esc_html( $self->rel ),
227: esc_html( $self->target ),
228: esc_html( $self->href ),
229: $icon,
230: esc_html( $self->title ),
231: );
232: }
233: }
234:
235: sub page_title ( $self ) {
236: return sprintf( '%s — %s', $self->project->name, $self->title );
237: }
238:
239: sub _build_meta ( $self ) {
240: my @meta = @{ $self->_meta_merge // [] };
241: if ( my $title = $self->title ) {
242: push @meta, {
243: name => 'title',
244: property => 'rdfs:label dc:title og:title',
245: content => $title,
246: };
247: }
248: return \@meta;
249: }
250:
251: 1;
252: