File Coverage

blib/lib/Web/Feed.pm
Criterion Covered Total %
statement 21 105 20.0
branch 0 12 0.0
condition 1 4 25.0
subroutine 7 10 70.0
pod 0 3 0.0
total 29 134 21.6


line stmt bran cond sub pod time code
1             package Web::Feed;
2 1     1   13046 use strict;
  1         2  
  1         50  
3 1     1   3 use warnings;
  1         1  
  1         21  
4 1     1   15 use 5.010;
  1         5  
5 1     1   402 use DateTime::Tiny;
  1         2210  
  1         22  
6 1     1   410 use Time::Local qw(timegm);
  1         1178  
  1         47  
7 1     1   418 use POSIX ();
  1         4830  
  1         716  
8              
9             our $VERSION = '0.11';
10              
11             sub new {
12 1     1 0 160 my ($class, %data) = @_;
13 1         2 my $self = bless \%data, $class;
14 1   50     9 $self->{path} //= 'atom';
15 1         2 return $self;
16             }
17              
18              
19             sub atom {
20 0     0 0   my ($self) = @_;
21              
22 0           my $url = $self->{url};
23 0           $url =~ s{/*$}{};
24              
25 0           my $xml = '';
26 0           $xml .= qq{\n};
27 0           $xml .= qq{\n};
28 0           $xml .= qq{\n};
29 0           $xml .= qq{$self->{title}\n};
30 0           $xml .= qq{$url/\n};
31 0           $xml .= qq{$self->{updated}Z\n};
32              
33 0           foreach my $e (@{ $self->{entries} }) {
  0            
34 0           $xml .= qq{\n};
35              
36 0           $xml .= qq{ $e->{title}\n};
37 0           $xml .= qq{ $e->{summary}\n};
38 0           $xml .= qq{ $e->{updated}Z\n};
39              
40 0           $xml .= qq{ };
41 0           my $id = $e->{id};
42 0 0         if (not $id) {
43 0           $id = $e->{link};
44 0           $id =~ s/\?.*//;
45             }
46 0           $xml .= qq{ $id\n};
47 0   0       my $content = $e->{content} // '';
48 0           $xml .= qq{ $content\n};
49              
50 0 0         if ($e->{author}) {
51 0           $xml .= qq{ \n};
52 0           $xml .= qq{ $e->{author}{name}\n};
53             #$xml .= qq{ $e->{author}{email}\n};
54 0           $xml .= qq{ \n};
55             }
56              
57 0           $xml .= qq{\n};
58             };
59 0           $xml .= qq{\n};
60              
61 0           return $xml;
62             }
63              
64             sub _pubDate {
65 0     0     my ($date) = @_;
66 0           my $dt = DateTime::Tiny->from_string( "$date" ); # forced stringification
67 0           my $pubDate = POSIX::strftime("%a, %d %b %Y %H:%M:%S GMT", gmtime timegm( $dt->second, $dt->minute, $dt->hour, $dt->day, $dt->month-1, $dt->year ));
68 0           return $pubDate;
69             }
70              
71              
72             sub rss {
73 0     0 0   my ($self) = @_;
74              
75 0           my $url = $self->{url};
76 0           $url =~ s{/*$}{};
77 0           my $pubDate = _pubDate($self->{updated});
78              
79             # itunes specs: http://www.apple.com/itunes/podcasts/specs.html
80 0           my $xml = '';
81 0           $xml .= qq{\n};
82 0           $xml .= qq{\n};
83 0           $xml .= qq{\n};
84 0           $xml .= qq{ $self->{title}\n};
85 0           $xml .= qq{ $url/\n};
86 0           $xml .= qq{ $pubDate\n};
87 0           $xml .= qq{ $self->{description}\n};
88 0           $xml .= qq{ $self->{language}\n};
89 0           $xml .= qq{ $self->{copyright}\n};
90              
91 0           $xml .= qq{ $self->{subtitle}\n};
92 0           $xml .= qq{ $self->{author}\n};
93 0           $xml .= qq{ $self->{summary}\n};
94 0 0         if ($self->{image}) {
95 0           $xml .= qq{ \n};
96             }
97 0 0         if ($self->{keywords}) {
98 0           my $keywords = join ', ', @{ $self->{keywords} };
  0            
99 0           $xml .= qq{ $keywords\n};
100             }
101 0           $xml .= qq{ \n};
102 0           $xml .= qq{ $self->{itunes_name}\n};
103 0           $xml .= qq{ $self->{itunes_email}\n};
104 0           $xml .= qq{ \n};
105 0           $xml .= qq{ no\n};
106 0           $xml .= qq{ \n};
107              
108 0           foreach my $e (@{ $self->{entries} }) {
  0            
109 0           $xml .= qq{ \n};
110 0           $xml .= qq{ $e->{title}\n};
111 0           $xml .= qq{ $e->{link}\n};
112 0           $xml .= qq{ $e->{link}\n};
113 0           $xml .= qq{ $e->{summary}\n};
114             # $xml .= qq{ $e->{updated}Z\n};
115              
116             # $xml .= qq{ $e->{id}\n};
117             # $xml .= qq{ $e->{content}\n};
118 0 0         if ($e->{author}) {
119 0           $xml .= qq{ $e->{author}{name}\n};
120             # $xml .= qq{ \n};
121             # $xml .= qq{ $e->{author}{name}\n};
122             # $xml .= qq{ $e->{author}{email}\n};
123             # $xml .= qq{ \n};
124             }
125              
126 0 0         if ($e->{itunes}) {
127 0           my $pubDate = _pubDate($e->{updated});
128 0           $xml .= qq{ $pubDate\n};
129 0           $xml .= qq{ $e->{itunes}{author}\n};
130             # $xml .= qq{ \n};
131 0           $xml .= qq{ $e->{itunes}{summary}\n};
132             # $xml .= qq{ \n};
133 0           $xml .= qq{ \n};
134 0           $xml .= qq{ $e->{itunes}{duration}\n};
135             }
136              
137              
138 0           $xml .= qq{ \n};
139             }
140              
141 0           $xml .= qq{\n};
142 0           $xml .= qq{\n};
143              
144 0           return $xml;
145             }
146              
147             1;
148              
149             =pod
150              
151             =head1 NAME
152              
153             Web::Feed - generate Atom and RSS feeds and sitemaps.xml files
154              
155             =head1 DESCRIPTION
156              
157             Experimental code.
158              
159             =head1 COPYRIGHT
160              
161             (c) 2014 Gabor Szabo
162              
163             =head1 LICENSE
164              
165             This program is free software; you can redistribute it and/or
166             modify it under the same terms as Perl 5 itself.
167              
168             =cut
169              
170             # Copyright 2014 Gabor Szabo
171             # LICENSE
172             # This program is free software; you can redistribute it and/or
173             # modify it under the same terms as Perl 5 itself.
174              
175