File Coverage

blib/lib/Software/License/Custom.pm
Criterion Covered Total %
statement 50 54 92.5
branch 11 18 61.1
condition 1 2 50.0
subroutine 16 17 94.1
pod 12 12 100.0
total 90 103 87.3


line stmt bran cond sub pod time code
1 9     9   82636 use strict;
  9         26  
  9         214  
2 9     9   43 use warnings;
  9         15  
  9         331  
3             # ABSTRACT: custom license handler
4             $Software::License::Custom::VERSION = '0.104002';
5             use parent 'Software::License';
6 9     9   381  
  9         253  
  9         47  
7             use Carp;
8 9     9   419 use Text::Template;
  9         13  
  9         516  
9 9     9   47  
  9         14  
  9         5024  
10             #pod =head1 DESCRIPTION
11             #pod
12             #pod This module extends L<Software::License> to give the possibility of specifying
13             #pod all aspects related to a software license in a custom file. This allows for
14             #pod setting custom dates, notices, etc. while still preserving compatibility with
15             #pod all places where L<Software::License> is used, e.g. L<Dist::Zilla>.
16             #pod
17             #pod In this way, you should be able to customise some aspects of the licensing
18             #pod messages that would otherwise be difficult to tinker, e.g. adding a note
19             #pod in the notice, setting multiple years for the copyright notice or set multiple
20             #pod authors and/or copyright holders.
21             #pod
22             #pod The license details should be put inside a file that contains different
23             #pod sections. Each section has the following format:
24             #pod
25             #pod =begin :list
26             #pod
27             #pod = header line
28             #pod
29             #pod This is a line that begins and ends with two underscores C<__>. The string
30             #pod between the begin and the end of the line is first depured of any non-word
31             #pod character, then used as the name of the section;
32             #pod
33             #pod = body
34             #pod
35             #pod a L<Text::Template> (possibly a plain text file) where items to be
36             #pod expanded are enclosed between double braces
37             #pod
38             #pod =end :list
39             #pod
40             #pod Each section is terminated by the header of the following section or by
41             #pod the end of the file. Example:
42             #pod
43             #pod __[ NAME ]__
44             #pod The Foo-Bar License
45             #pod __URL__
46             #pod http://www.example.com/foo-bar.txt
47             #pod __[ META_NAME ]__
48             #pod foo_bar_meta
49             #pod __{ META2_NAME }__
50             #pod foo_bar_meta2
51             #pod __{ SPDX_EXPRESSION }__
52             #pod foo_bar_spdx_expression
53             #pod __[ NOTICE ]__
54             #pod Copyright (C) 2000-2002 by P.R. Evious
55             #pod Copyright (C) {{$self->year}} by {{$self->holder}}.
56             #pod
57             #pod This is free software, licensed under {{$self->name}}.
58             #pod
59             #pod __[ LICENSE ]__
60             #pod The Foo-Bar License
61             #pod
62             #pod Well... this is only some sample text. Verily... only sample text!!!
63             #pod
64             #pod Yes, spanning more lines and more paragraphs.
65             #pod
66             #pod The different formats for specifying the section name in the example
67             #pod above are only examples, you're invited to use a consistent approach.
68             #pod
69             #pod =method new
70             #pod
71             #pod my $slc = Software::License::Custom->new({filename => 'LEGAL'});
72             #pod
73             #pod Create a new object. Arguments are passed through an anonymous hash, the
74             #pod following keys are allowed:
75             #pod
76             #pod filename - the file where the custom software license details are stored
77             #pod
78             #pod =cut
79              
80             my ($class, $arg) = @_;
81              
82 1     1 1 95 my $filename = delete $arg->{filename};
83              
84 1         10 my $self = $class->SUPER::new($arg);
85              
86 1         7 $self->load_sections_from($filename) if defined $filename;
87              
88 1 50       4 return $self;
89             }
90 1         3  
91             #pod =method load_sections_from
92             #pod
93             #pod $slc->load_sections_from('MY-LEGAL-ASPECTS');
94             #pod
95             #pod Loads the different sections of the license from the provided filename.
96             #pod
97             #pod Returns the input object.
98             #pod
99             #pod =cut
100              
101             my ($self, $filename) = @_;
102              
103             # Sections are kept inside a hash
104 1     1 1 2 $self->{'Software::License::Custom'}{section_for} = \my %section_for;
105              
106             my $current_section = '';
107 1         4 open my $fh, '<', $filename or croak "open('$filename'): $!";
108              
109 1         2 while (<$fh>) {
110 1 50       61 if (my ($section) = m{\A __ (.*) __ \n\z}mxs) {
111             ($current_section = $section) =~ s/\W+//gmxs;
112 1         439 }
113 20 100       46 else {
114 6         24 $section_for{$current_section} .= $_;
115             }
116             }
117 14         34 close $fh;
118              
119             # strip last newline from all items
120 1         11 s{\n\z}{}mxs for values %section_for;
121              
122             return $self;
123 1         13 }
124              
125 1         4 #pod =method section_data
126             #pod
127             #pod my $notice_template_reference = $slc->section_data('NOTICE');
128             #pod
129             #pod Returns a reference to a textual template that can be fed to
130             #pod L<Text::Template> (it could be simple text), according to what is
131             #pod currently loaded in the object.
132             #pod
133             #pod =cut
134              
135             my ($self, $name) = @_;
136             my $section_for = $self->{'Software::License::Custom'}{section_for} ||= {};
137             return unless exists $section_for->{$name};
138             return unless defined $section_for->{$name};
139 31     31 1 53 return \$section_for->{$name};
140 31   50     208 }
141 10 50       18  
142 10 50       57 #pod =head1 MORE METHODS
143 10         27 #pod
144             #pod The following methods, found in all software license classes, look up and
145             #pod render the template with the capitalized form of their name. In other words,
146             #pod the C<license> method looks in the C<LICENSE> template.
147             #pod
148             #pod For now, the C<meta_name> and C<meta2_name> methods return C<custom> if called
149             #pod on the class. This may become fatal in the future.
150             #pod
151             #pod =for :list
152             #pod * name
153             #pod * url
154             #pod * meta_name
155             #pod * meta2_name
156             #pod * license
157             #pod * notice
158             #pod * fulltext
159             #pod * version
160             #pod
161             #pod =cut
162              
163              
164             my $self = shift;
165             return 'custom' unless ref $self;
166             return $self->_fill_in('META_NAME')
167 24     24 1 658 }
168 1     1 1 922  
169             my $self = shift;
170             return 'custom' unless ref $self;
171 44     44 1 811 $self->_fill_in('META2_NAME')
172 44 100       146 }
173 1         3  
174             my $self = shift;
175             return undef unless ref $self;
176             return $self->_fill_in('SPDX_EXPRESSION')
177 43     43 1 792 }
178 43 100       102  
179 1         3  
180             my ($self) = @_;
181             return join "\n", $self->notice, $self->license;
182             }
183 21     21 1 30  
184 21 50       71 my ($self) = @_;
185 0         0 return unless $self->section_data('VERSION');
186             return $self->_fill_in('VERSION')
187             }
188 2     2 1 1310  
189 2     2 1 853 1;
190              
191              
192 1     1 1 843 =pod
193 1         3  
194             =encoding UTF-8
195              
196             =head1 NAME
197 0     0 1    
198 0 0         Software::License::Custom - custom license handler
199 0            
200             =head1 VERSION
201              
202             version 0.104002
203              
204             =head1 DESCRIPTION
205              
206             This module extends L<Software::License> to give the possibility of specifying
207             all aspects related to a software license in a custom file. This allows for
208             setting custom dates, notices, etc. while still preserving compatibility with
209             all places where L<Software::License> is used, e.g. L<Dist::Zilla>.
210              
211             In this way, you should be able to customise some aspects of the licensing
212             messages that would otherwise be difficult to tinker, e.g. adding a note
213             in the notice, setting multiple years for the copyright notice or set multiple
214             authors and/or copyright holders.
215              
216             The license details should be put inside a file that contains different
217             sections. Each section has the following format:
218              
219             =over 4
220              
221             =item header line
222              
223             This is a line that begins and ends with two underscores C<__>. The string
224             between the begin and the end of the line is first depured of any non-word
225             character, then used as the name of the section;
226              
227             =item body
228              
229             a L<Text::Template> (possibly a plain text file) where items to be
230             expanded are enclosed between double braces
231              
232             =back
233              
234             Each section is terminated by the header of the following section or by
235             the end of the file. Example:
236              
237             __[ NAME ]__
238             The Foo-Bar License
239             __URL__
240             http://www.example.com/foo-bar.txt
241             __[ META_NAME ]__
242             foo_bar_meta
243             __{ META2_NAME }__
244             foo_bar_meta2
245             __{ SPDX_EXPRESSION }__
246             foo_bar_spdx_expression
247             __[ NOTICE ]__
248             Copyright (C) 2000-2002 by P.R. Evious
249             Copyright (C) {{$self->year}} by {{$self->holder}}.
250              
251             This is free software, licensed under {{$self->name}}.
252              
253             __[ LICENSE ]__
254             The Foo-Bar License
255              
256             Well... this is only some sample text. Verily... only sample text!!!
257              
258             Yes, spanning more lines and more paragraphs.
259              
260             The different formats for specifying the section name in the example
261             above are only examples, you're invited to use a consistent approach.
262              
263             =head1 PERL VERSION
264              
265             This module is part of CPAN toolchain, or is treated as such. As such, it
266             follows the agreement of the Perl Toolchain Gang to require no newer version of
267             perl than v5.8.1. This version may change by agreement of the Toolchain Gang,
268             but for now is governed by the L<Lancaster
269             Consensus|https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/master/lancaster-consensus.md>
270             of 2013.
271              
272             =head1 METHODS
273              
274             =head2 new
275              
276             my $slc = Software::License::Custom->new({filename => 'LEGAL'});
277              
278             Create a new object. Arguments are passed through an anonymous hash, the
279             following keys are allowed:
280              
281             filename - the file where the custom software license details are stored
282              
283             =head2 load_sections_from
284              
285             $slc->load_sections_from('MY-LEGAL-ASPECTS');
286              
287             Loads the different sections of the license from the provided filename.
288              
289             Returns the input object.
290              
291             =head2 section_data
292              
293             my $notice_template_reference = $slc->section_data('NOTICE');
294              
295             Returns a reference to a textual template that can be fed to
296             L<Text::Template> (it could be simple text), according to what is
297             currently loaded in the object.
298              
299             =head1 MORE METHODS
300              
301             The following methods, found in all software license classes, look up and
302             render the template with the capitalized form of their name. In other words,
303             the C<license> method looks in the C<LICENSE> template.
304              
305             For now, the C<meta_name> and C<meta2_name> methods return C<custom> if called
306             on the class. This may become fatal in the future.
307              
308             =over 4
309              
310             =item *
311              
312             name
313              
314             =item *
315              
316             url
317              
318             =item *
319              
320             meta_name
321              
322             =item *
323              
324             meta2_name
325              
326             =item *
327              
328             license
329              
330             =item *
331              
332             notice
333              
334             =item *
335              
336             fulltext
337              
338             =item *
339              
340             version
341              
342             =back
343              
344             =head1 AUTHOR
345              
346             Ricardo Signes <rjbs@semiotic.systems>
347              
348             =head1 COPYRIGHT AND LICENSE
349              
350             This software is copyright (c) 2022 by Ricardo Signes.
351              
352             This is free software; you can redistribute it and/or modify it under
353             the same terms as the Perl 5 programming language system itself.
354              
355             =cut