File Coverage

blib/lib/GD/RPPNG.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package GD::RPPNG;

# Author: Pascal Gloor [e-mail]
# Date: 11 Oct 2003

require 5.004;
require GD;

use strict;
use warnings;
use GD 2.11;

our $VERSION = '0.9';

############# Code Begin

# Turn off buffering
$|=1;

# Definition of the main hash
my %opt;

# Declaration of new object with data types defined and blessed for use
sub new
{
    my $package = shift;
    my $object = { myimage => [] };
    my $bless = bless($object, $package);
    _defaults($bless);
    return $bless;
}

# Setting all options to their default value
sub _defaults
{
    my $self = shift;
    $opt{$self}{xsize}               = 400;
    $opt{$self}{ysize}               = 75;
    $opt{$self}{charset}             = 'ABCDEFGHJKLMNPQRSTUVWXYZ23456789%&#$@';
    $opt{$self}{codelen}             = 8;
    $opt{$self}{colors}              = 1;
    $opt{$self}{fontminpt}           = 12;
    $opt{$self}{fontmaxpt}           = 28;
    $opt{$self}{xlinesfactor}        = 10;
    $opt{$self}{ylinesfactor}        = 10;
    $opt{$self}{ydivert}             = 10;
    $opt{$self}{angle}               = 45;
    $opt{$self}{transparent}         = 0;
    $opt{$self}{debugcode}           = 0;
    @{$opt{$self}{bgcolor}}          = ( 255, 255, 255 );
    @{$opt{$self}{fgcolor}}          = ( 0, 0, 0 );
    $opt{$self}{code}                = '';

    undef @{$opt{$self}{ttf}};
}

# User overriding default options
sub Config
{
    my $self = shift;
    my @options = @_ if (@_);

    while(@options)
    {
        my $name = shift(@options);
        $name =~ tr/[A-Z]/[a-z]/;
        my $value = shift(@options);
        if ( $name =~ /bgcolor|fgcolor/ )
        {
            $value =~ s/(..)(..)(..)/$1 $2 $3/;
            my ($r,$g,$b) = split(/ /,$value);
            @{$opt{$self}{$name}} = ( hex($r), hex($g), hex($b) );
        }
        else
        {
            $opt{$self}{$name}=$value;
        }
    }
}

# Adding a TrueType Font
sub AddFonts
{
    my $self = shift;
    my $font = shift;
    if ( -r "$font" )
    {
        push(@{$opt{$self}{ttf}},$font);
    }
    else
    {
        warn "Could not read TrueType Font \"$font\"\n";
    }
}

# Generating a random password
sub _gencode
{
    my $self = shift;
    my $len = length($opt{$self}{charset});
    my @charset;
    $opt{$self}{code} = '';

    foreach ( split(//,$opt{$self}{charset}) )
    {
        push(@charset,$_);
    }

    for ( 1 .. $opt{$self}{codelen} )
    {
        $opt{$self}{code} .= $charset[(int(rand(length($opt{$self}{charset}))))];
    }
}

# Generating the image
sub GenImage
{

    my $self = shift;

    # generate a random password if not set
    if ( !length($opt{$self}{code}) )
    {
        _gencode($self);
    }

    my $fonts = @{$opt{$self}{ttf}};

    # create base image
    my $image = new GD::Image($opt{$self}{xsize},$opt{$self}{ysize});

    # setting back/fore-ground colors
    my $fgcolor = $image->colorAllocate(@{$opt{$self}{fgcolor}});
    my $bgcolor = $image->colorAllocate(@{$opt{$self}{bgcolor}});

    # setting background as transparent if requested
    if ( $opt{$self}{transparent} )
    {
        $image->transparent($bgcolor);
    }

    my @colors;

    # adding some colors to the palette
    if ( $opt{$self}{colors} )
    {
        foreach(1..50)
        {
            push(@colors,$image->colorAllocate(
                int(rand(200)),
                int(rand(200)),
                int(rand(200)) ) );
        }
    }

    # setting the background
    $image->filledRectangle(0,0,$opt{$self}{xsize}-1,$opt{$self}{ysize}-1,$bgcolor);

    my $ncolors = @colors;
    my $pos = 10;

    # loop on each code char
    foreach(split(//,$opt{$self}{code}))
    {

        # setting font color and deviation
        my $color = $fgcolor;
        my $margin = int( $opt{$self}{ysize} * $opt{$self}{ydivert} / 100 );
        my $dev   = int( rand( $margin ) + ( ( $opt{$self}{ysize} - $margin ) / 2 ) );

        # re-setting color
        if ( $opt{$self}{colors} )
        {
            $color = $colors[int(rand($ncolors-2))+2];
        }

        # printing the char
        if ( @{$opt{$self}{ttf}} )
        {
            my $pt = int( rand( $opt{$self}{fontmaxpt} - $opt{$self}{fontminpt} ) + $opt{$self}{fontminpt} );
            my $angle = 0;
            if ( $opt{$self}{angle} )
            {
                $angle = sprintf("%0.2f", rand($opt{$self}{angle}/180*3.14) - ( $opt{$self}{angle}/360*3.14) );
            }

            $image->stringFT(
                $color,
                @{$opt{$self}{ttf}}[int(rand($fonts))],
                $pt,
                $angle,
                $pos,
                $dev+($pt/2),
                $_
            );
        }
        else
        {
            $image->string(gdGiantFont,$pos,$dev,$_,$color);
        }

        # moving the position forward for the next char
        $pos += int($opt{$self}{xsize}/length($opt{$self}{code}));
    }


    # printing the X lines
    for ( 1 .. ( $opt{$self}{xsize} * $opt{$self}{xlinesfactor} / 100 ) )
    {
        my $pos = int( rand($opt{$self}{xsize} ) );
        my $color = $fgcolor;

        if ( $opt{$self}{colors} )
        {
            $color = $colors[int(rand($ncolors))];
        }

        $image->line($pos,0,$pos,$opt{$self}{ysize},$color);
    }

    # printing the Y lines
    for ( 1 .. ( $opt{$self}{ysize} * $opt{$self}{ylinesfactor} / 100 ) )
    {
        my $pos = int( rand($opt{$self}{ysize} ) );
        my $color = $fgcolor;

        if ( $opt{$self}{colors} )
        {
            $color = $colors[int(rand($ncolors))];
        }

        $image->line(0,$pos,$opt{$self}{xsize},$pos,$color);
    }

    # adding the code to the image if debugcode enabled
    if ( $opt{$self}{debugcode} )
    {
        $image->filledRectangle(0,0,length($opt{$self}{code})*11+10,15,$fgcolor);
        $image->string(gdMediumBoldFont,0,0,"Code: $opt{$self}{code}",$bgcolor);
    }

    # return the code and the generated image
    return (
        $opt{$self}{code},
        $image->png,
    );

    delete $opt{$self};
}

############# Code End

1;
__END__