File Coverage

blib/lib/Dancer2/Plugin/Captcha.pm
Criterion Covered Total %
statement 17 17 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 23 23 100.0


line stmt bran cond sub pod time code
1             package Dancer2::Plugin::Captcha;
2              
3             $Dancer2::Plugin::Captcha::VERSION = '0.11';
4             $Dancer2::Plugin::Captcha::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Dancer2::Plugin::Captcha - Dancer2 add-on for CAPTCHA.
9              
10             =head1 VERSION
11              
12             Version 0.11
13              
14             =cut
15              
16 1     1   49223 use 5.006;
  1         4  
17 1     1   4 use strict; use warnings;
  1     1   2  
  1         15  
  1         4  
  1         9  
  1         24  
18 1     1   529 use Data::Dumper;
  1         6676  
  1         48  
19              
20 1     1   441 use Dancer2::Plugin;
  1         325314  
  1         9  
21 1     1   39514 use GD::SecurityImage;
  1         3792  
  1         7  
22              
23             =head1 DESCRIPTION
24              
25             A very simple plugin for L to process CAPTCHA.I needed this for my other
26             project (in-progress) available on L.
27              
28             The core functionality of the plugin is supported by L.
29              
30             =head1 SYNOPSIS
31              
32             =head2 Setting up the application configuration.
33              
34             The plugin expect a session engine configured for it to perform its task,
35              
36             session: Simple
37              
38             plugins:
39             Captcha:
40             new:
41             width: 160
42             height: 175
43             lines: 5
44             gd_font: 'giant'
45             create: [ 'normal', 'default' ]
46             out:
47             force: 'png'
48             particle: [ 100 ]
49              
50             =head2 Setting up the application route handler.
51              
52             get '/get_captcha' => sub {
53             return generate_captcha();
54             };
55              
56             post '/validate_captcha' => sub {
57             return "Invalid captcha code."
58             unless (is_valid_captcha(request->params->{captcha}));
59              
60             remove_captcha;
61             };
62              
63             =head2 Setting up the application template.
64              
65            
66            
67            
68            
69            
70            
71              
72             =head1 CONFIGURATION
73              
74             The plugin can be configured in the application configuration file as below:
75              
76             plugins:
77             Captcha:
78             new:
79             create:
80             particle:
81             out:
82              
83             =head2 new
84              
85             The following keys can be assigned to method 'new':
86              
87             +------------+--------------------------------------------------------------+
88             | Key | Description |
89             +------------+--------------------------------------------------------------+
90             | width | The width of the image (in pixels). |
91             | height | The height of the image (in pixels). |
92             | ptsize | The point size of the ttf character. |
93             | lines | The number of lines in the background of the image. |
94             | font | The absolute path to your TrueType font file. |
95             | gd_font | The possible value are 'small', 'large', 'mediumbold', |
96             | | 'tiny' and 'giant'. |
97             | bgcolor | The background color of the image. |
98             | send_ctobg | If has a true value, the random security code will be |
99             | | displayed in the background and the lines will pass over it. |
100             | frame | If has a true value, a frame will be added around the image. |
101             | scramble | If set, the characters will be scrambled. |
102             | angle | Sets the angle (0-360) for scrambled/normal characters. |
103             | thickness | Sets the line drawing width. |
104             | mdmax | The minimum length if the random string. Default is 6. |
105             | md_data | Default character set used to create the random string is |
106             | | [0..9]. |
107             +------------+--------------------------------------------------------------+
108              
109             =head2 create
110              
111             The data should be in the format as below for method 'create':
112              
113             [ $method, $style, $text_color, $line_color ]
114              
115             The key C<$method> and C<$style> are mandatory and the rest all are optionals.
116              
117             The key C<$method> can have one of the following values:
118              
119             normal or ttf
120              
121             The key C<$style> can have one of the following values:
122              
123             +---------+-----------------------------------------------------------------+
124             | Key | Description |
125             +---------+-----------------------------------------------------------------+
126             | default | The default style. Draws horizontal, vertial and angular lines. |
127             | rect | Draws horizontal and vertical lines. |
128             | box | Draws two filled rectangles. |
129             | circle | Draws circles. |
130             | ellipse | Draws ellipses. |
131             | ec | Draws both ellipses and circles. |
132             | blank | Draws nothing. |
133             +---------+-----------------------------------------------------------------+
134              
135             =head2 out
136              
137             The following keys can be assigned to method 'out':
138              
139             +----------+----------------------------------------------------------------+
140             | Key | Description |
141             +----------+----------------------------------------------------------------+
142             | force | Can have one of the formats 'jpeg' or 'png' or 'gif'. |
143             | compress | Can be between 1 and 100. |
144             +----------+----------------------------------------------------------------+
145              
146             =head2 particle
147              
148             The data should be in the format as below for method 'particle':
149              
150             [ $density, $maximum_dots ]
151              
152             The default value for C<$density> is dependent on the image's height & width. The
153             greater value of height and width is taken and multiplied by 20 for defaults.
154              
155             The key C<$maximum_dots> defines the maximum number of dots near the default dot.
156             The default value is 1. If you set it to 4, the selected pixel and 3 other pixels
157             near it will be used and colored.
158              
159             =head1 METHODS
160              
161             =head2 generate_captcha(\%params)
162              
163             It returns captcha image as per the given parameters. If the key 'random' is not
164             defined then the default character sets [0..9] will be used.
165              
166             get '/get_captcha' => sub {
167             return generate_captcha({
168             new => {
169             width => 500,
170             height => 75,
171             lines => 5,
172             gd_font => 'giant',
173             },
174             particle => [ 100 ],
175             out => { force => 'png' },
176             random => ,
177             });
178             };
179              
180             =cut
181              
182             register generate_captcha => sub {
183             my ($dsl, $init, $id) = @_;
184              
185             $init = {} unless defined $init;
186             $id = 'default' unless defined $id;
187              
188             my $conf = plugin_setting();
189              
190             foreach my $key (qw(new out)) {
191             $conf->{$key} //= {};
192             $init->{$key} //= {};
193             $init->{$key} = { %{$conf->{$key}}, %{$init->{$key}} };
194             }
195              
196             foreach my $key (qw(create particle)) {
197             $conf->{$key} //= [];
198             $init->{$key} ||= $conf->{$key};
199             }
200              
201             $dsl->engine('session')
202             or die "ERROR: Session engine required for the plugin ".__PACKAGE__.".\n";
203              
204             my $image = GD::SecurityImage->new(%{$init->{new}});
205             $image->random($init->{random});
206             $image->create(@{$init->{create}});
207             $image->particle(@{$init->{particle}});
208             my ($captcha, $mime_type, $random_number) = $image->out(%{$init->{out}});
209              
210             $dsl->_save_captcha($id, 'string' => $random_number);
211             $dsl->header('Pragma' => 'no-cache');
212             $dsl->header('Cache-Control' => 'no-cache');
213             $dsl->content_type($mime_type);
214              
215             return $captcha;
216             };
217              
218             =head2 is_valid_captcha($input, $id)
219              
220             The C<$input> is the captcha code entered by the user and C<$id> is the captcha
221             ID. It returns 0 or 1 depending on whether the captcha matches or not.
222              
223             post '/validate_captcha' => sub {
224             return "Invalid captcha code."
225             unless (is_valid_captcha(request->params->{captcha}));
226              
227             remove_captcha;
228             };
229              
230             =cut
231              
232             register is_valid_captcha => sub {
233             my ($dsl, $input, $id) = @_;
234              
235             $id = 'default' unless defined $id;
236             my $captcha = $dsl->_get_captcha($id, 'string');
237             ((defined $input) && (defined $captcha) && ($input eq $captcha))
238             ?
239             (return 1)
240             :
241             (return 0);
242             };
243              
244             =head2 remove_captcha($id)
245              
246             The C<$id> is the captcha ID. It removes the captcha from the session.
247              
248             =cut
249              
250             register remove_captcha => sub {
251             my ($dsl, $id) = @_;
252              
253             $id = 'default' unless defined $id;
254              
255             my $captcha = $dsl->session('captcha');
256             return unless defined $captcha;
257             return unless ((exists $captcha->{$id}) && (exists $captcha->{$id}{'string'}));
258              
259             $captcha->{$id}{'string'} = undef;
260             $dsl->session('captcha' => $captcha);
261             };
262              
263             register_plugin;
264              
265             #
266             #
267             # PRIVATE METHODS
268              
269             sub _save_captcha {
270             my ($dsl, $id, $key, $value) = @_;
271              
272             die "ERROR: Missing captcha ID.\n" unless defined $id;
273             die "ERROR: Missing captcha key.\n" unless defined $key;
274             die "ERROR: Missing captcha value.\n" unless defined $value;
275              
276             my $captcha = $dsl->app->session->read('captcha') || {};
277             $captcha->{$id} ||= {};
278             $captcha->{$id}{$key} = $value;
279             $dsl->app->session->write('captcha' => $captcha);
280             }
281              
282             sub _get_captcha {
283             my ($dsl, $id, $key) = @_;
284              
285             die "ERROR: Missing captcha ID.\n" unless defined $id;
286             die "ERROR: Missing captcha key.\n" unless defined $key;
287              
288             my $captcha = $dsl->app->session->read('captcha');
289             return unless defined $captcha;
290              
291             return $captcha->{$id}{$key};
292             }
293              
294             =head1 AUTHOR
295              
296             Mohammad S Anwar, C<< >>
297              
298             =head1 REPOSITORY
299              
300             L
301              
302             =head1 ACKNOWLEDGEMENTS
303              
304             Inspired by the package L (Alessandro Ranellucci ).
305              
306             =head1 SEE ALSO
307              
308             L
309              
310             =head1 BUGS
311              
312             Please report any bugs or feature requests to C,
313             or through the web interface at L.
314             I will be notified and then you'll automatically be notified of progress on your
315             bug as I make changes.
316              
317             =head1 SUPPORT
318              
319             You can find documentation for this module with the perldoc command.
320              
321             perldoc Dancer2::Plugin::Captcha
322              
323             You can also look for information at:
324              
325             =over 4
326              
327             =item * RT: CPAN's request tracker (report bugs here)
328              
329             L
330              
331             =item * AnnoCPAN: Annotated CPAN documentation
332              
333             L
334              
335             =item * CPAN Ratings
336              
337             L
338              
339             =item * Search CPAN
340              
341             L
342              
343             =back
344              
345             =head1 LICENSE AND COPYRIGHT
346              
347             Copyright (C) 2015 - 2017 Mohammad S Anwar.
348              
349             This program is free software; you can redistribute it and / or modify it under
350             the terms of the the Artistic License (2.0). You may obtain a copy of the full
351             license at:
352              
353             L
354              
355             Any use, modification, and distribution of the Standard or Modified Versions is
356             governed by this Artistic License.By using, modifying or distributing the Package,
357             you accept this license. Do not use, modify, or distribute the Package, if you do
358             not accept this license.
359              
360             If your Modified Version has been derived from a Modified Version made by someone
361             other than you,you are nevertheless required to ensure that your Modified Version
362             complies with the requirements of this license.
363              
364             This license does not grant you the right to use any trademark, service mark,
365             tradename, or logo of the Copyright Holder.
366              
367             This license includes the non-exclusive, worldwide, free-of-charge patent license
368             to make, have made, use, offer to sell, sell, import and otherwise transfer the
369             Package with respect to any patent claims licensable by the Copyright Holder that
370             are necessarily infringed by the Package. If you institute patent litigation
371             (including a cross-claim or counterclaim) against any party alleging that the
372             Package constitutes direct or contributory patent infringement,then this Artistic
373             License to you shall terminate on the date that such litigation is filed.
374              
375             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
376             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
377             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
378             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
379             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
380             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
381             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
382              
383             =cut
384              
385             1; # End of Dancer2-Plugin-Captcha