File Coverage

blib/lib/Catmandu/Exporter/Atom.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package Catmandu::Exporter::Atom;
2              
3 1     1   32013 use namespace::clean;
  1         12500  
  1         4  
4 1     1   365 use Catmandu::Sane;
  0            
  0            
5             use XML::Atom::Feed;
6             use XML::Atom::Entry;
7             use POSIX qw(strftime);
8             use Moo;
9              
10             with 'Catmandu::Exporter';
11              
12             has title => (is => 'ro', default => sub { undef });
13             has subtitle => (is => 'ro', default => sub { undef });
14             has id => (is => 'ro', default => sub { undef });
15             has icon => (is => 'ro', default => sub { undef });
16             has logo => (is => 'ro', default => sub { undef });
17             has generator => (is => 'ro', default => sub { undef });
18             has updated => (is => 'ro', default => sub { undef });
19             has rights => (is => 'ro', default => sub { undef });
20             has ns => (is => 'ro', default => sub { undef });
21              
22             has link => (is => 'ro', isa => sub {
23             Catmandu::BadArg->throw("Link needs to be an array hash")
24             unless !defined $_[0] || ref $_[0] eq 'ARRAY';
25             });
26             has author => (is => 'ro', isa => sub {
27             Catmandu::BadArg->throw("Author needs to be an array hash")
28             unless !defined $_[0] || ref $_[0] eq 'ARRAY';
29             });
30             has contributor => (is => 'ro', isa => sub {
31             Catmandu::BadArg->throw("Contributor needs to be an array hash")
32             unless !defined $_[0] || ref $_[0] eq 'ARRAY';
33             });
34             has category => (is => 'ro', isa => sub {
35             Catmandu::BadArg->throw("Category needs to be an array hash")
36             unless !defined $_[0] || ref $_[0] eq 'ARRAY';
37             });
38              
39             has atom => (is => 'ro', lazy => 1, builder => '_build_atom');
40             has extra => (is => 'ro', default => sub { undef });
41              
42             sub BUILDARGS {
43             my ( $class, @args ) = @_;
44             my %args = ();
45            
46             if (@args > 0 && @args % 2 == 0) {
47             (%args) = (@args);
48             for (keys %args) {
49             next unless /^[^:]+:/;
50             $args{extra}->{$_} = $args{$_};
51             }
52             }
53            
54             return \%args;
55             }
56            
57             sub _build_atom {
58             my ($self) = @_;
59             my $atom = XML::Atom::Feed->new;
60            
61             if (defined $self->author) {
62             for (@{$self->author}) {
63             my $author = XML::Atom::Person->new;
64             $author->name($_->{name}) if defined $_->{name};
65             $author->email($_->{email}) if defined $_->{email};
66             $author->uri($_->{uri}) if defined $_->{uri};
67             $author->url($_->{url}) if defined $_->{url};
68             $author->homepage($_->{homepage}) if defined $_->{homepage};
69             $atom->author($author);
70             }
71             }
72            
73             if (defined $self->category) {
74             for (@{$self->category}) {
75             my $category = XML::Atom::Category->new;
76             $category->term($_->{term}) if defined $_->{term};
77             $category->label($_->{label}) if defined $_->{label};
78             $category->scheme($_->{scheme}) if defined $_->{scheme};
79             $atom->add_category($category, 'test');
80             }
81             }
82            
83             if (defined $self->contributor) {
84             for (@{$self->contributor}) {
85             my $contributor = XML::Atom::Person->new;
86             $contributor->name($_->{name}) if defined $_->{name};
87             $contributor->email($_->{email}) if defined $_->{email};
88             $contributor->uri($_->{uri}) if defined $_->{uri};
89             $contributor->url($_->{url}) if defined $_->{url};
90             $contributor->homepage($_->{homepage}) if defined $_->{homepage};
91             $atom->contributor($contributor);
92             }
93             }
94            
95             $atom->generator($self->generator) if defined $self->generator;
96             $atom->icon($self->icon) if defined $self->icon;
97             $atom->id($self->id) if defined $self->id;
98            
99             if (defined $self->link) {
100             for (@{$self->link}) {
101             my $link = XML::Atom::Link->new;
102             $link->type($_->{type}) if defined $_->{type};
103             $link->rel($_->{rel}) if defined $_->{rel};
104             $link->href($_->{href}) if defined $_->{href};
105             $link->hreflang($_->{hreflang}) if defined $_->{hreflang};
106             $link->title($_->{title}) if defined $_->{title};
107             $link->lenth($_->{length}) if defined $_->{length};
108             $atom->add_link($link);
109             }
110             }
111            
112             $atom->logo($self->logo) if defined $self->logo;
113             $atom->rights($self->rights) if defined $self->rights;
114             $atom->subtitle($self->subtitle) if defined $self->subtitle;
115             $atom->title($self->title) if defined $self->title;
116              
117             my $updated = $self->updated ? $self->updated : strftime("%Y-%m-%dT%H:%M:%SZ",gmtime(time));
118             $atom->updated($updated);
119            
120             if (defined $self->ns) {
121             for my $key (keys %{$self->extra}) {
122             next unless $key =~ /^([^:]+):(\S+)/;
123             my ($prefix,$name) = ($1,$2);
124             my $url = $self->ns->{$prefix};
125             next unless defined $url;
126             my $ns = XML::Atom::Namespace->new( $prefix => $url );
127             my $value = $self->extra->{$key};
128             $atom->set($ns, $name, $value);
129             }
130             }
131            
132             $atom;
133             }
134              
135             sub add {
136             my ($self, $data) = @_;
137             my $entry = XML::Atom::Entry->new;
138            
139             if (defined $data->{author}->{name} || defined $data->{author}->{email}) {
140             my $author = XML::Atom::Person->new;
141             $author->name($data->{author}->{name}) if defined $data->{author}->{name};
142             $author->email($data->{author}->{email}) if defined $data->{author}->{email};
143             $author->uri($data->{author}->{uri}) if defined $data->{author}->{uri};
144             $author->url($data->{author}->{url}) if defined $data->{author}->{url};
145             $author->homepage($data->{author}->{homepage}) if defined $data->{author}->{homepage};
146             $entry->author($author);
147             }
148            
149             if (defined $data->{category}) {
150             for (@{$data->{category}}) {
151             my $category = XML::Atom::Category->new;
152             $category->term($_->{term}) if defined $_->{term};
153             $category->label($_->{label}) if defined $_->{label};
154             $category->scheme($_->{scheme}) if defined $_->{scheme};
155             $entry->add_category($category);
156             }
157             }
158            
159             if (defined $data->{content}) {
160             my $content = XML::Atom::Content->new;
161             if ( defined $data->{content}->{mode} ) {
162             $content->mode($data->{content}->{mode});
163             }
164             #$content->mode($data->{content}->{mode} ? $data->{content}->{mode} : "xml");
165             $content->body($data->{content}->{body});
166             $entry->content($content);
167             }
168            
169             if (defined $data->{contributor}->{name} || defined $data->{contributor}->{email}) {
170             my $contributor = XML::Atom::Person->new;
171             $contributor->name($data->{contributor}->{name}) if defined $data->{contributor}->{name};
172             $contributor->email($data->{contributor}->{email}) if defined $data->{contributor}->{email};
173             $contributor->uri($data->{contributor}->{uri}) if defined $data->{contributor}->{uri};
174             $contributor->url($data->{contributor}->{url}) if defined $data->{contributor}->{url};
175             $contributor->homepage($data->{contributor}->{homepage}) if defined $data->{contributor}->{homepage};
176             $entry->contributor($contributor);
177             }
178            
179             $entry->id($data->{id}) if defined $data->{id};
180            
181             if (defined $data->{link}) {
182             for (@{$data->{link}}) {
183             my $link = XML::Atom::Link->new;
184             $link->type($_->{type}) if defined $_->{type};
185             $link->rel($_->{rel}) if defined $_->{rel};
186             $link->href($_->{href}) if defined $_->{href};
187             $link->hreflang($_->{hreflang}) if defined $_->{hreflang};
188             $link->title($_->{title}) if defined $_->{title};
189             $link->length($_->{length}) if defined $_->{length};
190             $entry->add_link($link);
191             }
192             }
193            
194             my $published = $data->{published} ? $data->{published} : strftime("%Y-%m-%dT%H:%M:%SZ", gmtime(time));
195             $entry->published($published);
196            
197             $entry->rights($data->{rights}) if defined $data->{rights};
198             $entry->source($data->{source}) if defined $data->{source};
199             $entry->summary($data->{summary}) if defined $data->{summary};
200             $entry->title($data->{title}) if defined $data->{title};
201            
202             my $updated = $data->{updated} ? $data->{updated} : strftime("%Y-%m-%dT%H:%M:%SZ", gmtime(time));
203             $entry->updated($updated);
204            
205             # Other metadata can be in a namespace
206             if (defined $self->ns) {
207             for my $key (keys %{$data}) {
208             next unless $key =~ /^([^:]+):(\S+)/;
209             my ($prefix,$name) = ($1,$2);
210             my $url = $self->ns->{$prefix};
211             next unless defined $url;
212             my $ns = XML::Atom::Namespace->new( $prefix => $url );
213             my $value = $data->{$key};
214             $entry->set($ns, $name, $value);
215             }
216             }
217            
218             $self->atom->add_entry($entry);
219             }
220              
221             sub commit {
222             my ($self) = @_;
223             my $fh = $self->fh;
224             say $fh $self->atom->as_xml;
225             }
226              
227             =head1 NAME
228              
229             Catmandu::Exporter::Atom - an Atom exporter
230              
231             =head1 SYNOPSIS
232              
233             use Catmandu::Exporter::Atom;
234              
235             my $blog_args = {
236             id => "urn:uuid:60a76c80-d399-11d9-b91C-0003939e0af6" ,
237             title => "My Blog" ,
238             subtitle => "testing 1.2.3" ,
239             icon => "http://icons.org/test.jpg" ,
240             generator => "Catmandu::Exporter::Atom" ,
241             rights => "Beer license",
242             link => [
243             {
244             'type' => 'text/html' ,
245             'rel' => 'alternate' ,
246             'href' => 'http://www.example.com' ,
247             }
248             ],
249             author => [
250             {
251             'name' => 'Daffy' ,
252             'email' => 'duck@toons.be' ,
253             }
254             ] ,
255             contributor => [
256             {
257             'name' => 'Bugs' ,
258             'email' => 'bunny@toons.be'
259             }
260             ],
261             ns => {
262             'dc' => 'http://purl.org/dc/elements/1.1/',
263             },
264             'dc:source' => 'test',
265             };
266            
267             my $exporter = Catmandu::Exporter::Atom->new(%$blog_args);
268              
269             $exporter->add_many($arrayref);
270             $exporter->add_many($iterator);
271             $exporter->add_many(sub { });
272              
273             $exporter->add($hashref);
274            
275             $exporter->add({
276             'title' => 'My Little Pony' ,
277             'subtitle' => 'Data testing for you and me' ,
278             'content' => "sdsadas" ,
279             'summary' => 'Brol 123' ,
280             'id' => '1291821827128172817' ,
281             'author' => {
282             'name' => 'John Doe' ,
283             'email' => 'john@farwaway.org' ,
284             } ,
285             'contributor' => {
286             'name' => 'Rabbit, R' ,
287             'email' => 'r.rabbit@farwaway.org' ,
288             'homepage' => 'http://faraway.org/~rabbit' ,
289             } ,
290             'link' => [
291             {
292             'type' => 'text/html' ,
293             'rel' => 'alternate' ,
294             'href' => 'http://www.example.com' ,
295             'title' => 'Test test' ,
296             'length' => '1231' ,
297             'hreflang' => 'eng' ,
298             } ,
299             {
300             'type' => 'text/html' ,
301             'rel' => 'alternate' ,
302             'href' => 'http://www.example2.com' ,
303             }
304             ] ,
305             'category' => [
306             {
307             'scheme' => 'http://localhost:8080/roller/adminblog' ,
308             'term' => 'Music',
309             }
310             ] ,
311             'rights' => 'Yadadada',
312             'dc:subject' => 'Toyz',
313             });
314              
315             printf "exported %d objects\n" , $exporter->count;
316              
317             =head2 Add one object
318              
319             use Catmandu::Exporter::Atom;
320             my $exporter = Catmandu::Exporter::Atom->new();
321              
322             print $exporter->add($hashref);
323              
324             =head2 Add many objects to exporter
325              
326             use Catmandu::Exporter::Atom;
327             my $exporter = Catmandu::Exporter::Atom->new();
328              
329             print $exporter->add_many($arrayref);
330              
331             =head2 Add many objects from an iterator
332              
333             use Catmandu::Exporter::Atom;
334             my $exporter = Catmandu::Exporter::Atom->new();
335              
336             my $iterator = Catmandu::Importer::
337              
338             print
339              
340             =head2 Fix your data while exporting the data
341              
342             use Catmandu::Exporter::Atom;
343             my $exporter = Catmandu::Exporter::Atom->new(fix => 'fix.txt');
344              
345             # where fix.txt looks for example:
346             # add_field()
347             # delete
348             # mv
349              
350             print $exporter->add($data);
351              
352              
353             =head1 SEE ALSO
354              
355             L
356              
357             =cut
358              
359             1;