# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::Image::Security
#   Author: Aki Mimoto
#   CVS Info : 087,071,086,086,085      
#   $Id: Security.pm,v 1.3 2006/11/03 18:55:35 brewt Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description: Creates an image with specified text with mild 
#              alterations to rendered text and background to
#              reduce machine legibility.
#

package GT::Image::Security;
# ==================================================================

use strict;
use vars qw/@ISA $ATTRIBS $ERRORS $DEBUG/;
use GT::Base;

$DEBUG = 0;
@ISA = 'GT::Base';

$ATTRIBS = {
    text           => '',

    height         => undef, # undef == automatic 
    width          => undef, # undef == automatic 
    image_type     => undef, # undef == automatic 

    fonts_path     => undef,

# Since this module will probably be working with the Bitstream fonts,
# the module by default has the settings to remove the fonts that are 
# difficult to read
    exclude_fonts  => [qw( Vera.ttf VeraIt.ttf VeraMoIt.ttf VeraMono.ttf VeraSe.ttf )],

# The number of steps each colour has. As truecolour
# is not being used automatically, 5 appears to be safest 
# value that regresses nicely across versions
    colour_steps   => 5,

# invert the intensity colours on the image?
    invert         => undef, # undef == automatic 

    max_x_wobble   => 20,
    max_y_wobble   => 20,
    max_ang_wobble => 30,
    base_pt        => 30,
    max_pt_wobble  => 15,
    max_obfuscates => undef, # undef == automatic 
    padding        => 10,

    display_chars  => undef, # undef == automatic 

# The following attributes are listed reference just as
# purposes. They shouldn't be used by the invoking application.
    _use_ttf       => 1,
    _fonts         => undef,
    _keyimage      => undef,
};

$ERRORS = {
    IMG_GD_FAIL   => 'Could not load GD. (%s)',
    IMG_FONT_PATH => 'Could not open font path (%s)',
    IMG_INIT_FAIL => 'Could not initialize image.',
    IMG_TYPE_FAIL => 'Could not determine if GD could render an image',
    IMG_DRAW_FAIL => 'Could not draw image because (%s).',
    IMG_DATA_FAIL => 'Could not generate data for image because (%s)'
};

sub new {
# -------------------------------------------------------------------
# Test to make sure GD is available on the system. If not, returns
# undef and records the error
#
    my $class = shift;
    local $@;
    eval { require GD };
    return $class->warn( IMG_GD_FAIL => "$@" ) if $@;
    return $class->SUPER::new( @_ );
}

sub init_fonts {
# -------------------------------------------------------------------
# This loads the fonts, tests to see if the system can handle truetype
# and if it can't, switches the system over to internal fonts
#
    my $self = shift;

# Find out if this system allows ttf to be used.
    my $use_ttf = UNIVERSAL::can( 'GD::Image', 'stringFT' );

    my @fonts;

# If the GD module supports the stringFT function
# which is used to render TrueType fonts onto the 
# image, let's see if we can load a couple of TTF files
    if ( $use_ttf and defined $self->{fonts_path} ) {
        my $exclude_font_lookup = {
            map {( lc $_ => 1 )} @{$self->{exclude_fonts}}
        };

        $self->debug( "Trying to load fonts from path: $self->{fonts_path}" ) if $self->{_debug};

        -d $self->{fonts_path} or return $self->warn( IMG_FONT_PATH => $self->{fonts_path} );
        opendir( FONTSDIR, $self->{fonts_path} ) or return $self->warn( IMG_FONT_PATH => "$!" );

        while ( my $f = readdir FONTSDIR ) {
            next unless $f =~ /\.ttf/i;
            next if $exclude_font_lookup->{lc $f};
            push @fonts, "$self->{fonts_path}/$f";
        }
        closedir FONTSDIR;

# Check to see that using the TTF support causes no errors
# We do this buy just faking a request to the function which 
# simply returns. If there was an error, it should be set in
# $@
        if ( @fonts ) {
            GD::Image->stringFT( 0, $fonts[0], 12, 0, 0, 0, 'GT' );
            $@ and $use_ttf = 0;
        }

        unless ( defined $self->{max_obfuscates} ) {
            $self->{max_obfuscates} = 10;
        }
    }

# Something didn't work in our attempt to use the TTF features
# we'll setup to use just the standard built in font faces
# though they may be easily cracked with an OCR based system.
    unless ( @fonts and $use_ttf ) {

# change the max obfuscations to 3 as 10 would obliterate
# the legibility of the text
        unless ( defined $self->{max_obfuscates} ) {
            $self->{max_obfuscates} = 3;
        }
        @fonts = ( 
            GD::gdGiantFont(),
# The next set of fonts are far too small 
# to be legible. The "Giant" font is rather 
# tiny on the screen as well.
#            GD::gdLargeFont()
#            GD::gdSmallFont()
#            GD::gdTinyFont()
        );

        $use_ttf = 0;
    }

# Debug output
    if ( $self->{_debug} ) {
        if ( $use_ttf ) {
            $self->debug( "Using Truetype Fonts. The following fonts are loaded:" );
            foreach my $font ( @fonts ) {
                $self->debug( "  $font" );
            }
        }
        else {
            $self->debug( "Using internal Fonts." );
        }
    }

    $self->{_use_ttf} = $use_ttf;
    $self->{_fonts}  = \@fonts;
}

sub init_image {
# --------------------------------------------------
# Create the image and fill in the background. Has
# a secondary effect of initializing the text
# string and calculating bounds on each character.
#
    my $self = shift;

    $self->{_keyimage} and return $self->{_keyimage};

    my ( $mx, $my ) = $self->calculate_bounds( @_ ) or return;

    my $keyimage_width  = $self->{width}  ||= $mx + $self->{padding} * 2,
    my $keyimage_height = $self->{height} ||= $my + $self->{padding} * 2;

    my $keyimage = $self->{_keyimage} = GD::Image->new(
        $keyimage_width,
        $keyimage_height
    ) or return $self->warn( 'IMG_INIT_FAIL' );

    $keyimage->fill( 
        0,  # x position to flood from
        0,  # y position to flood from
        $self->get_random_colour( -0.2 ) 
    );

    return $keyimage;
}

sub init_chars {
# --------------------------------------------------
# This will take the text to be rendered and randomly
# choose values on how they will be rendered.
#
    my $self = shift;

    $self->{text} = shift if @_;
    my $text = $self->{text} or return;

    my @display_chars;

    my $fonts = $self->init_fonts or return;

    foreach my $ch ( split //, $text ) {

# setup variable entities wobble
        my $f = $fonts->[int( @$fonts * rand )];
        my $a = ( $self->{max_ang_wobble} * ( 0.5 - rand() ) ) * 0.01745;
        my $y = int( rand() * $self->{max_y_wobble} );
        my $x = int( rand() * $self->{max_x_wobble} );
        my $p = $self->{base_pt} + ( int( $self->{max_pt_wobble} * ( 0.5 - rand() ) ) );

# the new character record.
        my $char_rec = {
            char    => $ch,
            font    => $f,
            angle   => $a,
            xoffset => $x,
            yoffset => $y,
            point   => $p,
        };

        push @display_chars, $char_rec;
    }

    $self->{display_chars} = \@display_chars;
}

sub init_colour_matrix {
# --------------------------------------------------
# This creates an NxNxN colour lookup matrix where
# N is equal to $self->{colour_steps}. This allows
# the fetching of colours quickly without need to
# create the colour entry in the swatch.
#
    my $self = shift;

# create the colour maps for the image
    my $colour_steps = $self->{colour_steps};
    my $fraction     = 255 / $colour_steps;

    my $colour_map = [];
    for my $r ( 0..$colour_steps ) {
        for my $g ( 0..$colour_steps ) {
            for my $b ( 0..$colour_steps ) {
                my @rgb = map { int( $_ * $fraction ) } ( $r, $g, $b );
                $colour_map->[$r][$g][$b] = $self->{_keyimage}->colorAllocate( @rgb );
            }
        }
    }

# do we want to invert the colours with the randomizer?
    unless ( defined $self->{invert} ) {
        $self->{invert} = rand > 0.5 ? 1 : 0;
    }

    $self->{colour_map} = $colour_map;
}

sub draw_image {
# --------------------------------------------------
# This method does the actual work of putting the
# characters onto a prepared image.
#
    my $self = shift;

    my $display_chars = $self->{display_chars};
    my $keyimage = $self->init_image or return;

    my $offset = $self->{padding};
    my $obfuscate_count  = 0;

# If we have TTF support use that as the display
# chars have been prepared with TTF support in mind
    if ( $self->{_use_ttf} ) {
        local $@;

        foreach my $char_rec ( @$display_chars ) {
            $keyimage->stringFT(  
                $self->get_random_colour( 0.6 ),
                $char_rec->{font}, 
                $char_rec->{point}, 
                $char_rec->{angle}, 
                $offset, 
                $char_rec->{yoffset} + $self->{padding}, 
                $char_rec->{char}
            );

            return $self->warn( IMG_DRAW_FAIL => "$@" ) if $@;

            $offset += $char_rec->{xoffset};

            if ( $obfuscate_count++ < $self->{max_obfuscates} ) {
                $self->obfuscate_image;
            }
        }
    }

# Unfortunately, TTF support is not available so attempt
# to regress as nicely as possible
    else {
        foreach my $char_rec ( @$display_chars ) {
            $keyimage->string(
                $char_rec->{font},
                $offset,
                $char_rec->{yoffset} + $self->{padding},
                $char_rec->{char},
                $self->get_random_colour( 0.6 )
            );

            $offset += $char_rec->{xoffset};
        }
    }

# Finish up the obfuscations
    while ( $obfuscate_count++ < $self->{max_obfuscates} ) {
        $self->obfuscate_image;
    }


    return 1;

}

sub obfuscate_image {
# --------------------------------------------------
# This randomly applies certain transformations to the
# key image to make it harder for machine readability.
# To add new obfuscation methods, the easiest way could
# be to subclass this module and override this function
#
    my $self = shift;

    my $mode = int( 2 * rand() );

    my $keyimage = $self->init_image or return;
    my $keyimage_width  = $self->{width};
    my $keyimage_height = $self->{height};

# Basic line
    if ( $mode == 1 ) {

# Find two edges to play with
        my @edges = sort { $a->[2] <=> $b->[2] } (
            [ 0, int(rand()*$keyimage_height), rand ], # left
            [ int(rand()*$keyimage_width), 0, rand], # top
            [ $keyimage_width, int(rand()*$keyimage_height), rand], # right
            [ int(rand()*$keyimage_width), $keyimage_height, rand ], # bottom
        );

        $keyimage->line( 
            @{$edges[0]}[0,1], 
            @{$edges[1]}[0,1], 
            $self->get_random_colour
        );
    }

# Draw a rectangle after acquiring two random points
    else {
        my @edges = (
            int(rand()*$keyimage_width), int(rand()*$keyimage_height),
            int(rand()*$keyimage_width), int(rand()*$keyimage_height)
        );

        $keyimage->rectangle( 
            @edges, 
            $self->get_random_colour
        );
    }

}

sub calculate_char_bounds {
# --------------------------------------------------
# Finds out the bounds for a single character. Based
# upon the setting provided.
#
    my ( $self, $char_rec ) = @_;

    my ( $vx, $vy );

# Must discern which of the methods are going to be
# used to display images.
    if ( $self->{_use_ttf} ) {

# calculate bounds
        my @b = GD::Image->stringFT( 
            0, 
            $char_rec->{font},
            $char_rec->{point},
            $char_rec->{angle},
            $char_rec->{xoffset},
            $char_rec->{yoffset},
            $char_rec->{char}
        );

# The docs for bounds on stringFT suggested that
# the elements should be a bit more ordered but
# having had odd experiences with the values. Ensure
# value sanity
        my ( $mxx, $mxy, $mix, $miy ) = (0,0,0,0);
        for ( my $i = 0; $i < 4 ; $i++ ) {
            my ( $x, $y ) = @b[$i*2,$i*2+1];
            $x > $mxx and $mxx = $x;
            $x < $mix and $mix = $x;
            $y > $mxy and $mxy = $y;
            $y < $miy and $miy = $y;
        }

        $vx = abs( $mxx - $mix );
        $vy = abs( $mxy - $miy );
        $char_rec->{yoffset} = $vy;

    }
    else {
        my $f = $char_rec->{font};
        $vx = $f->width()  + $char_rec->{xoffset};
        $vy = $f->height() + $char_rec->{yoffset};
    }

    $char_rec->{xoffset} = $vx;

    return ( $vx, $vy );
}

sub get_random_colour {
# --------------------------------------------------
# Returns a random GD image colour to be used in
# rendering fonts/lines/etc. The fraction value 
# is optional and determines what portion of the 
# palatte will be returned. A -1 < fraction < 0 will use
# the brightest n * 100% percent while a 0 < fraction < 1
# will consider the darkest n * 100% as possible results
#
    my ( $self, $fraction ) = @_;

    unless ( $self->{colour_map} ) {
        $self->init_colour_matrix;
    };

    $fraction ||= 1;
    $fraction *= ( $self->{invert} ? -1 : 1 );
    
    my $colour_steps = $self->{colour_steps};

    my @rgb;

    $fraction = $fraction * $colour_steps;
    if ( $fraction > 0 ) {
        @rgb = map { int($fraction*rand) } (1,2,3);
    }
    else {
        @rgb = map { int($colour_steps+$fraction*rand) } (1,2,3);
    }

    return $self->{colour_map}[$rgb[0]][$rgb[1]][$rgb[2]];

}

sub calculate_bounds {
# --------------------------------------------------
# Find out how much space all the text is going to
# occupy. This function will determine how large the
# image will be.
#
    my $self = shift;
    my $display_chars = $self->init_chars( @_ ) or return;

    my $my = 0;
    my $mx = 0;

    for my $char_rec ( @$display_chars ) {
        my ( $vx, $vy ) = $self->calculate_char_bounds( $char_rec );
        $mx += $vx;
        $my < $vy and $my = $vy;
    }

    return ( $mx, $my )
}

sub image_type {
# --------------------------------------------------
# Returns the image type of the output format favoured
# by GD
#
    my $self = shift;
    my $keyimage = $self->init_image or return;

# If the image type has not been predeclared,
# attempt to 
    unless ( defined $self->{image_type} ) {
        $self->{image_type} ||= 
            UNIVERSAL::can( $keyimage, 'png' )  ? 'png' :
            UNIVERSAL::can( $keyimage, 'gif' )  ? 'gif' :
            UNIVERSAL::can( $keyimage, 'jpeg' ) ? 'jpeg' :
            $self->warn( 'IMG_TYPE_FAIL' );
    }

    return $self->{image_type};
}

sub image_data {
# --------------------------------------------------
# Returns the data to the image in scalar format. Suitable
# for print
#
    my $self = shift;

    my $keyimage = $self->init_image or return;
    my $image_type = $self->image_type or return;

    $self->draw_image or return;

    local $@;
    my $data;

    eval { $data = $keyimage->$image_type() };

    $@ and return $self->warn( IMG_DATA_FAIL => "$@" ); # copy value

    return $data;
}

1;
__END__

=head1 NAME

GT::Image::Security - Using the GD module, creates an image with text.

=head1 SYNOPSIS

    use GT::Image::Security;

    my $sec_image  = GT::Image::Security->new(
        fonts_path => "/home/aki/public_html/fonts",
        text       => "Hello World"
    ) or die $GT::Image::Security::error;

    # some versions have gif, others png
    my $img_type = $sec_image->image_type();

    print "Content-type: image/$img_type\n\n";
    print $sec_image->image_data;

=head1 DESCRIPTION

Creates an image with specified text with mild alterations to rendered text 
and background to reduce machine legibility. Whenever it can, it will attempt 
to use TrueType fonts as the internal fonts tend to be difficult to read 
and very limited in the number of transformations possible.

=head1 INTERFACE

=head2 new 

Creates a new security image handler with all options populated but does 
not initialize the image. While most option are set by default or automatically,
certain behaviours can be forced quite easily by passing in a new value.

new will return undef if the GD module cannot be loaded. The exact details of the 
error can be retreived from $GT::Image::Security::error or through the normal 
GT::Base error function mechanism.

The following is a list of attributes that can be used to customize the output.

=over 4

=item text

Required. The string to be rendered in the image.

=item fonts_path

Optional. Required only if TrueType support is desired, it should be the path to the directory that holds .TTF files.

=item height

Optional. Typically automatically calculated, setting this will force the image to the specified height. (Output will be clipped if not tall enough)

=item width

Optional. Typically automatically calculated, setting this will force the image to the specified width. (Output will be clipped if not wide enough)

=item image_type

Optional. Set to png/jpeg/gif if the output format is important. If GD does not support the rendering method for the type of image, image_data will return undef and an error will be set.

=item exclude_fonts

Optional. Arrayref of filenames to ignore when scanning fonts for reasons such as illegibility. By default, the settings have been configured to work with the Bitstream Vera selection of fonts.

=item colour_steps

Optional. The number of steps between 0..255 in relation to the brightness of a single colour channel. By default, it has been set to 5 as older GD modules only support 256 colours.

=item invert

Optional. Typically automatically chosen, it will invert the colour selections so instead of dark colours for the foreground, brighter colours will be chosen instead. Similarly for the background, from bright, dark colours will be chosen instead.

=item max_x_wobble 

Optional. Maximum number of pixels to randomly offset characters from ideal position along the horizontal axis.

=item max_y_wobble 

Optional. Maximum number of pixels to randomly offset characters from ideal position along the vertical axis.

=item max_ang_wobble

Optional. Only affects TrueType fonts, internal fonts will not use this feature. The maximum amount of random angular rotation for each character in the text.

=item base_pt

Optional. Only affects TrueType fonts, internal fonts will not use this feature. This sets the base point size of the font.

=item max_pt_wobble

Optional. Only affects TrueType fonts, internal fonts will not use this feature. The maximum amount of random deviation from the base_pt size for each chacter rendered.

=item max_obfuscates

Optional. Usually set automatically, this sets the number of times the obfuscate_image action will be called uon the image. The action randomly draws a line or a rectangle on the image to provide chaff for any attempt to use OCR type software to extract the text from the image.

=item padding

Optional. The amount of extra pixel space that should be around the text.

=item display_chars

Optional. Typically shouldn't be used. However, it may be useful in situations where you would like to reproduce the image. After image_data has been called, squirrel away the value of $obj->{display_chars} and it will contain all the settings to be able to regenerate the image's core parts. Note: it does not store colour information so while the positions and size of the image would be the same, the colours would be different.

=back

=head2 image_type

Returns the type of image the module will attempt to produce. The results
can be "png", "gif", and "jpeg", fit for inserting into a mimetype header.

If an error occurs in the testing or no rendering methods could be found,
the function will return undef. The details on the error can be retrieved 
through $obj->error

=head2 image_data

Returns a scalar with binary data which comprise the image. The image type 
can be preset via the "image_type" attribute or accertained by the 
image_type() method.

If an error occurs in the testing or no rendering methods could be found,
the function will return undef. The details on the error can be retrieved 
through $obj->error

=head1 SEE ALSO

GD, http://stein.cshl.org/WWW/software/GD/

=head1 MAINTAINER

Aki Mimoto


=head1 COPYRIGHT

Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
http://www.gossamer-threads.com

=head1 VERSION

Revision: $Id: Security.pm,v 1.3 2006/11/03 18:55:35 brewt Exp $

=cut
