You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
168 lines
3.6 KiB
168 lines
3.6 KiB
package CMTD::Captcha; |
|
|
|
use strict; |
|
use warnings; |
|
use utf8; |
|
|
|
use Imager; |
|
|
|
our $VERSION = 0.01; |
|
|
|
sub new { |
|
my ($class, %config) = @_; |
|
my $self = { |
|
width => 120, |
|
height => 40, |
|
bg_color => '#444444', |
|
fg_color => '#999999', |
|
expire => 300, |
|
debug => 0, |
|
length => 6, |
|
ft_file => undef, |
|
ft_size => 32, |
|
ft_family => 'SansSerif', |
|
wv_size => 5, |
|
wv_length => 60, |
|
%config |
|
}; |
|
|
|
die("Captcha : ft_file not set\n") unless ($self->{ft_file}); |
|
|
|
return bless $self, $class; |
|
} |
|
|
|
sub _gen_code { |
|
my ($self) = @_; |
|
my ($code, $pos); |
|
|
|
my @chars = ('a' .. 'f', '0' .. '9'); |
|
my $length = $self->{length}; |
|
|
|
$code = ""; |
|
while ($length --> 0) { |
|
$pos = int rand scalar(@chars); |
|
$code .= $chars[$pos]; |
|
} |
|
|
|
return $code; |
|
} |
|
|
|
sub create { |
|
my ($self) = @_; |
|
my ($code, $data, $err); |
|
|
|
eval { |
|
warn "Generating code\n" if $self->{debug}; |
|
$code = $self->_gen_code(); |
|
warn "Code is: $code\n" if $self->{debug}; |
|
|
|
my $image = Imager->new( |
|
xsize => $self->{width}, |
|
ysize => $self->{height}, |
|
); |
|
|
|
warn "Creating image (1/3)\n" if $self->{debug}; |
|
$image->box(filled => 1, color => $self->{bg_color}); |
|
|
|
# calculate position of bottom left corner of text box |
|
warn "Creating font\n" if $self->{debug}; |
|
my $font = Imager::Font->new( |
|
file => $self->{ft_file}, |
|
size => $self->{ft_size}, |
|
color => $self->{fg_color}, |
|
) or die("can't create font: ", Imager->errstr, "\n"); |
|
|
|
warn "Creating image (2/3)\n" if $self->{debug}; |
|
$font->align( |
|
string => $code, |
|
halign => 'center', |
|
valign => 'center', |
|
image => $image, |
|
x => $image->getwidth / 2, |
|
y => $image->getheight / 2, |
|
) or die("can't place code on image\n"); |
|
|
|
$image->filter( |
|
type => 'noise', |
|
amount => 120, |
|
subtype => 0, |
|
) or die("can't distort image\n"); |
|
|
|
$image = $image->convert(preset => 'grey'); |
|
|
|
warn "Saving image\n" if ($self->{debug}); |
|
$image->write(data => \$data, type => 'jpeg') |
|
or die("can't write image: " . Imager->errstr . "\n"); |
|
|
|
$self->{error} = ''; 1; |
|
} or do { |
|
warn "Error: $@" if ($self->{debug}); |
|
$self->{error} = $@; |
|
return; |
|
}; |
|
|
|
return ($code, $data); |
|
} |
|
|
|
sub error { |
|
my ($self) = @_; |
|
return $self->{error} || ''; |
|
} |
|
|
|
1; |
|
|
|
=pod |
|
|
|
=head1 NAME |
|
|
|
CMTD::Captcha -- generate captcha with Imager |
|
|
|
=head1 DESCRIPTION |
|
|
|
Based on Mojolicious::Plugin::CaptchaRenderer, but uses Imager instead. |
|
|
|
=head1 Methods / Private |
|
|
|
=head2 C<_gen_code> |
|
|
|
Generate captcha code for placing to image. |
|
|
|
=head1 Methods / Public |
|
|
|
=head2 C<new> |
|
|
|
my $captcha = CMTD::Captcha->new(%config); |
|
|
|
Constructor. Takes plain hash of options. Mandatory settings: |
|
|
|
* ft_file -- default: undef, file with font to use |
|
|
|
Optional settings: |
|
|
|
* width -- 120, image width |
|
* height -- 30, image height |
|
* bg_color -- '#444444', base background color for image |
|
* fg_color -- '#999999', color of text |
|
* debug -- 0, display diagnostic messages to stderr |
|
* ft_size -- 32, font size, points |
|
* ft_family -- 'SansSerif', font family |
|
* wv_size -- 5, distortion settings, vertical amplitude |
|
* wv_length -- 60, distortion settings, wave length |
|
|
|
=head2 C<create> |
|
|
|
my $captcha = CMTD::Captcha->new(%config); |
|
my ($code, $data) = $captcha->create(); |
|
|
|
Generates captcha image, returns hash of filename. |
|
|
|
=head2 C<error> |
|
|
|
my $captcha = CMTD::Captcha->new(%config); |
|
...do something wrong... |
|
my $error = $captcha->error; |
|
|
|
Returns last occured error for method C<create> |
|
Error will be cleared on next successfull call to these methods. |
|
|
|
=cut
|
|
|