File Coverage

lib/GD/SecurityImage/Utils.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package GD::SecurityImage::Utils;
use GD::SecurityImage;
use strict;
use vars qw(@EXPORT @ISA $VERSION);
use Exporter;
@ISA = qw/Exporter/;
@EXPORT = ('write_captcha');
$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)/g;

$GD::SecurityImage::Utils::DEBUG=0;
sub DEBUG : lvalue { $GD::SecurityImage::Utils::DEBUG }


sub find_a_ttf_file {

   my @arg = ('find','/usr/share/fonts/','-type','f', '-image', '"*ttf"');
   my @files = split (/\n/, `@arg`);
   scalar @files or warn("no ttf fount with [@arg]") and return;
   return $files[0];
}






sub write_captcha {
   my ($abs_out,$opt)=@_;
   if (defined $opt){
      ref $opt eq 'HASH' or croak('must be hash ref');
   }
   $opt||={};




		# captcha
		$opt->{width}   ||= 140;
		$opt->{height}  ||= 50;
		$opt->{ptsize}  ||= 32;
		$opt->{lines}   ||= 14;
		$opt->{rndmax}  ||= 4;
		$opt->{font}    ||= undef; #'/var/www/public_html/.icons/luxisr.ttf';
      $opt->{bgcolor} ||= '#dddddd';
   # Create a normal image

   $abs_out=~/[^\/]\.(\w{1,5})$/ or die("abs out $abs_out cant match extension type");
   my $ext = lc($1);
   $ext eq 'png'
      or $ext eq 'gif'
      or $ext eq 'jpg'
      or $ext eq 'jpeg'
      or die("extension $ext for $abs_out is not an acceptable image format");




   my $image = new GD::SecurityImage (
		width   => $opt->{width},
      height  => $opt->{height},
      lines   => $opt->{lines},
		bgcolor => $opt->{bgcolor},
		ptsize  => $opt->{ptsize},
		rndmax  => $opt->{rndmax}, # TODO change to at least 4 for release
		send_ctobg => 0,
		font    => $opt->{font},
		# if the font is not present, or illegible by the uid, the words do not show in the image.
	);

   $image->random();
   $image->create('ttf','circle','#113377', '#225599');
	$image->particle(700,6);

   my($image_data, $mime_type, $correct_code) = $image->out();



	print STDERR "login captcha mime: $mime_type, random number: $correct_code\n" if DEBUG;

   open(OUT,'>',$abs_out) or die;
   binmode OUT;
   print OUT $image_data;

   return $correct_code;
}










1;

__END__