File Coverage

blib/lib/Crypt/Image.pm
Criterion Covered Total %
statement 6 8 75.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 9 11 81.8


line stmt bran cond sub pod time code
1             package Crypt::Image;
2              
3             $Crypt::Image::VERSION = '0.10';
4             $Crypt::Image::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Crypt::Image - Interface to hide text into an image.
9              
10             =head1 VERSION
11              
12             Version 0.10
13              
14             =cut
15              
16 1     1   12748 use 5.006;
  1         2  
17 1     1   493 use Data::Dumper;
  1         6239  
  1         42  
18              
19 1     1   172 use GD::Image;
  0            
  0            
20             use Math::Random;
21             use POSIX qw/floor/;
22             use Crypt::Image::Util;
23             use Types::Standard qw(Int);
24             use Crypt::Image::Params qw(FileType FilePath);
25              
26             use Moo;
27             use namespace::clean;
28              
29             =head1 DESCRIPTION
30              
31             It requires key image and a text message to start with. The text message is
32             scattered through out the image and gaps are filled with random trash.RGB is used
33             to hide the text message well from any algorithm that searches for similarities
34             between 2 or more images which are generated by the same key.The UTF char code is
35             randomly distributed between the R, G and B, which then gets added / substracted
36             from the original RGB. So even if the same key image is used to encrypt the same
37             text, it will look different from previously encrypted images and actual data
38             pixels are unrecognizable from trash data,which also changes randomly every time.
39              
40             =cut
41              
42             our $INTENSITY = 30;
43              
44             has 'width' => (is => 'ro', isa => Int);
45             has 'height' => (is => 'ro', isa => Int);
46             has 'file' => (is => 'ro', isa => FilePath, required => 1);
47             has 'type' => (is => 'ro', isa => FileType, default => sub { return 'png'; });
48             has 'bytes' => (is => 'rw', isa => Int);
49             has 'countc' => (is => 'rw', isa => Int);
50              
51             =head1 CONSTRUCTOR
52              
53             The constructor takes at the least the location key image,currently only supports
54             PNG format. Make sure your key image is not TOO BIG. Please refer to the image
55             key.png supplied with the package tar ball to give you a start.
56              
57             use strict; use warnings;
58             use Crypt::Image;
59              
60             my $crypter = Crypt::Image->new(file => 'your_key_image.png');
61              
62             =cut
63              
64             sub BUILD {
65             my ($self) = @_;
66              
67             $self->{key} = GD::Image->new($self->{file});
68             $self->{width} = $self->{key}->width;
69             $self->{height} = $self->{key}->height;
70             $self->{bytes} = ($self->{width} * $self->{height}) - 2;
71             GD::Image->trueColor(1);
72             }
73              
74             =head1 METHODS
75              
76             =head2 encrypt($message, $encrypted_image_name)
77              
78             Encrypts the key image (of type PNG currently) with the given text and save it as
79             the new image by the given file name. The length of the given text depends on
80             height and width of the key image given in the constructor.It should not be longer
81             than (width*height)-2.
82              
83             use strict; use warnings;
84             use Crypt::Image;
85              
86             my $crypter = Crypt::Image->new(file => 'your_key_image.png');
87             $crypter->encrypt('Hello World', 'your_new_encrypted_image.png');
88              
89             =cut
90              
91             sub encrypt {
92             my ($self, $text, $file) = @_;
93              
94             die("ERROR: Encryption text is missing.\n") unless defined $text;
95             die("ERROR: Decrypted file name is missing.\n") unless defined $file;
96             die("ERROR: Encryption text is too long.\n") if ($self->{bytes} < length($text));
97              
98             my ($width, $height, $allowed, $count);
99             $self->{copy} = Crypt::Image::Util::cloneImage($self->{key});
100             $allowed = int(floor($self->{bytes}/length($text)));
101             $self->_encryptAllowed($allowed, 1, 1);
102             $self->{countc} = 0;
103             $count = 0;
104              
105             foreach $width (0..$self->{width}-1) {
106             foreach $height (0..$self->{height}-1) {
107             unless (($width == 1) && ($height == 1)) {
108             $count++;
109             if ($count == $allowed) {
110             $self->_encrypt($width, $height, $self->_next($text));
111             $count = 0;
112             }
113             else {
114             $self->_encrypt($width, $height, 0);
115             }
116             }
117             }
118             }
119              
120             Crypt::Image::Util::saveImage($file, $self->{copy}, $self->{type});
121             }
122              
123             =head2 decrypt($encrypted_image)
124              
125             Decrypts the given encrypted image and returns the hidden text.
126              
127             use strict; use warnings;
128             use Crypt::Image;
129              
130             my $crypter = Crypt::Image->new(file => 'your_key_image.png');
131             $crypter->encrypt('Hello World', 'your_new_encrypted_image.png');
132             print "Text: [" . $crypter->decrypt('your_new_encrypted_image.png') . "]\n";
133              
134             =cut
135              
136             sub decrypt {
137             my ($self, $file) = @_;
138              
139             die("ERROR: Encrypted file missing.\n") unless defined $file;
140             die("ERROR: Encrypted file [$file] not found.\n") unless (-f $file);
141              
142             my ($allowed, $count, $text, $width, $height);
143              
144             $self->{copy} = GD::Image->new($file);
145             $allowed = $self->_decryptAllowed(1, 1);
146             $count = 0;
147             $text = '';
148              
149             foreach $width (0..$self->{width}-1) {
150             foreach $height (0..$self->{height}-1) {
151             unless (($width == 1) && ($height == 1)) {
152             $count++;
153             if ($count == $allowed) {
154             $text .= $self->_decrypt($width, $height);
155             $count = 0;
156             }
157             }
158             }
159             }
160             return $text;
161             }
162              
163             sub _encrypt {
164             my ($self, $x, $y, $a) = @_;
165              
166             my ($r, $g, $b, $i, $axis);
167             ($r,$g,$b) = Crypt::Image::Util::getPixelColorRGB($self->{key}, $x, $y);
168             if ($a == 0) {
169             $i = int(random_uniform() * $INTENSITY);
170             $b = Crypt::Image::Util::moveUp($b, $i);
171             $i = int(random_uniform() * $INTENSITY);
172             $g = Crypt::Image::Util::moveUp($g, $i);
173             $i = int(random_uniform() * $INTENSITY);
174             $r = Crypt::Image::Util::moveUp($r, $i);
175             }
176             else {
177             $axis = Crypt::Image::Util::splitInThree($a);
178             $b = Crypt::Image::Util::moveUp($b, $axis->x);
179             $g = Crypt::Image::Util::moveUp($g, $axis->y);
180             $r = Crypt::Image::Util::moveUp($r, $axis->z);
181             }
182              
183             $self->{copy}->setPixel($x, $y, Crypt::Image::Util::getColor($r, $g, $b));
184             }
185              
186             sub _decrypt {
187             my ($self, $x, $y) = @_;
188              
189             my ($r, $g, $b) = Crypt::Image::Util::differenceInAxis($self->{key}, $self->{copy}, $x, $y);
190              
191             return chr($r+$g+$b);
192             }
193              
194             sub _encryptAllowed {
195             my ($self, $allowed, $x, $y) = @_;
196              
197             my ($r, $g, $b, $axis, $count);
198             $count = 0;
199             ($r,$g,$b) = Crypt::Image::Util::getPixelColorRGB($self->{key}, $x, $y);
200              
201             while ($allowed > 127) {
202             $count++;
203             $allowed -= 127;
204             }
205              
206             if ($count > 0) {
207             $axis = Crypt::Image::Util::splitInTwo($count);
208             $r = Crypt::Image::Util::moveDown($r, $axis->x);
209             $g = Crypt::Image::Util::moveDown($g, $axis->y);
210             }
211              
212             $b = Crypt::Image::Util::moveDown($b, $allowed)
213             if ($allowed <= 127);
214              
215             $self->{copy}->setPixel($x, $y, Crypt::Image::Util::getColor($r, $g, $b));
216             }
217              
218             sub _decryptAllowed {
219             my ($self, $x, $y) = @_;
220              
221             my ($r, $g, $b) = Crypt::Image::Util::differenceInAxis($self->{key}, $self->{copy}, $x, $y);
222             return (($r*127)+($g*127)+$b);
223             }
224              
225             sub _next {
226             my ($self, $text) = @_;
227              
228             my $a = 0;
229             if (length($text) > $self->{countc}) {
230             $a = ord(substr($text, $self->{countc}, 1));
231             $self->{countc}++;
232             }
233              
234             return $a;
235             }
236              
237             =head1 AUTHOR
238              
239             Mohammad S Anwar, C<< >>
240              
241             =head1 REPOSITORY
242              
243             L
244              
245             =head1 BUGS
246              
247             Please report any bugs / feature requests to C or
248             through the the web interface at L.
249             I will be notified, and then you'll automatically be notified of progress on your
250             bug as I make changes.
251              
252             =head1 SUPPORT
253              
254             You can find documentation for this module with the perldoc command.
255              
256             perldoc Crypt::Image
257              
258             You can also look for information at:
259              
260             =over 4
261              
262             =item * RT: CPAN's request tracker
263              
264             L
265              
266             =item * AnnoCPAN: Annotated CPAN documentation
267              
268             L
269              
270             =item * CPAN Ratings
271              
272             L
273              
274             =item * Search CPAN
275              
276             L
277              
278             =back
279              
280             =head1 ACKNOWLEDGEMENT
281              
282             Joonas Vali, author of the L
283             gave me the idea for this module.
284              
285             =head1 LICENSE AND COPYRIGHT
286              
287             Copyright (C) 2011 - 2016 Mohammad S Anwar.
288              
289             This program is free software; you can redistribute it and/or modify it under
290             the terms of the the Artistic License (2.0). You may obtain a copy of the full
291             license at:
292              
293             L
294              
295             Any use, modification, and distribution of the Standard or Modified Versions is
296             governed by this Artistic License.By using, modifying or distributing the Package,
297             you accept this license. Do not use, modify, or distribute the Package, if you do
298             not accept this license.
299              
300             If your Modified Version has been derived from a Modified Version made by someone
301             other than you,you are nevertheless required to ensure that your Modified Version
302             complies with the requirements of this license.
303              
304             This license does not grant you the right to use any trademark, service mark,
305             tradename, or logo of the Copyright Holder.
306              
307             This license includes the non-exclusive, worldwide, free-of-charge patent license
308             to make, have made, use, offer to sell, sell, import and otherwise transfer the
309             Package with respect to any patent claims licensable by the Copyright Holder that
310             are necessarily infringed by the Package. If you institute patent litigation
311             (including a cross-claim or counterclaim) against any party alleging that the
312             Package constitutes direct or contributory patent infringement,then this Artistic
313             License to you shall terminate on the date that such litigation is filed.
314              
315             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
316             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
317             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
318             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
319             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
320             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
321             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
322              
323             =cut
324              
325             1; # End of Crypt::Image