diff --git a/lib/CMTD/Captcha.pm b/lib/CMTD/Captcha.pm new file mode 100644 index 0000000..ae9cf01 --- /dev/null +++ b/lib/CMTD/Captcha.pm @@ -0,0 +1,168 @@ +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 + + 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 + + my $captcha = CMTD::Captcha->new(%config); + my ($code, $data) = $captcha->create(); + +Generates captcha image, returns hash of filename. + +=head2 C + + my $captcha = CMTD::Captcha->new(%config); + ...do something wrong... + my $error = $captcha->error; + +Returns last occured error for method C +Error will be cleared on next successfull call to these methods. + +=cut