ASP4x-Captcha-Imager
view release on metacpan or search on metacpan
2011-05-09 v0.003
- content-length is no longer set. It was causing problems when combined with mod_gzip.
2010-06-03 v0.002
- "Scaling" the captcha larger/smaller works better now, so you're not stuck
with the default width and height.
2010-03-23 v0.001
- Initial release.
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/ASP4x/Captcha/Imager.pm
Makefile.PL
MANIFEST
META.yml
t/010-basic/000-setup.t
t/010-basic/010-compile.t
t/010-basic/020-basic.t
t/010-basic/030-form.t
t/conf/asp4-config.json
t/conf/httpd.conf
t/etc/LiberationSans-Regular.ttf
t/handlers/dev/captcha.pm
t/handlers/dev/validate.pm
t/htdocs/form.asp
inc/Module/Install.pm view on Meta::CPAN
#line 1
package Module::Install;
# For any maintainers:
# The load order for Module::Install is a bit magic.
# It goes something like this...
#
# IF ( host has Module::Install installed, creating author mode ) {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
# 3. The installed version of inc::Module::Install loads
# 4. inc::Module::Install calls "require Module::Install"
# 5. The ./inc/ version of Module::Install loads
# } ELSE {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
# 3. The ./inc/ version of Module::Install loads
# }
BEGIN {
require 5.004;
}
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
inc/Module/Install.pm view on Meta::CPAN
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
use inc::${\__PACKAGE__};
not:
inc/Module/Install/Metadata.pm view on Meta::CPAN
}
return 1;
}
sub all_from {
my ( $self, $file ) = @_;
unless ( defined($file) ) {
my $name = $self->name or die(
"all_from called with no args without setting name() first"
);
$file = join('/', 'lib', split(/-/, $name)) . '.pm';
$file =~ s{.*/}{} unless -e $file;
unless ( -e $file ) {
die("all_from cannot find $file from $name");
}
}
unless ( -f $file ) {
die("The path '$file' does not exist, or is not a file");
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
return $self->{values}{no_index};
}
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
} else {
$self->can($key)->($self, $value);
}
}
lib/ASP4x/Captcha/Imager.pm view on Meta::CPAN
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
lib/ASP4x/Captcha/Imager.pm view on Meta::CPAN
$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 );
}# end font()
1;# return true:
=pod
=head1 NAME
ASP4x::Captcha::Imager - Imager-based CAPTCHA for your ASP4 web application.
=head1 SYNOPSIS
=head2 In Your asp4-config.conf
{
...
"system": {
...
"settings": {
...
"captcha_key": "Some random string of any length",
"captcha_font": "@ServerRoot@/etc/LiberationSans-Regular.ttf",
"captcha_width": 140,
"captcha_height": 40,
"captcha_bg_color": "FFFFFF",
"captcha_length": 4
...
}
}
lib/ASP4x/Captcha/Imager.pm view on Meta::CPAN
use strict;
use warnings 'all';
use base 'ASP4::FormHandler';
use vars __PACKAGE__->VARS;
sub run
{
my ($s, $context) = @_;
my $secret = $Config->system->settings->captcha_key;
my $code = lc($Form->{security_code});
# It should exist in the session and have the correct value:
if( exists($Session->{asp4captcha}->{$code}) )
{
# Ding ding ding ding ding!
$Response->Write("CORRECT");
}
else
{
t/010-basic/020-basic.t view on Meta::CPAN
"Got res.content"
);
is(
$res->header('content-type') => "image/png",
"content-type is image/png"
);
my $Session = $api->context->session;
my $wordLength = $api->context->config->system->settings->captcha_length;
my $secret = $api->context->config->system->settings->captcha_key;
my ($word) = grep {
length($_) == $wordLength &&
md5_hex($_ . $secret) eq $Session->{asp4captcha}->{$_};
} keys %{ $Session->{asp4captcha} };
ok( $word, "Found word '$word'");
my $hashed = md5_hex($word . $secret);
is($hashed => $Session->{asp4captcha}->{$word}, "Hashing is correct" );
t/010-basic/030-form.t view on Meta::CPAN
"Got the captcha image"
);
ok(
my ($form) = HTML::Form->parse( $res->content, '/' ),
"Got the form"
);
# Figure out what the security code is:
my $Session = $api->context->session;
my $wordLength = $api->context->config->system->settings->captcha_length;
my $secret = $api->context->config->system->settings->captcha_key;
my ($word) = grep {
length($_) == $wordLength &&
md5_hex($_ . $secret) eq $Session->{asp4captcha}->{$_};
} keys %{ $Session->{asp4captcha} };
# Fill out the form - lowercase:
$form->find_input('security_code')->value( lc($word) );
$res = $api->ua->submit_form( $form );
is( $res->content => "CORRECT", "Validated correctly (A)" );
t/conf/asp4-config.json view on Meta::CPAN
"system": {
"post_processors": [
],
"libs": [
"@ServerRoot@/lib"
],
"load_modules": [
],
"env_vars": {
},
"settings": {
"captcha_key": "Captcha-Is-Teh-Awesome",
"captcha_font": "@ServerRoot@/etc/LiberationSans-Regular.ttf",
"captcha_width": 140,
"captcha_height": 40,
"captcha_bg_color": "FFFFFF",
"captcha_length": 4
}
},
"errors": {
"error_handler": "ASP4::ErrorHandler",
t/handlers/dev/validate.pm view on Meta::CPAN
use strict;
use warnings 'all';
use base 'ASP4::FormHandler';
use vars __PACKAGE__->VARS;
use Digest::MD5 'md5_hex';
sub run
{
my ($s, $context) = @_;
my $secret = $Config->system->settings->captcha_key;
my $code = lc($Form->{security_code});
# It should exist in the session and have the correct value:
if( exists($Session->{asp4captcha}->{$code}) && md5_hex($code . $secret) eq $Session->{asp4captcha}->{$code} )
{
$Response->Write("CORRECT");
}
else
{
# Bzzzzzzzzzzt: WRONG!
( run in 0.997 second using v1.01-cache-2.11-cpan-49f99fa48dc )