view release on metacpan or  search on metacpan

lib/ASP4x/Captcha/Imager.pm  view on Meta::CPAN

package ASP4x::Captcha::Imager;

use strict;
use warnings 'all';
use base 'ASP4::FormHandler';
use vars __PACKAGE__->VARS;
use Imager;
use Digest::MD5 'md5_hex';

our $VERSION = '0.003';


sub run
{
  my ($s, $context) = @_;
  
  my ($word, $key) = $s->generate_pair( $context );
  
  $Session->{asp4captcha} = { lc($word) => $key };
  $word = join ' ', split //, $word;
  
  my $img = Imager->new(
    xsize => eval { $Config->system->settings->captcha_width }  || 140,
    ysize => eval { $Config->system->settings->captcha_height } || 70
  );

  $img->box(
    filled => 1,
    color  => eval { $Config->system->settings->captcha_bg_color } || 'white'
  );

  my $font = Imager::Font->new( $s->font );

  my @colors = qw(
    A9A9A9  878787  656565  808080
    CACACA  EFEFEF  DEDEDE  CDCDCD
    BABABA  A9A9A9  878787  656565
    434343  212121  EFEFEF  DEDEDE
    CDCDCD  BABABA  CCCCCC  AAAAAA
  );
  
  # Add the word to the image, but make it hard to read:
  my @chars = split //, $word;
  my $charWidth = ( $img->getwidth * 0.8 ) / scalar(@chars);
  my $charHeight = sprintf("%d", $img->getheight * 0.7);
  
  for( 1..10 )
  {
    for my $idx ( 0..@chars - 1 )
    {
      for( 1..int(rand() * @colors) )
      {
      push @colors, shift(@colors);
      }
      my $color = $colors[0];
      $font->align(
        halign  => 'center',
        valign  => 'center',
        string  => $chars[$idx],
        size    => $charHeight,
        image   => $img,
        color   => $color,
        'x'     => ( $idx * $charWidth ) + int(rand() * 8) + $charWidth,
        'y'     => ($img->getheight / 2) + int(rand() * 8) - 4,
      );
    }# end for()
    $img->filter( type => 'gaussian', stddev => 1 );
  }# end for()
  
  # Render the image as PNG:
  my $str = "";
  $img->write(type=>'png', data => \$str)
    or die $img->errstr;
  $Response->Expires( -30 );
  $Response->AddHeader( pragma => 'no-cache' );
  $Response->SetHeader('content-type' => 'image/png');
  $Response->ContentType( 'image/png' );
  $Response->Write( $str );
}# end run()


sub generate_pair
{
  my ($s, $context) = @_;

  my $len = eval { $Config->system->settings->captcha_length } || 4;
  my $chars = join '', ( 'A'..'H', 'J'..'N', 'P'..'Z', 1..9 );

  my $word = '';
  while( length($word) < $len )
  {
    $word .= substr($chars, int(rand()*length($chars)), 1);
  }# end while()
  
  my $key = md5_hex( lc($word) . ( eval { $Config->system->settings->captcha_key } || '' ) );
  
  return ( $word, $key );
}# end generate_pair()


sub font
{
  my $s = shift;
  
  return ( file => $Config->system->settings->captcha_font );