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 |