File Coverage

blib/lib/Statocles/Page/ListItem.pm
Criterion Covered Total %
statement 33 33 100.0
branch 10 10 100.0
condition n/a
subroutine 7 7 100.0
pod 3 3 100.0
total 53 53 100.0


line stmt bran cond sub pod time code
1             package Statocles::Page::ListItem;
2             our $VERSION = '0.086';
3             # ABSTRACT: An item in a List page
4              
5 26     26   531 use Statocles::Base 'Class';
  26         53  
  26         209  
6 26     26   177734 use Mojo::DOM;
  26         8718  
  26         15529  
7              
8             #pod =attr page
9             #pod
10             #pod The L<page object|Statocles::Page> for this item in the list.
11             #pod
12             #pod =cut
13              
14             has page => (
15             is => 'ro',
16             isa => ConsumerOf[ 'Statocles::Page' ],
17             );
18              
19             #pod =attr rewrite_mode
20             #pod
21             #pod One of "absolute" or "full". Defaults to "absolute".
22             #pod
23             #pod If "absolute", will rewrite the content using the absolute path of the page.
24             #pod
25             #pod If "full", will use the full URL (the site base_url and the page URL) when
26             #pod rewriting the content.
27             #pod
28             #pod =cut
29              
30             has rewrite_mode => (
31             is => 'ro',
32             isa => Enum[qw( absolute full )],
33             default => 'absolute',
34             );
35              
36             #pod =method DOES
37             #pod
38             #pod This page proxies everything necessary to be a page object, without consuming
39             #pod the L<page role|Statocles::Page>.
40             #pod
41             #pod =cut
42              
43             sub DOES {
44 748     748 1 68925 my ( $self, $class ) = @_;
45 748         2506 return $self->page->DOES( $class );
46             }
47              
48             #pod =method AUTOLOAD
49             #pod
50             #pod Methods are proxyed to the L<page object|/page> so that this object appears
51             #pod mostly as the page inside of it.
52             #pod
53             #pod =cut
54              
55             our $AUTOLOAD;
56             sub AUTOLOAD {
57 8382     8382   1719404 my ( $self, @args ) = @_;
58 8382         38767 my ( $method_name ) = $AUTOLOAD =~ /::([^:]+)$/;
59              
60             # We must be able to destroy ourselves
61             # This issue is fixed in perl 5.18
62 8382 100       40946 return if $method_name eq 'DESTROY';
63              
64 7039         25652 my $method = $self->page->can( $method_name );
65 7039 100       13223 if ( !$method ) {
66 1         20 die sprintf q{ListItem page (%s %s) has no method "%s"},
67             $self->page->path,
68             ref $self->page,
69             $method_name;
70             }
71 7038         84991 return $method->( $self->page, @args );
72             }
73              
74             #pod =method content
75             #pod
76             #pod my $html = $page->content;
77             #pod
78             #pod Get the content for this page. Rewrite any links, images, or other according to the
79             #pod L<rewrite_mode attributes|/rewrite_mode>.
80             #pod
81             #pod =cut
82              
83             sub _rewrite_content {
84 988     988   2149 my ( $self, $content ) = @_;
85              
86 988         5673 my $dom = Mojo::DOM->new( $content );
87 988         1196169 for my $attr ( qw( src href ) ) {
88 1976         101123 for my $el ( $dom->find( "[$attr]" )->each ) {
89 6895         1150257 my $url = $el->attr( $attr );
90              
91             # relative URLs must be absolute
92 6895 100       110490 if ( $url !~ m{^(?:(?:[a-zA-Z]+:)|//?)} ) {
93 3702         11961 $url = $self->page->dirname . '/' . $url;
94             }
95              
96             # absolute URLs may be full
97 6895 100       187963 if ( $self->rewrite_mode eq 'full' ) {
98 4583 100       12541 if ( $url !~ m{^(?:(?:[a-zA-Z]+:)|//)} ) {
99 3687         61708 $url = $self->page->site->url( $url );
100             }
101             }
102              
103 6895         16366 $el->attr( $attr => $url );
104             }
105             }
106              
107 988         67126 return "$dom";
108             }
109              
110             sub content {
111 2     2 1 9566 my ( $self, @args ) = @_;
112 2         14 my $content = $self->page->content( @args );
113 2         7437 return $self->_rewrite_content( $content );
114             }
115              
116             #pod =method sections
117             #pod
118             #pod my @sections = $page->sections;
119             #pod
120             #pod Get a list of content divided into sections. The Markdown "---" marker divides
121             #pod sections. Rewrite any links, images, or other according to the L<rewrite_mode
122             #pod attributes|/rewrite_mode>.
123             #pod
124             #pod =cut
125              
126             sub sections {
127 983     983 1 49807 my ( $self, @args ) = @_;
128 983         4396 return map { $self->_rewrite_content( $_ ) } $self->page->sections( @args );
  986         3382  
129             }
130              
131             1;
132              
133             __END__
134              
135             =pod
136              
137             =encoding UTF-8
138              
139             =head1 NAME
140              
141             Statocles::Page::ListItem - An item in a List page
142              
143             =head1 VERSION
144              
145             version 0.086
146              
147             =head1 DESCRIPTION
148              
149             This page wraps another page for use inside of a L<list
150             page|Statocles::Page::List>. This page will rewrite content to ensure that
151             relative links in the page work correctly when moved into the list page.
152              
153             =head1 ATTRIBUTES
154              
155             =head2 page
156              
157             The L<page object|Statocles::Page> for this item in the list.
158              
159             =head2 rewrite_mode
160              
161             One of "absolute" or "full". Defaults to "absolute".
162              
163             If "absolute", will rewrite the content using the absolute path of the page.
164              
165             If "full", will use the full URL (the site base_url and the page URL) when
166             rewriting the content.
167              
168             =head1 METHODS
169              
170             =head2 DOES
171              
172             This page proxies everything necessary to be a page object, without consuming
173             the L<page role|Statocles::Page>.
174              
175             =head2 AUTOLOAD
176              
177             Methods are proxyed to the L<page object|/page> so that this object appears
178             mostly as the page inside of it.
179              
180             =head2 content
181              
182             my $html = $page->content;
183              
184             Get the content for this page. Rewrite any links, images, or other according to the
185             L<rewrite_mode attributes|/rewrite_mode>.
186              
187             =head2 sections
188              
189             my @sections = $page->sections;
190              
191             Get a list of content divided into sections. The Markdown "---" marker divides
192             sections. Rewrite any links, images, or other according to the L<rewrite_mode
193             attributes|/rewrite_mode>.
194              
195             =head1 AUTHOR
196              
197             Doug Bell <preaction@cpan.org>
198              
199             =head1 COPYRIGHT AND LICENSE
200              
201             This software is copyright (c) 2016 by Doug Bell.
202              
203             This is free software; you can redistribute it and/or modify it under
204             the same terms as the Perl 5 programming language system itself.
205              
206             =cut