File Coverage

lib/App/Followme/FileData.pm
Criterion Covered Total %
statement 100 102 98.0
branch 18 20 90.0
condition n/a
subroutine 20 21 95.2
pod 1 10 10.0
total 139 153 90.8


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