Authen-Captcha
view release on metacpan or search on metacpan
} # else, we're just going to let perl do it's thing
return $self;
}
sub type
{
ref(my $self = shift) or croak "instance variable needed";
if (@_)
{
if ($_[0] =~ /^(jpg|png|gif|image|picture)$/i)
{
$self->{_type} = 'image';
} elsif ($_[0] =~ /^(sound|snd|wav|mp3)$/i) {
$self->{_type} = 'sound';
}
return $self->{_type};
} else {
return $self->{_type};
}
}
my $passed=0;
# $new_data will hold the part of the database we want to keep and
# write back out
my $new_data = "";
foreach my $line (@data)
{
$line =~ s/\n//;
my ($data_time,$data_token,$data_code) = $line =~ m/(^\d+)::([a-f0-9]{32})::(.*)$/
or next;
my $png_file = File::Spec->catfile($self->output_folder(),$data_token . ".png");
if ($data_token eq $token)
{
# the token was found in the database
if (($current_time - $data_time) > $self->expire())
{
warn "Crypt Found But Expired\n" if($self->debug() >= 2);
# the token was found but has expired
$return_value = -1;
} else {
$return_value = 1;
}
if ( $return_value < ($self->keep_failures() ? -1 : -2) )
{
warn "No Match: " . $data_token . " And " . $token . "\n" if($self->debug() >= 2);
# solution was wrong, not expired, and we're keeping failures
$new_data .= $line."\n";
} else {
# remove the found token so it can't be used again
warn "Unlink File: " . $png_file . "\n" if($self->debug() >= 2);
unlink($png_file) or carp("Can't remove png file [$png_file]\n");
}
if ( $return_value == -2 ) {
# incorrect solution
$return_value = -3;
}
} elsif (($current_time - $data_time) > $self->expire()) {
# removed expired token
warn "Removing Expired Crypt File: " . $png_file ."\n" if($self->debug() >= 2);
unlink($png_file) or carp("Can't remove png file [$png_file]\n");
} else {
# token not found or expired, keep it
$new_data .= $line."\n";
}
}
# update database
open(DATA,">$database_file") or die "Can't open File: $database_file\n";
print DATA $new_data;
close(DATA);
my $new_data = "";
foreach my $line (@data)
{
$line =~ s/\n//;
my ($data_time,$data_token,$data_code) = $line =~ m/(^\d+)::([a-f0-9]{32})::(.*)$/
or next;
if ( (($current_time - $data_time) > ($self->expire())) ||
($data_token eq $token) )
{ # remove expired captcha, or a dup
my $png_file = File::Spec->catfile($self->output_folder(),$data_token . ".png");
unlink($png_file) or carp("Can't remove png file [$png_file]\n");
} else {
$new_data .= $line."\n";
}
}
# save the code to database
warn "open File: $database_file\n" if($self->debug() >= 2);
open(DATA,">$database_file") or die "Can't open File: $database_file\n";
warn "-->>" . $new_data . "\n" if($self->debug() >= 2);
warn "-->>" . $current_time . "::" . $token."::".$code."\n" if($self->debug() >= 2);
my $length = length($code);
my $im_width = $self->width();
# create a new image and color
my $im = new GD::Image(($im_width * $length),$self->height());
my $black = $im->colorAllocate(0,0,0);
# copy the character images into the code graphic
for(my $i=0; $i < $length; $i++)
{
my $letter = substr($code,$i,1);
my $letter_png = File::Spec->catfile($self->images_folder(),$letter . ".png");
my $source = new GD::Image($letter_png);
$im->copy($source,($i*($self->width()),0,0,0,$self->width(),$self->height()));
my $a = int(rand (int(($self->width())/14)))+0;
my $b = int(rand (int(($self->height())/12)))+0;
my $c = int(rand (int(($self->width())/3)))-(int(($self->width())/5));
my $d = int(rand (int(($self->height())/3)))-(int(($self->height())/5));
$im->copyResized($source,($i*($self->width()))+$a,$b,0,0,($self->width())+$c,($self->height())+$d,$self->width(),$self->height());
}
# distort the code graphic
for(my $i=0; $i<($length*($self->width())*($self->height())/14+200); $i++)
$im->line($a,$b,$c,$d,$index);
} elsif ($i < (($length*($self->width())*($self->height())/14+200)/2)) {
$im->setPixel($c,$d,$index);
} else {
$im->setPixel($c,$d,$black);
}
}
# generate a background
my $a = int(rand 5)+1;
my $background_img = File::Spec->catfile($self->images_folder(),"background" . $a . ".png");
my $source = new GD::Image($background_img);
my ($background_width,$background_height) = $source->getBounds();
my $b = int(rand (int($background_width/13)))+0;
my $c = int(rand (int($background_height/7)))+0;
my $d = int(rand (int($background_width/13)))+0;
my $e = int(rand (int($background_height/7)))+0;
my $source2 = new GD::Image(($length*($self->width())),$self->height());
$source2->copyResized($source,0,0,$b,$c,($length*($self->width())),$self->height(),$background_width-$b-$d,$background_height-$c-$e);
# merge the background onto the image
$im->copyMerge($source2,0,0,0,0,($length*($self->width())),$self->height(),40);
# add a border
$im->rectangle(0,0,((($length)*($self->width()))-1),(($self->height())-1),$black);
# save the image to file
my $png_data = $im->png;
return \$png_data;
}
sub create_sound_file
{
ref(my $self = shift) or croak "instance variable needed";
my $code = shift;
my $length = length($code);
my @chars = split('',$code);
my $snd_file;
ref(my $self = shift) or croak "instance variable needed";
my $length = shift;
my $code = $self->generate_random_string($length);
my $token = random_regex('[a-f0-9]{32}');
my ($captcha_data_ref,$output_filename);
if ($self->type() eq 'image')
{
$captcha_data_ref = $self->create_image_file($code);
$output_filename = File::Spec->catfile($self->output_folder(),$token . ".png");
} elsif ($self->type() eq 'sound') {
$captcha_data_ref = $self->create_sound_file($code);
$output_filename = File::Spec->catfile($self->output_folder(),$token . ".wav");
} else {
croak "invalid captcha type [" . $self->type() . "]";
}
$self->_save_file($captcha_data_ref,$output_filename);
$self->_save_code($code,$token);
$captcha->output_folder('/some/http/folder');
# Alternitively, any of the methods to set variables may also be
# used directly in the constructor
my $captcha = Authen::Captcha->new(
data_folder => '/some/folder',
output_folder => '/some/http/folder',
);
# create a captcha. Image filename is "$token.png"
my $token = $captcha->generate_code($number_of_characters);
# check for a valid submitted captcha
# $code is the submitted letter combination guess from the user
# $token is the submitted token from the user (that we gave them)
my $results = $captcha->check_code($code,$token);
# $results will be one of:
# 1 : Passed
# 0 : Code not checked (file error)
# -1 : Failed: code expired
width => 25, # optional. default 25
height => 35, # optional. default 35
images_folder => '/some/folder', # optional. default to lib dir
keep_failures => 0, # optional, defaults to 0(false)
debug => 0, # optional. default 0
=back
=item C<$token = $captcha-E<gt>generate_code( $number_of_characters );>
Creates a captcha. Image filename is "$token.png"
It can also be called in array context to retrieve the string of characters used to generate the captcha (the string the user is expected to respond with). This is useful for debugging.
ex.
C<($token,$chars) = $captcha-E<gt>generate_code( $number_of_characters );>
=item C<$results = $captcha-E<gt>check_code($code,$token);>
check for a valid submitted captcha
Required. Sets the directory to hold the flatfile database that will be used to store the current non-expired valid captcha tokens.
Must be writable by the process running the script (usually the web server user, which is usually either "apache" or "http"), but should not be accessible to the end user.
=item C<$captcha-E<gt>output_folder( '/some/folder' );>
Required. Sets the directory to hold the generated Captcha image files. This is usually a web accessible directory so that the user can view the images in here, but it doesn't have to be web accessible (you could be attaching the images to an e-mail ...
Must be writable by the process running the script (usually the web server user, which is usually either "apache" or "http").
=item C<$captcha-E<gt>images_folder( '/some/folder' );>
Optional, and may greatly affect the results... use with caution. Allows you to override the default character graphic png's and backgrounds with your own set of graphics. These are used in the generation of the final captcha image file. The defaults...
[lib install dir]/Authen/Captcha/images
=item C<$captcha-E<gt>expire( 300 );>
Optional. Sets the number of seconds this captcha will remain valid. This means that the created captcha's will not remain valid forever, just as long as you want them to be active. Set to an appropriate value for your application. Defaults to 300.
=item C<$captcha-E<gt>width( 25 );>
Optional. Number of pixels high for the character graphics. Defaults to 25.
Captcha/images/CVS/Entries view on Meta::CPAN
/2.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/3.png/1.1/Mon Dec 1 20:37:11 2003/-kb/
/4.png/1.1/Mon Dec 1 20:37:11 2003/-kb/
/5.png/1.1/Mon Dec 1 20:37:11 2003/-kb/
/6.png/1.1/Mon Dec 1 20:37:11 2003/-kb/
/7.png/1.1/Mon Dec 1 20:37:11 2003/-kb/
/8.png/1.1/Mon Dec 1 20:37:11 2003/-kb/
/9.png/1.1/Mon Dec 1 20:37:11 2003/-kb/
/Thumbs.db/1.1/Mon Dec 1 20:37:11 2003/-kb/
/a.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/b.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/background1.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/background2.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/background3.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/background4.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/background5.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/c.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/d.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/e.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/f.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/g.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/h.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/i.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/j.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/k.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/l.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/m.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/n.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/o.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/p.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/q.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/r.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/s.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/t.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/u.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/v.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/w.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/x.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/y.png/1.1/Mon Dec 1 20:37:10 2003/-kb/
/z.png/1.1/Mon Dec 1 20:37:11 2003/-kb/
D
* Captcha.pm, Changes, Makefile.PL, README, t/1.t: changed
namespace from Crypt::Captcha to Authen::Captcha after looking over
compete module list on CPAN... Authen now seems more appropriate.
2003-12-01 21:23 jmiller
* Captcha.pm: updated documentation
2003-12-01 20:52 jmiller
* Captcha/images/: 2.png, 3.png, 4.png, 5.png, 6.png, 7.png, 8.png,
9.png, Thumbs.db, a.png, b.png, background1.png, background2.png,
background3.png, background4.png, background5.png, c.png, d.png,
e.png, f.png, g.png, h.png, i.png, j.png, k.png, l.png, m.png,
n.png, o.png, p.png, q.png, r.png, s.png, t.png, u.png, v.png,
w.png, x.png, y.png, z.png: adding static image data
2003-12-01 20:45 jmiller
* Makefile.PL, t/1.t: had to change the PM_FILTER, and the test to
hack around the imagesfolder stuff
2003-12-01 20:23 jmiller
* Captcha.pm, t/1.t: fixed "use of uninitialized value" that was in
checkCode (last 4 lines... if $newdata was empty, it'd complain
Captcha.pm
Captcha/images/2.png
Captcha/images/3.png
Captcha/images/4.png
Captcha/images/5.png
Captcha/images/6.png
Captcha/images/7.png
Captcha/images/8.png
Captcha/images/9.png
Captcha/images/CVS/Entries
Captcha/images/CVS/Repository
Captcha/images/CVS/Root
Captcha/images/Thumbs.db
Captcha/images/a.png
Captcha/images/b.png
Captcha/images/background1.png
Captcha/images/background2.png
Captcha/images/background3.png
Captcha/images/background4.png
Captcha/images/background5.png
Captcha/images/c.png
Captcha/images/d.png
Captcha/images/e.png
Captcha/images/f.png
Captcha/images/g.png
Captcha/images/h.png
Captcha/images/i.png
Captcha/images/j.png
Captcha/images/k.png
Captcha/images/l.png
Captcha/images/m.png
Captcha/images/n.png
Captcha/images/o.png
Captcha/images/p.png
Captcha/images/q.png
Captcha/images/r.png
Captcha/images/s.png
Captcha/images/t.png
Captcha/images/u.png
Captcha/images/v.png
Captcha/images/w.png
Captcha/images/x.png
Captcha/images/y.png
Captcha/images/z.png
Changes
MANIFEST
Makefile.PL
README
examples/README
examples/wwwtest.cgi
license.txt
t/1.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
$captcha->output_folder('/some/http/folder');
# Alternitively, any of the methods to set variables may also be
# used directly in the constructor
my $captcha = Authen::Captcha->new(
data_folder => '/some/folder',
output_folder => '/some/http/folder',
);
# create a captcha. Image filename is "$md5sum.png"
my $md5sum = $captcha->generate_code($number_of_characters);
# check for a valid submitted captcha
# $code is the submitted letter combination guess from the user
# $md5sum is the submitted md5sum from the user (that we gave them)
my $results = $captcha->check_code($code,$md5sum);
# $results will be one of:
# 1 : Passed
# 0 : Code not checked (file error)
# -1 : Failed: code expired
data_folder => '/some/folder', # required
output_folder => '/some/http/folder', # required
expire => 300, # optional. default 300
width => 25, # optional. default 25
height => 35, # optional. default 35
images_folder => '/some/folder', # optional. default to lib dir
debug => 0, # optional. default 0
"$md5sum = $captcha->generate_code( $number_of_characters );"
Creates a captcha. Image filename is "$md5sum.png"
It can also be called in array context to retrieve the string of
characters used to generate the captcha (the string the user is
expected to respond with). This is useful for debugging. ex.
"($md5sum,$chars) = $captcha->generate_code( $number_of_characters
);"
"$results = $captcha->check_code($code,$md5sum);"
check for a valid submitted captcha $code is the submitted letter
Required. Sets the directory to hold the generated Captcha image
files. This is usually a web accessable directory so that the user
can view the images in here, but it doesn't have to be web
accessable (you could be attaching the images to an e-mail for some
verification, or some other Captcha implementation). Must be
writable by the process running the script (usually the web server
user, which is usually either "apache" or "http").
"$captcha->images_folder( '/some/folder' );"
Optional, and may greatly affect the results... use with caution.
Allows you to override the default character graphic png's and
backgrounds with your own set of graphics. These are used in the
generation of the final captcha image file. The defaults are held
in: [lib install dir]/Authen/Captcha/images
"$captcha->expire( 300 );"
Optional. Sets the number of seconds this captcha will remain valid.
This means that the created captcha's will not remain valid forever,
just as long as you want them to be active. Set to an appropriate
value for your application. Defaults to 300.
examples/wwwtest.cgi view on Meta::CPAN
}
sub default
{
my $md5sum = $captcha->generate_code($num_of_characters);
print header;
print "<HTML><HEAD></HEAD><BODY><FORM METHOD=post>
<INPUT TYPE=hidden name=crypt value=\"$md5sum\">
Please enter the characters in the image below: <INPUT TYPE=text name=code>
<BR>
<IMG SRC=\"$www_output_dir/$md5sum.png\"><BR>
<INPUT TYPE=submit>
</FORM></BODY></HTML>\n";
}
sub check_code
{
my ($code,$md5sum) = @_;
my $results = $captcha->check_code($code,$md5sum);
# $results will be one of:
( run in 0.628 second using v1.01-cache-2.11-cpan-788537b7465 )