File Coverage

lib/App/Followme/FileData.pm
Criterion Covered Total %
statement 98 100 98.0
branch 17 18 94.4
condition n/a
subroutine 20 21 95.2
pod 1 10 10.0
total 136 149 91.2


line stmt bran cond sub pod time code
1             package App::Followme::FileData;
2              
3 16     16   850 use 5.008005;
  16         82  
4 16     16   97 use strict;
  16         32  
  16         431  
5 16     16   97 use warnings;
  16         32  
  16         455  
6 16     16   85 use integer;
  16         54  
  16         90  
7 16     16   513 use lib '../..';
  16         39  
  16         92  
8              
9              
10 16     16   2188 use base qw(App::Followme::FolderData);
  16         35  
  16         7835  
11 16     16   149 use App::Followme::FIO;
  16         39  
  16         1597  
12 16     16   2751 use App::Followme::NestedText;
  16         43  
  16         1144  
13 16     16   2593 use App::Followme::Web;
  16         40  
  16         20057  
14              
15             our $VERSION = "2.01";
16              
17             #----------------------------------------------------------------------
18             # Read the default parameter values
19              
20             sub parameters {
21 340     340 1 648 my ($self) = @_;
22              
23             return (
24 340         964 base_directory => '',
25             title_template => '',
26             );
27             }
28              
29             #----------------------------------------------------------------------
30             # Convert content represented in html format (stub)
31              
32             sub fetch_as_html {
33 10     10 0 24 my ($self, $content_block) = @_;
34 10         21 return $content_block;
35             }
36              
37             #----------------------------------------------------------------------
38             # Parse content as html to get fallback values for data
39              
40             sub fetch_content {
41 99     99 0 229 my ($self, $content_block) = @_;
42              
43             # Content within title template is title, rest of content is body
44              
45 99         190 my $metadata = [];
46 99         167 my $global = 0;
47 99         142 my $body;
48              
49              
50 99 100       255 if ($self->{title_template}) {
51              
52             my $title_parser = sub {
53 22     22   57 my ($metadata, @tokens) = @_;
54 22         64 my $text = web_only_text(@tokens);
55 22         54 push(@$metadata, 'title', $text);
56 22         57 return '';
57 23         101 };
58              
59             $body = web_substitute_tags($self->{title_template},
60 23         73 $content_block,
61             $title_parser,
62             $metadata,
63             $global
64             );
65             } else {
66 76         136 $body = $content_block;
67             }
68              
69 99         398 $body =~ s/^\s+//;
70 99         265 push(@$metadata, 'body', $body);
71 99         275 my %content = @$metadata;
72              
73             my $paragraph_parser = sub {
74 91     91   263 my ($paragraph, @tokens) = @_;
75 91         250 $$paragraph = web_only_text(@tokens);
76 91         229 return;
77 99         442 };
78              
79 99         181 my $paragraph;
80 99 100       359 if (web_match_tags('<p></p>',
81             $body,
82             $paragraph_parser,
83             \$paragraph,
84             $global)) {
85              
86             # Description is first sentence of first paragraph
87 91         816 $paragraph =~ /([^.!?\s][^.!?]*(?:[.!?](?!['"]?\s|$)[^.!?]*)*[.!?]?['"]?(?=\s|$))/;
88 91         311 $content{description} = $1;
89 91         200 $content{summary} = $paragraph;
90             }
91              
92 99         838 return %content;
93             }
94              
95             #----------------------------------------------------------------------
96             # Fetch data from all its possible sources
97              
98             sub fetch_data {
99 554     554 0 4241 my ($self, $name, $filename, $loop) = @_;
100              
101             # Check to see if you can get data without opening file
102 554         1886 $self->check_filename($name, $filename);
103 554         1496 my %data = $self->gather_data('get', $name, $filename, $loop);
104              
105             # Then open the file and try to read the data from it
106             %data = ($self->fetch_from_file($filename), %data)
107 554 100       1622 unless exists $data{$name};
108              
109             # If not found in the file, calculate from other fields
110             %data = (%data, $self->gather_data('calculate', $name, $filename, $loop))
111 554 100       1446 unless exists $data{$name};
112              
113 554         1879 return %data;
114             }
115              
116             #----------------------------------------------------------------------
117             # Look in the file for the data
118              
119             sub fetch_from_file {
120 115     115 0 265 my ($self, $filename) = @_;
121              
122 115         354 my $text = fio_read_page($filename);
123 115 100       462 return () unless $text;
124              
125 102         433 my $section = $self->fetch_sections($text);
126              
127             # First look in the metadata and then the content
128 102         384 my %metadata = $self->fetch_metadata($section->{metadata});
129 102         411 my %content = $self->fetch_content($section->{body});
130              
131 102         696 return (%content, %metadata);
132             }
133              
134             #----------------------------------------------------------------------
135             # Fetch metadata directly from file
136              
137             sub fetch_metadata {
138 57     57 0 129 my ($self, $metadata_block) = @_;
139              
140 57         238 my %metadata = nt_parse_almost_yaml_string($metadata_block);
141 57         177 return %metadata;
142             }
143              
144             #----------------------------------------------------------------------
145             # Split text into metadata and content sections
146              
147             sub fetch_sections {
148 54     54 0 128 my ($self, $text) = @_;
149              
150 54         83 my %section;
151 54         293 my $divider = qr(-{3,}\s*\n);
152              
153 54 100       436 if ($text =~ /^$divider/) {
154 28         197 my @sections = split($divider, $text, 3);
155 28         84 $section{body} = $sections[2];
156 28         70 $section{metadata} = $sections[1];
157              
158             } else {
159 26         82 $section{body} = $text;
160 26         55 $section{metadata} = '';
161             }
162              
163 54         195 $section{body} = $self->fetch_as_html($section{body});
164 54         130254 return \%section;
165             }
166              
167             #----------------------------------------------------------------------
168             # Return author's name in sortable order
169              
170             sub format_author {
171 29     29 0 76 my ($self, $sorted_order, $author) = @_;
172              
173 29 100       73 if ($sorted_order) {
174 1         2 $author = lc($author);
175              
176             # no need to sort if last name is first
177 1 50       3 if ($author !~ /^\w+,/) {
178             # put last name first
179 1         3 $author =~ s/[^\w\s]//g;
180 1         3 my @names = split(' ', $author);
181 1         2 my $name = pop(@names);
182 1         3 unshift(@names, $name);
183              
184 1         3 $author = join(' ', @names);
185             }
186             }
187              
188 29         111 return $author;
189             }
190              
191             #----------------------------------------------------------------------
192             # Return title in sortable order
193              
194             sub format_title {
195 104     104 0 235 my ($self, $sorted_order, $title) = @_;
196              
197 104 100       259 if ($sorted_order) {
198 7         15 $title = lc($title);
199 7         14 $title =~ s/^a\s+//;
200 7         15 $title =~ s/^the\s+//;
201             }
202              
203 104         345 return $title;
204             }
205              
206             #----------------------------------------------------------------------
207             # Return the base directory defined in this object
208              
209             sub get_base_directory {
210 0     0 0   my ($self) = @_;
211 0           return $self->{base_directory};
212             }
213              
214             1;
215              
216             =pod
217              
218             =encoding utf-8
219              
220             =head1 NAME
221              
222             App::Followme::FileData
223              
224             =head1 SYNOPSIS
225              
226             use App::Followme::FileData;
227             my $data = App::Followme::FileData->new();
228             my $html = App::Followme::Template->new('example.htm', $data);
229              
230             =head1 DESCRIPTION
231              
232             This module extracts data from a file. It assumes the file is a text
233             file with the metadata in a nested text block preceding a content block
234             that is in html format or convertible to html format. The two sections
235             are separated by a line of three or more dots. These asumptions can be
236             overriden by overriding the methods in the class. Like the other data
237             classes, this class is normally called by the Template class and not
238             directly by user code.
239              
240             =head1 METHODS
241              
242             All data classes are first instantiated by calling new and the object
243             created is passed to a template object. It calls the build method with an
244             argument name to retrieve that data item, though for the sake of
245             efficiency, all the data are read from the file at once.
246              
247             =head1 VARIABLES
248              
249             The file metadata class can evaluate the following variables. When passing
250             a name to the build method, the sigil should not be used.
251              
252             =over 4
253              
254             =item $body
255              
256             The main content of the file.
257              
258             =item $description
259              
260             A one sentence description of the file contents
261              
262             =item $date
263              
264             The creation date of a file. The display format is controlled by the
265             configuration variable, data_format
266              
267             =item $summary
268              
269             A summary of the file's contents, by default the first paragraph.
270              
271             =item $title
272              
273             The title of the file, either derived from the content or the file metadata.
274              
275             =back
276              
277             =head1 CONFIGURATION
278              
279             This class has the following configuration variable:
280              
281             =over 4
282              
283             =item base_directory
284              
285             The top directory containing the files to be processed
286              
287             =item title_template
288              
289             A set of html tags that bound the title in the file's contents. The default
290             value is "<h1></h1>".
291              
292             =back
293              
294             =head1 LICENSE
295              
296             Copyright (C) Bernie Simon.
297              
298             This library is free software; you can redistribute it and/or modify
299             it under the same terms as Perl itself.
300              
301             =head1 AUTHOR
302              
303             Bernie Simon E<lt>bernie.simon@gmail.comE<gt>
304              
305             =cut