From e1d5dc4b07718833459101fe615b0843a754f15e Mon Sep 17 00:00:00 2001
From: Alex 'AdUser' Z <ad_user@runbox.com>
Date: Tue, 22 Aug 2017 16:51:09 +1000
Subject: [PATCH] + CMTD::Captcha

---
 lib/CMTD/Captcha.pm | 168 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 168 insertions(+)
 create mode 100644 lib/CMTD/Captcha.pm

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<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