File Coverage

lib/App/Followme/EditSections.pm
Criterion Covered Total %
statement 94 103 91.2
branch 29 36 80.5
condition 2 6 33.3
subroutine 14 15 93.3
pod 2 8 25.0
total 141 168 83.9


line stmt bran cond sub pod time code
1             package App::Followme::EditSections;
2              
3 1     1   621 use 5.008005;
  1         22  
4 1     1   5 use strict;
  1         2  
  1         34  
5 1     1   5 use warnings;
  1         8  
  1         40  
6              
7 1     1   5 use lib '../..';
  1         16  
  1         60  
8              
9 1     1   158 use base qw(App::Followme::Module);
  1         1  
  1         502  
10              
11 1     1   7 use File::Spec::Functions qw(catfile);
  1         3  
  1         44  
12 1     1   5 use App::Followme::FIO;
  1         2  
  1         1097  
13              
14             our $VERSION = "2.03";
15              
16             #----------------------------------------------------------------------
17             # Read the default parameter values
18              
19             sub parameters {
20 16     16 1 25 my ($pkg) = @_;
21              
22             return (
23 16         44 remove_comments => 0,
24             data_pkg => 'App::Followme::WebData',
25             );
26             }
27              
28             #----------------------------------------------------------------------
29             # Modify pages to match the most recently modified page
30              
31             sub run {
32 0     0 0 0 my ($self, $folder) = @_;
33              
34 0         0 $self->update_folder($folder);
35 0         0 return;
36             }
37              
38             #----------------------------------------------------------------------
39             # Find the location of a string in a page
40              
41             sub find_location {
42 42     42 0 89 my ($self, $page, $prototype, $propos, $after) = @_;
43              
44 42         47 my $hi;
45 42         56 my $lo = 0;
46 42         59 my $mid = 8;
47              
48 42   33     111 while ($mid > $lo && (! defined $hi || $mid < $hi)) {
      33        
49 49         62 my $str;
50 49 100       71 if ($after) {
51 21         36 $str = substr($prototype, $propos, $mid)
52             } else {
53 28 50       48 $mid = $propos if $mid > $propos;
54 28         56 $str = substr($prototype, $propos-$mid, $mid);
55             }
56              
57 49         59 my $count = 0;
58 49         54 my $pagepos = -1;
59 49         89 while ($count < 2) {
60 98         171 my $newpos = index($page, $str, $pagepos+1);
61 98 100       170 last unless $newpos > $pagepos;
62              
63 56         72 $count ++;
64 56         98 $pagepos = $newpos;
65             }
66              
67 49 100       95 if ($count > 1) {
    50          
68 7         11 $lo = $mid;
69 7 50       19 if (defined $hi) {
70 0         0 $mid = int(0.5 * ($mid + $hi));
71             } else {
72 7         22 $mid = 2 * $mid;
73             }
74              
75             } elsif ($count == 1) {
76 42 100       74 $pagepos += $mid unless $after;
77 42         75 return $pagepos;
78              
79             } else {
80 0         0 $hi = $mid;
81 0         0 $mid = int(0.5 * ($mid + $lo));
82             }
83             }
84              
85 0         0 return;
86             }
87              
88             #----------------------------------------------------------------------
89             # Initialize the extension
90              
91             sub setup {
92 4     4 1 9 my ($self) = @_;
93              
94 4         8 $self->{extension} = $self->{web_extension};
95 4         7 return;
96             }
97              
98             #----------------------------------------------------------------------
99             # Read page and strip comments
100              
101             sub strip_comments {
102 13     13 0 2232 my ($self, $file, $keep_sections) = @_;
103              
104 13         36 my $page = fio_read_page($file);
105 13 50       42 die "Could not read page" unless length($page);
106              
107 13         21 my @output;
108 13         164 my @tokens = split(/(<!--.*?-->)/, $page);
109              
110 13         35 foreach my $token (@tokens) {
111 169 100       803 if ($token !~ /^(<!--.*?-->)$/) {
    100          
112 91         174 push(@output, $token);
113             } elsif ($token =~ /(<!--\s*end)?section\s+.*?-->/) {
114 24 100       53 push(@output, $token) if $keep_sections;
115             } else {
116 54 100       143 push(@output, $token) unless $self->{remove_comments};
117             }
118             }
119              
120 13         91 return join('', @output);
121             }
122              
123             #----------------------------------------------------------------------
124             # Strip file of comments and combine with prototype
125              
126             sub update_file {
127 7     7 0 14 my ($self, $file, $prototype) = @_;
128              
129 7         16 my $page = $self->strip_comments($file, 0);
130 7         19 $page = $self->update_page($page, $prototype);
131 7         27 fio_write_page($file, $page);
132              
133 7         18 return;
134             }
135              
136             #----------------------------------------------------------------------
137             # Parse prototype and page and combine them
138              
139             sub update_page {
140 7     7 0 16 my ($self, $page, $prototype) = @_;
141              
142 7         11 my @output;
143             my $notfound;
144 7         37 while ($prototype =~ /(<!--\s*(?:end)?section\s+.*?-->)/g) {
145 42         101 my $comment = $1;
146 42         55 my $pos = pos($prototype);
147 42         87 my $after = $comment =~ /<!--\s*end/;
148              
149             # locate the position of the comment from the prototype in the page
150 42 100       74 $pos = $pos - length($comment) unless $after;
151 42         85 my $loc = $self->find_location($page, $prototype, $pos, $after);
152              
153 42 50       77 unless (defined $loc) {
154 0         0 $notfound ++;
155 0         0 $loc= 0;
156             }
157              
158             # substitute comment into page
159 42 100       90 $comment = $after ? "\n$comment" : "$comment\n";
160 42         89 push(@output, substr($page, 0, $loc), $comment);
161 42         183 $page = substr($page, $loc);
162             }
163              
164 7         14 push(@output, $page);
165              
166 7 50       13 die "Could not locate tags\n" if $notfound;
167              
168 7         34 return join('', @output);
169             }
170              
171             #----------------------------------------------------------------------
172             # Edit all files in the directory
173              
174             sub update_folder {
175 2     2 0 9 my ($self, $folder, $prototype_file, $prototype) = @_;
176              
177 2         12 my $index_file = $self->to_file($folder);
178 2         15 my $files = $self->{data}->build('files_by_mdate_reversed', $index_file);
179              
180 2 100       6 unless (defined $prototype_file) {
181 1 50       3 if (@$files) {
182 1         2 $prototype_file = shift(@$files);
183 1         3 $prototype = $self->strip_comments($prototype_file, 1);
184             }
185             }
186              
187 2         4 foreach my $file (@$files) {
188 7         27 eval {$self->update_file($file, $prototype)};
  7         19  
189 7         47 $self->check_error($@, $folder);
190             }
191              
192 2         9 my $folders = $self->{data}->build('folders', $index_file);
193 2         6 for my $subfolder (@$folders) {
194 1         6 $self->update_folder($subfolder, $prototype_file, $prototype);
195             }
196              
197 2         6 return;
198             }
199              
200             1;
201             __END__
202              
203             =encoding utf-8
204              
205             =head1 NAME
206              
207             App::Followme::EditSections - Edit the section tags on an html page
208              
209             =head1 SYNOPSIS
210              
211             use App::Followme::EditSection;
212             my $edit = App::Followme::EditSection->new();
213             $edit->run($directory);
214              
215             =head1 DESCRIPTION
216              
217             Followme distinguishes between sections of a web page which are the same across
218             the website and sections that differ between each page by html comments starting
219             with section and endsection. This module modifies the placement or number of these
220             tags across a website. It can also used to modify an existing website so it
221             can be maintained by followme. Before running followme with this module, edit a
222             page and put the section and endsection comments in the proper locations. Then
223             create a configuration file containing the name of this module. Then run followme
224             and it will modify all the pages of the website to include the same comments. Any
225             section and endsection tags that were previously in the file will be removed.
226              
227             =head1 CONFIGURATION
228              
229             The following field in the configuration file are used:
230              
231             =over 4
232              
233             =item remove_comments
234              
235             Remove all html comments that are in a file, not just the section and endsection
236             tags.
237              
238             =item data_pkg
239              
240             The package used to retrieve information from each file. The default value is
241             'App::Followme::WebData'.
242              
243             =back
244              
245             =head1 LICENSE
246              
247             Copyright (C) Bernie Simon.
248              
249             This library is free software; you can redistribute it and/or modify
250             it under the same terms as Perl itself.
251              
252             =head1 AUTHOR
253              
254             Bernie Simon E<lt>bernie.simon@gmail.comE<gt>
255              
256             =cut