File Coverage

lib/App/Followme/CreateRss.pm
Criterion Covered Total %
statement 69 69 100.0
branch n/a
condition 1 2 50.0
subroutine 14 14 100.0
pod 2 5 40.0
total 86 90 95.5


line stmt bran cond sub pod time code
1             package App::Followme::CreateRss;
2              
3 1     1   503 use 5.008005;
  1         3  
4 1     1   8 use strict;
  1         2  
  1         24  
5 1     1   9 use warnings;
  1         2  
  1         25  
6              
7 1     1   5 use lib '../..';
  1         2  
  1         7  
8              
9 1     1   145 use base qw(App::Followme::Module);
  1         2  
  1         513  
10              
11 1     1   6 use File::Spec::Functions qw(catfile splitdir);
  1         2  
  1         50  
12 1     1   630 use MIME::Base64 qw(encode_base64);
  1         675  
  1         62  
13              
14 1     1   7 use App::Followme::FIO;
  1         2  
  1         94  
15 1     1   6 use App::Followme::NestedText;
  1         2  
  1         628  
16              
17             our $VERSION = "2.03";
18              
19             #----------------------------------------------------------------------
20             # Read the default parameter values
21              
22             sub parameters {
23 4     4 1 6 my ($pkg) = @_;
24              
25             return (
26 4         15 rss_extension => 'rss',
27             data_pkg => 'App::Followme::WebData',
28             );
29             }
30              
31             #----------------------------------------------------------------------
32             # Write an rss file for the web pages in a directory
33              
34             sub run {
35 1     1 0 56 my ($self, $folder) = @_;
36              
37 1         5 my %rss = $self->build_rss($folder);
38              
39 1         6 my @path = splitdir($folder);
40 1         11 my $filename = pop(@path) . '.' . $self->{rss_extension};
41 1         6 $filename = catfile($folder, $filename);
42              
43 1         9 nt_write_almost_xml_file($filename, %rss);
44              
45 1         9 return;
46             }
47              
48             #----------------------------------------------------------------------
49             # Return an rss file of the newest web pages in a directory
50              
51             sub build_rss {
52 1     1 0 4 my ($self, $folder) = @_;
53              
54 1         13 my $index_file = $self->to_file($folder);
55 1         6 my $info = $self->file_info($index_file);
56 1         7 my %channel = %$info;
57 1         3 delete $channel{guid};
58              
59 1         2 my @items;
60 1         5 my $files = $self->{data}->build('top_files_by_mdate_reversed',
61             $index_file);
62              
63 1         3 foreach my $file (@$files) {
64 3         8 push(@items, $self->file_info($file));
65             }
66 1         7 $channel{item} = \@items;
67              
68 1         4 my $rss_tag = 'rss version="2.0"';
69 1         5 my %rss = ($rss_tag => {channel => \%channel});
70              
71 1         10 return %rss;
72             }
73              
74             #----------------------------------------------------------------------
75             # Return the pertinent information about a file for the rss file
76              
77             sub file_info {
78 4     4 0 8 my ($self, $file) = @_;
79 4         8 my $info = {};
80              
81             # build returns a reference, so must dereference
82              
83 4         6 $info->{title} = ${$self->{data}->build('title', $file)};
  4         28  
84 4         9 $info->{author} = ${$self->{data}->build('author', $file)};
  4         22  
85 4         7 $info->{description} = ${$self->{data}->build('description', $file)};
  4         14  
86 4         10 $info->{pubDate} = ${$self->{data}->build('date', $file)};
  4         14  
87 4         9 $info->{link} = ${$self->{data}->build('remote_url', $file)};
  4         13  
88              
89 4         20 my $guid = encode_base64($info->{link});
90 4         26 $guid =~ s/=*\n$//;
91 4         12 $info->{guid} = $guid;
92              
93 4         11 return $info;
94             }
95              
96             #----------------------------------------------------------------------
97             # Set exclude_index to true and set default date format
98              
99             sub setup {
100 1     1 1 3 my ($self) = @_;
101              
102 1         3 $self->{extension} = $self->{web_extension};
103 1   50     4 $self->{data}{date_format} ||= 'Day, dd Mon yyyy';
104 1         2 $self->{data}{exclude_index} = 1;
105 1         3 return;
106             }
107              
108             1;
109             __END__
110              
111             =encoding utf-8
112              
113             =head1 NAME
114              
115             App::Followme::CreateRss - Create an rss file for a directory
116              
117             =head1 SYNOPSIS
118              
119             use App::Followme::CreateRss;
120             my $rss = App::Followme::CreateRss->new();
121             $rss->run($folder);
122              
123             =head1 DESCRIPTION
124              
125             This module creates an rss file listing the newest files in a folder
126             and its subfolders.
127              
128             =head1 CONFIGURATION
129              
130             The following fields in the configuration file are used:
131              
132             =over 4
133              
134             =item rss_extension
135              
136             The extension used for rss files. The default value is 'rss'.
137              
138             =item data_pkg
139              
140             The package used to retrieve information from each file contained in the
141             rss file. The default value is 'App::Followme::WebData'.
142              
143             =back
144              
145             =head1 LICENSE
146              
147             Copyright (C) Bernie Simon.
148              
149             This library is free software; you can redistribute it and/or modify
150             it under the same terms as Perl itself.
151              
152             =head1 AUTHOR
153              
154             Bernie Simon E<lt>bernie.simon@gmail.comE<gt>
155              
156             =cut