File Coverage

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


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