File Coverage

lib/CodeGen/Protection/Format/Perl.pm
Criterion Covered Total %
statement 17 20 85.0
branch 4 8 50.0
condition n/a
subroutine 5 5 100.0
pod n/a
total 26 33 78.7


line stmt bran cond sub pod time code
1             package CodeGen::Protection::Format::Perl;
2              
3             # ABSTRACT: Safely rewrite parts of Perl documents
4              
5 4     4   280449 use Moo;
  4         30478  
  4         21  
6 4     4   6853 use Carp 'croak';
  4         7  
  4         1187  
7             with qw(CodeGen::Protection::Role);
8              
9             our $VERSION = '0.04';
10              
11             sub _tidy {
12 19     19   45 my ( $self, $code ) = @_;
13 19 100       99 return $code unless my $perltidy = $self->tidy;
14 5         3715 require Perl::Tidy;
15 5         991789 my @perltidy;
16 5 50       26 if ( '1' ne $perltidy ) {
17 0 0       0 unless ( -e $perltidy ) {
18 0         0 croak("Cannot find perltidyrc file: $perltidy");
19             }
20 0         0 @perltidy = ( perltidyrc => $perltidy );
21             }
22              
23 5         15 my ( $stderr, $tidied );
24              
25             # need to clear @ARGV or else Perl::Tidy thinks you're trying
26             # to provide a filename and dies
27 5         14 local @ARGV;
28 5 50       31 Perl::Tidy::perltidy(
29             source => \$code,
30             destination => \$tidied,
31             stderr => \$stderr,
32             @perltidy,
33             ) and die "Perl::Tidy error: $stderr";
34              
35 5         509876 return $tidied;
36             }
37              
38             # For both the _start_marker_format() and the _end_marker_format(), the first
39             # '%s' is the version number if it's being added to the document. It's a
40             # version regex (_version_re()) if it's being used to match the start or end
41             # marker.
42              
43             # The second '%s' is the md5 sum if it's being added to the document. It's a
44             # captured md5 regex ([0-9a-f]{32}) if it's being used to match the start or
45             # end marker.
46              
47             sub _start_marker_format {
48 60     60   174 '#<<< %s %s. Do not touch any code between this and the end comment. Checksum: %s';
49             }
50              
51             sub _end_marker_format {
52 60     60   160 '#>>> %s %s. Do not touch any code between this and the start comment. Checksum: %s';
53             }
54              
55             1;
56              
57             __END__
58              
59             =pod
60              
61             =encoding UTF-8
62              
63             =head1 NAME
64              
65             CodeGen::Protection::Format::Perl - Safely rewrite parts of Perl documents
66              
67             =head1 VERSION
68              
69             version 0.04
70              
71             =head1 SYNOPSIS
72              
73             my $rewrite = CodeGen::Protection::Format::Perl->new(
74             protected_code => $text,
75             );
76             say $rewrite->rewritten;
77              
78             my $rewrite = CodeGen::Protection::Format::Perl->new(
79             existing_code => $existing_code,
80             protected_code => $protected_code,
81             );
82             say $rewrite->rewritten;
83              
84             =head1 DESCRIPTION
85              
86             This module allows you to do a safe partial rewrite of documents. If you're
87             familiar with L<DBIx::Class::Schema::Loader>, you probably know the basic
88             concept.
89              
90             Note that this code is designed for Perl documents and is not very
91             configurable.
92              
93             In short, we wrap your "protected" (C<protected_code>) Perl code in start and
94             end comments, with checksums for the code:
95              
96             #<<< CodeGen::Protection::Format::Perl 0.01. Do not touch any code between this and the end comment. Checksum: fa97a021bd70bf3b9fa3e52f203f2660
97            
98             # protected code goes here
99              
100             #>>> CodeGen::Protection::Format::Perl 0.01. Do not touch any code between this and the start comment. Checksum: fa97a021bd70bf3b9fa3e52f203f2660
101              
102             If C<existing_code> is provided, this module removes the code between the old
103             code's start and end markers and replaces it with the C<protected_code>. If
104             the code between the start and end markers has been altered, it will no longer
105             match the checksums and rewriting the code will fail.
106              
107             =head1 CONSTRUCTOR
108              
109             my $rewrite = CodeGen::Protection::Format::Perl->new(
110             protected_code => $protected_code, # required
111             existing_code => $existing_code, # optional
112             perltidy => 1, # optional
113             name => $name, # optional
114             overwrite => 0, # optional
115             );
116              
117             The constructor only requires that C<protected_code> be passed in.
118              
119             =over 4
120              
121             =item * C<protected_code>
122              
123             This is a required string containing any new Perl code to be built with this
124             tool. If C<protected_code> is passed in an C<existing_code> is not, we're in "Creation
125             mode" (see L<#Modes>) and the new Perl code must I<not> have start and end
126             markers generated by this tool.
127              
128             =item * C<existing_code>
129              
130             This is an optional string containing Perl code already built with this tool.
131             If provided, this code I<must> have the start and end markers generated by
132             this tool so that the rewriter knows the section of code to replace with the
133             injected code.
134              
135             =item * C<name>
136              
137             Optional name for the code. This is only used in error messages if you're
138             generating a lot of code and an error occurs and you'd like to see the name
139             in the error.
140              
141             =item * C<perltidy>
142              
143             If true, will attempt to run L<Perl::Tidy> on the code between the start and
144             end markers. If the value of perltidy is the number 1 (one), then a generic
145             pass of L<Perl::Tidy> will be done on the code. If the value is true and
146             anything I<other> than one, this is assumed to be the path to a F<.perltidyrc>
147             file and that will be used to tidy the code (or C<croak()> if the
148             F<.perltidyrc> file cannot be found).
149              
150             =item * C<overwrite>
151              
152             Optional boolean, default false. In "Rewrite mode", if the checksum in the
153             start and end markers doesn't match the code within them, someone has manually
154             altered that code and we do not automatically overwrite it (in fact, we
155             C<croak()>). Setting C<overwrite> to true will cause it to be overwritten.
156              
157             =back
158              
159             =head1 MODES
160              
161             There are two modes: "Creation" and "Rewrite."
162              
163             =head2 Creation Mode
164              
165             my $rewrite = CodeGen::Protection::Format::Perl->new(
166             protected_code => $text,
167             );
168             say $rewrite->rewritten;
169              
170             If you create an instance with C<protected_code> but not old text, this will wrap
171             the new text in start and end tags that "protect" the document if you rewrite
172             it:
173              
174             my $perl = <<'END';
175             sub sum {
176             my $total = 0;
177             $total += $_ foreach @_;
178             return $total;
179             }
180             END
181             my $rewrite = CodeGen::Protection::Format::Perl->new( protected_code => $perl );
182             say $rewrite->rewritten;
183              
184             Output:
185              
186             #<<< CodeGen::Protection::Format::Perl 0.01. Do not touch any code between this and the end comment. Checksum: fa97a021bd70bf3b9fa3e52f203f2660
187              
188             sub sum {
189             my $total = 0;
190             $total += $_ foreach @_;
191             return $total;
192             }
193              
194             #>>> CodeGen::Protection::Format::Perl 0.01. Do not touch any code between this and the start comment. Checksum: fa97a021bd70bf3b9fa3e52f203f2660
195              
196             You can then take the marked up document and insert it into another Perl
197             document and use the rewrite mode to safely rewrite the code between the start
198             and end markers. The rest of the document will be ignored.
199              
200             Note that leading and trailing comments start with C<< #<<< >> and C<< #>>> >>
201             respectively. Those are special comments which tell L<Perl::Tidy> to ignore
202             what ever is between them. Thus, you can safely tidy code written with this.
203              
204             The start and end checksums are the same and are the checksum of the text
205             between the comments. Leading and trailing lines which are all whitespace are
206             removed and one leading and one trailing newline will be added.
207              
208             =head2 Rewrite Mode
209              
210             Given a document created with the "Creating" mode, you can then take the
211             marked up document and insert it into another Perl document and use the
212             rewrite mode to safely rewrite the code between the start and end markers.
213             The rest of the document will be ignored.
214              
215             my $rewrite = CodeGen::Protection::Format::Perl->new(
216             existing_code => $existing_code,
217             protected_code => $protected_code,
218             );
219             say $rewrite->rewritten;
220              
221             In the above, assuming that C<$existing_code> is a rewritable document, the
222             C<$protected_code> will replace the rewritable section of the C<$existing_code>, leaving
223             the rest unchanged.
224              
225             However, if C<$protected_code> is I<also> a rewritable document, then the rewritable
226             portion of the C<$protected_code> will be extract and used to replace the rewritable
227             portion of the C<$existing_code>.
228              
229             So for the code shown in the "Creation mode" section, you could add more code
230             like this:
231              
232             package My::Package;
233              
234             use strict;
235             use warnings;
236              
237             sub average {
238             return sum(@_)/@_;
239             }
240              
241             #<<< CodeGen::Protection::Format::Perl 0.01. Do not touch any code between this and the end comment. Checksum: fa97a021bd70bf3b9fa3e52f203f2660
242              
243             sub sum {
244             my $total = 0;
245             $total += $_ foreach @_;
246             return $total;
247             }
248              
249             #>>> CodeGen::Protection::Format::Perl 0.01. Do not touch any code between this and the start comment. Checksum: fa97a021bd70bf3b9fa3e52f203f2660
250            
251             1;
252              
253             However, later on I might realize that the C<sum> function will happily try to
254             sum things which are not numbers, so I want to fix that. I'll slurp the C<My::Package> code
255             into the C<$existing_code> variable and then:
256              
257             my $perl = <<'END';
258             use Scalar::Util 'looks_like_number';
259              
260             sub sum {
261             my $total = 0;
262             foreach my $number (@_) {
263             unless (looks_like_number($number)) {
264             die "'$number' doesn't look like a numbeer!";
265             }
266             $total += $number;
267             }
268             return $total;
269             }
270             END
271             my $rewrite = CodeGen::Protection::Format::Perl->new( existing_code => $existing_code, protected_code => $perl );
272             say $rewrite->rewritten;
273              
274             And that will print out:
275              
276             package My::Package;
277            
278             use strict;
279             use warnings;
280            
281             sub average {
282             return sum(@_)/@_;
283             }
284            
285             #<<< CodeGen::Protection::Format::Perl 0.01. Do not touch any code between this and the end comment. Checksum: d135a051f158ee19fbd68af5466fb1ae
286            
287             use Scalar::Util 'looks_like_number';
288            
289             sub sum {
290             my $total = 0;
291             foreach my $number (@_) {
292             unless (looks_like_number($number)) {
293             die "'$number' doesn't look like a numbeer!";
294             }
295             $total += $number;
296             }
297             return $total;
298             }
299            
300             #>>> CodeGen::Protection::Format::Perl 0.01. Do not touch any code between this and the start comment. Checksum: d135a051f158ee19fbd68af5466fb1ae
301            
302             1;
303              
304             You can see that the code between the start and end checksum comments and been
305             rewritten, while the rest of the code remains unchanged.
306              
307             =head1 AUTHOR
308              
309             Curtis "Ovid" Poe <ovid@allaroundtheworld.fr>
310              
311             =head1 COPYRIGHT AND LICENSE
312              
313             This software is copyright (c) 2021 by Curtis "Ovid" Poe.
314              
315             This is free software; you can redistribute it and/or modify it under
316             the same terms as the Perl 5 programming language system itself.
317              
318             =cut