File Coverage

blib/lib/Web/Microformats2/Document.pm
Criterion Covered Total %
statement 77 79 97.4
branch 13 14 92.8
condition 9 11 81.8
subroutine 14 14 100.0
pod 4 6 66.6
total 117 124 94.3


line stmt bran cond sub pod time code
1             package Web::Microformats2::Document;
2 2     2   12 use Moose;
  2         5  
  2         15  
3 2     2   11576 use Encode qw(encode_utf8);
  2         4  
  2         132  
4 2     2   14 use JSON qw(decode_json);
  2         5  
  2         18  
5 2     2   263 use List::Util qw(any);
  2         3  
  2         124  
6              
7 2     2   14 use Web::Microformats2::Item;
  2         3  
  2         1777  
8              
9             has 'top_level_items' => (
10             is => 'ro',
11             traits => ['Array'],
12             isa => 'ArrayRef[Web::Microformats2::Item]',
13             default => sub { [] },
14             lazy => 1,
15             handles => {
16             all_top_level_items => 'elements',
17             add_top_level_item => 'push',
18             count_top_level_items => 'count',
19             has_top_level_items => 'count',
20             },
21             );
22              
23             has 'items' => (
24             is => 'ro',
25             traits => ['Array'],
26             isa => 'ArrayRef[Web::Microformats2::Item]',
27             default => sub { [] },
28             lazy => 1,
29             handles => {
30             add_item => 'push',
31             all_items => 'elements',
32             },
33             );
34              
35             has 'rels' => (
36             is => 'ro',
37             isa => 'HashRef',
38             lazy => 1,
39             clearer => '_clear_rels',
40             default => sub { {} },
41             );
42              
43             has 'rel_urls' => (
44             is => 'ro',
45             isa => 'HashRef',
46             lazy => 1,
47             clearer => '_clear_rel_urls',
48             default => sub { {} },
49             );
50              
51             sub as_json {
52 75     75 1 146 my $self = shift;
53              
54 75         2142 my $data_for_json = {
55             rels => $self->rels,
56             'rel-urls' => $self->rel_urls,
57             items => $self->top_level_items,
58             };
59              
60 75         1560 return JSON->new->convert_blessed->utf8->encode( $data_for_json );
61             }
62              
63             sub as_raw_data {
64 1     1 1 460 my $self = shift;
65              
66 1         4 return decode_json( $self->as_json );
67             }
68              
69             sub new_from_json {
70 1     1 1 549 my $class = shift;
71              
72 1         3 my ( $json ) = @_;
73              
74 1         6 my $data_ref = decode_json (encode_utf8($json));
75              
76             my $document = $class->new(
77             rels => $data_ref->{rels} || {},
78             rel_urls => $data_ref->{rel_urls} || {},
79 1   50     64 );
      50        
80              
81 1         1008 for my $deflated_item ( @{ $data_ref->{items} } ) {
  1         4  
82 1         5 my $item = $class->_inflate_item( $deflated_item );
83 1         39 $document->add_top_level_item( $item );
84 1         43 $document->add_item ( $item );
85             }
86              
87 1         11 return $document;
88             }
89              
90             sub _inflate_item {
91 3     3   34 my $class = shift;
92              
93 3         5 my ( $deflated_item ) = @_;
94              
95 3         6 foreach ( @{ $deflated_item->{type} } ) {
  3         6  
96 2         10 s/^h-//;
97             }
98              
99             my $item = Web::Microformats2::Item->new(
100             types => $deflated_item->{type},
101 3         32 );
102              
103 3 100       2013 if ( defined $deflated_item->{value} ) {
104 2         65 $item->value( $deflated_item->{value} );
105             }
106              
107 3         6 for my $deflated_child ( @{ $deflated_item->{children} } ) {
  3         8  
108 0         0 $item->add_child ( $class->_inflate_item( $deflated_child ) );
109             }
110              
111 3         6 for my $property ( keys %{ $deflated_item->{properties} } ) {
  3         10  
112 8         25 my $properties_ref = $deflated_item->{properties}->{$property};
113 8         12 for my $property_value ( @{ $properties_ref } ) {
  8         13  
114 8 100       15 if ( ref( $property_value ) ) {
115 2         21 $property_value = $class->_inflate_item( $property_value );
116             }
117 8         20 $item->add_base_property( $property, $property_value );
118             }
119             }
120              
121 3         11 return $item;
122             }
123              
124             sub get_first {
125 1     1 1 5 my $self = shift;
126              
127 1         4 my ( $type ) = @_;
128              
129 1         75 for my $item ( $self->all_items ) {
130 1 50       207 return $item if $item->has_type( $type );
131             }
132              
133 0         0 return;
134             }
135              
136             sub add_rel {
137 48     48 0 67 my $self = shift;
138              
139 48         78 my ( $rel, $url ) = @_;
140              
141 48   100     1217 $self->rels->{ $rel } ||= [];
142 48 100   38   153 unless ( any { $_ eq $url } @{ $self->{rels}->{$rel} } ) {
  38         73  
  48         175  
143 41         50 push @{ $self->{rels}->{$rel} }, $url;
  41         174  
144             }
145             }
146              
147             sub add_rel_url {
148 42     42 0 58 my $self = shift;
149              
150 42         65 my ( $url, $rel_url_value_ref ) = @_;
151              
152 42         51 my $current_value;
153 42 100       1139 unless ( $current_value = $self->rel_urls->{ $url } ) {
154 38         872 $current_value = $self->rel_urls->{ $url } = {};
155             }
156              
157 42         77 foreach (qw( hreflang media title type text)) {
158 210 100 100     422 if (
159             ( defined $rel_url_value_ref->{ $_ } )
160             && not ( defined $current_value->{ $_ } )
161             ) {
162 43         86 $current_value->{ $_ } = $rel_url_value_ref->{ $_ };
163             }
164             }
165              
166 42   100     147 $current_value->{rels} ||= [];
167 42         50 for my $rel ( @{ $rel_url_value_ref->{rels} }) {
  42         79  
168 48 100   13   125 unless ( any { $_ eq $rel } @{ $current_value->{ rels } } ) {
  13         39  
  48         146  
169 41         57 push @{ $current_value->{ rels } }, $rel;
  41         194  
170             }
171             }
172             }
173              
174              
175             1;
176              
177             =pod
178              
179             =head1 NAME
180              
181             Web::Microformats2::Document - A parsed Microformats2 data structure
182              
183             =head1 DESCRIPTION
184              
185             An object of this class represents a Microformats2 data structure that
186             has been either parsed from an HTML document or deserialized from JSON.
187              
188             The expected use-case is that you will construct document objects either
189             via the L<Web::Microformats2::Parser/parse> method of
190             L<Web::Microformats2::Parser>, or by this class's L</new_from_json>
191             method. Once constructed, we expect you to treat documents as read-only.
192              
193             See Web::Microformats2 for further context and purpose.
194              
195             =head1 METHODS
196              
197             =head2 Class Methods
198              
199             =head3 new_from_json
200              
201             $doc = Web::Microformats2->new_from_json( $json_string )
202              
203             Given a JSON string containing a properly serialized Microformats2 data
204             structure, returns a L<Web::Microformats2::Document> object.
205              
206             =head2 Object Methods
207              
208             =head3 as_json
209              
210             $json = $doc->as_json
211              
212             Returns a JSON representation of this object, created according to
213             Microformats2 serialization rules.
214              
215             =head3 as_raw_data
216              
217             $mf2_data_ref = $doc->as_raw_data
218              
219             Returns a hash reference containing unblessed data structures that map
220             exactly to the JSON version of this object, as defined by Microformats2
221             serialization rules. In other words, it contains C<items>, C<rels>, and
222             C<rel-urls> keys, and builds down from there.
223              
224             Call this if you'd like to parse the Microformats2 metadata out of a
225             document and then work with it at low level, as opposed to (or as well
226             as) using the various convenience methods offered by this class.
227              
228             Equivalent to calling C<decode_json()> (see L<JSON/decode_json>) on the
229             output of C<as_json>.
230              
231             =head3 all_items
232              
233             @items = $doc->all_items;
234              
235             Returns a list of all L<Web::Microformats2::Item> objects this document
236             contains at I<any> level.
237              
238             =head3 all_top_level_items
239              
240             @items = $doc->all_top_level_items;
241              
242             Returns a list of all L<Web::Microformats2::Item> objects this document
243             contains at the top level.
244              
245             =head3 get_first
246              
247             $item = $doc->get_first( $item_type );
248              
249             # So:
250             $entry = $doc->get_first( 'h-entry' );
251             # Or...
252             $entry = $doc->get_first( 'entry' );
253              
254             Given a Microformats2 item-type string -- e.g. "h-entry" (or just
255             "entry") -- returns the first item of that type that this document
256             contains (in document order, depth-first).
257              
258             =head1 AUTHOR
259              
260             Jason McIntosh (jmac@jmac.org)
261              
262             =head1 COPYRIGHT AND LICENSE
263              
264             This software is Copyright (c) 2018 by Jason McIntosh.
265              
266             This is free software, licensed under:
267              
268             The MIT (X11) License