File Coverage

blib/lib/Enterprise/Licence.pm
Criterion Covered Total %
statement 50 52 96.1
branch 2 6 33.3
condition 2 5 40.0
subroutine 15 15 100.0
pod 1 7 14.2
total 70 85 82.3


line stmt bran cond sub pod time code
1             package Enterprise::Licence;
2 2     2   97295 use utf8; use strict; use warnings; our $VERSION = '0.02';
  2     2   18  
  2     2   10  
  2         59  
  2         6  
  2         35  
  2         9  
  2         3  
  2         83  
3 2     2   1823 use DateTime; use Math::BigInt; use Compress::Huffman;
  2     2   996596  
  2     2   89  
  2         2664  
  2         53844  
  2         9  
  2         52831  
  2         11015  
  2         111  
4 2     2   904 use Shannon::Entropy qw/entropy/; use Bijection qw/all/;
  2     2   3316  
  2         25  
  2         1057  
  2         2148  
  2         15  
5              
6             sub new {
7 4     4 1 1001227 my ($pkg, $args) = (@_, {});
8 4         17 my $self = bless {}, $pkg;
9 4 50 33     34 unless ($args->{secret} && entropy($args->{secret}) > 3) {
10 0         0 die 'no secure secret passed to new';
11             }
12 4         253 $self->{secret} = $args->{secret};
13 4   50     21 $self->{increment} = $args->{increment} || 0.1;
14 4         37 my $ch = $self->huffman([split '', $args->{secret}]);
15 4         18 $self->{ch} = $ch;
16             bijection_set(
17             ($args->{offset} ? $args->{offset} : ()),
18 0         0 @{$args->{biject}}
19 4 0       12 ) if $args->{biject};
    50          
20 4         24 $self;
21             }
22              
23             sub bin2dec {
24 6     6 0 165 my $dec = $_[1];
25 6         37 return Math::BigInt->new("0b$dec");
26             }
27              
28             sub dec2bin {
29 2     2 0 8 my $i = Math::BigInt->new($_[1]);
30 2         90 return substr($i->as_bin(), 2);
31             }
32              
33             sub customer_offset {
34 4     4 0 751 my $encode = [split '', $_[1]];
35 4         13 my $ch = $_[0]->huffman($encode);
36 4         15 return $ch->encode($encode);
37             }
38              
39             sub huffman {
40 8     8 0 20 my ($self, $encode) = @_;
41 8         49 my $ch = Compress::Huffman->new();
42 8         34 my $i = $self->{increment};
43             my %symbols = map {
44             $_ => ( $i += $self->{increment} )
45 8         14 } @{$encode};
  68         206  
  8         20  
46 8         42 $ch->symbols(\%symbols, notprob => 1);
47 8         6190 return $ch;
48             }
49              
50 8     8 0 11229 sub bi { return scalar biject($_[1]); }
51 8     8 0 103 sub in { return scalar inverse($_[1]); }
52              
53             1;
54              
55             __END__
56              
57             =head1 NAME
58              
59             Enterprise::Licence - Licence or License
60              
61             =head1 VERSION
62              
63             Version 0.02
64              
65             =cut
66              
67             =head1 SYNOPSIS
68              
69             use Enterprise::Licence::Generate;
70             use Enterprise::Licence::Validate;
71              
72             my $sec = 'ab3yq34s1£f';
73             my $generator = Enterprise::Licence::Generate->new({ secret => $sec });
74              
75             my $client = 'unique';
76             my $licence = $generator->generate($client, { years => 99 });
77              
78             my $validator = Enterprise::Licence::Validate->new({ secret => $sec });
79             my @valid = $validator->valid($licence, $client);
80             # (1) == valid
81             # (0, 1) == expired
82             # (0, 0) == invalid
83              
84             =cut
85              
86             =head1 Description
87              
88             My software is white labeled and distributed into environments that I do not control. I needed a way to programmatically licence code for a set period of time 1 month trial, 5 years etc.
89              
90             =head2 The Licence
91              
92             The following is an example of a licence that this module generates:
93              
94             jQT42jKM_-gfPn32-qs49pg-lpsYxqok
95              
96             It can be broken down into 4 parts:
97              
98             =over
99              
100             =item secret + client/environment
101              
102             jQT42jKM_
103              
104             Decimal Huffman compressed secret + Decimal Huffman compressed client/environment bijected.
105              
106             =item start time
107              
108             gfPn32
109              
110             The Bijected epoch your licence is valid from.
111              
112             =item expire time
113              
114             qs49pg
115              
116             The Bijected epoch your licence is valid to.
117              
118             =item duration
119              
120             lpsYxqok
121              
122             The Bijected duration of the licence (expire time - start time) this is to validate that the licence has not been manipulated.
123              
124             =back
125              
126             =head1 Generate/Validate
127              
128             =head2 new
129              
130             Both Generate and Validate accept the same parameters to new
131              
132             =over
133              
134             =item secret
135              
136             A string that should have an entropy greater than 3. This value is meant to be set at application level, hidden in compiled abstracted code.
137              
138             =item increment
139              
140             A float that will be used to build the huffman symbols table.
141              
142             =item biject
143              
144             An array reference that is passed to bijection_set.
145              
146             =item offset
147              
148             An offset that is passed to bijection_set.
149              
150             =back
151              
152             =head2 generate
153              
154             To generate a licence it as simple as the following:
155              
156             my $generator = Enterprise::Licence::Generate->new({ secret => $secret });
157             my $licence = $generator->generate('world-wide', { months => 1 });
158              
159             =over
160              
161             =item client/environment
162              
163             The first param to generate should be your environment/client identifier.
164              
165             =item duration
166              
167             The second param should be a valid reference that can be passed to DateTime->add().
168              
169             =back
170              
171             =cut
172              
173             =head2 validate
174              
175             To validate a licence:
176              
177             my $validator = Enterprise::Licence::Validate->new({ secret => $secret });
178             my @valid = $validator->valid($licence, 'world-wide');
179             # (1) == The licence is valid
180             # (0, 1) == The licence is valid but it has expired
181             # (0, 0) == The licence is invalid.
182              
183             =over
184              
185             =item client/environment
186              
187             The first param to validate should be the licence string.
188              
189             =item duration
190              
191             The second param to validate should be your environment/client identifier.
192              
193             =back
194              
195             =cut
196              
197             =head1 AUTHOR
198              
199             LNATION, C<< <thisusedtobeanemail at gmail.com> >>
200              
201             =head1 BUGS
202              
203             Please report any bugs or feature requests to C<bug-enterprise-licence at rt.cpan.org>, or through
204             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Enterprise-Licence>. I will be notified, and then you'll
205             automatically be notified of progress on your bug as I make changes.
206              
207             =head1 SUPPORT
208              
209             You can find documentation for this module with the perldoc command.
210              
211             perldoc Enterprise::Licence
212              
213              
214             You can also look for information at:
215              
216             =over 4
217              
218             =item * RT: CPAN's request tracker (report bugs here)
219              
220             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Enterprise-Licence>
221              
222             =item * AnnoCPAN: Annotated CPAN documentation
223              
224             L<http://annocpan.org/dist/Enterprise-Licence>
225              
226             =item * CPAN Ratings
227              
228             L<http://cpanratings.perl.org/d/Enterprise-Licence>
229              
230             =item * Search CPAN
231              
232             L<http://search.cpan.org/dist/Enterprise-Licence/>
233              
234             =back
235              
236              
237             =head1 ACKNOWLEDGEMENTS
238              
239              
240             =head1 LICENSE AND COPYRIGHT
241              
242             Copyright 2019 LNATION.
243              
244             This program is free software; you can redistribute it and/or modify it
245             under the terms of the the Artistic License (2.0). You may obtain a
246             copy of the full license at:
247              
248             L<http://www.perlfoundation.org/artistic_license_2_0>
249              
250             Any use, modification, and distribution of the Standard or Modified
251             Versions is governed by this Artistic License. By using, modifying or
252             distributing the Package, you accept this license. Do not use, modify,
253             or distribute the Package, if you do not accept this license.
254              
255             If your Modified Version has been derived from a Modified Version made
256             by someone other than you, you are nevertheless required to ensure that
257             your Modified Version complies with the requirements of this license.
258              
259             This license does not grant you the right to use any trademark, service
260             mark, tradename, or logo of the Copyright Holder.
261              
262             This license includes the non-exclusive, worldwide, free-of-charge
263             patent license to make, have made, use, offer to sell, sell, import and
264             otherwise transfer the Package with respect to any patent claims
265             licensable by the Copyright Holder that are necessarily infringed by the
266             Package. If you institute patent litigation (including a cross-claim or
267             counterclaim) against any party alleging that the Package constitutes
268             direct or contributory patent infringement, then this Artistic License
269             to you shall terminate on the date that such litigation is filed.
270              
271             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
272             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
273             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
274             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
275             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
276             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
277             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
278             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
279              
280              
281             =cut
282              
283             1; # End of Enterprise::Licence