The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl -w
use strict;
use warnings;
use vars qw( %API );
use Test::More;
use Cwd;
use Carp qw(croak);
use lib qw(
   ..
   ../t/lib
      t/lib
);

BEGIN {
   %API = (
      gd_normal                       => 6,
      gd_ttf                          => 6,
      gd_normal_scramble              => 6,
      gd_ttf_scramble                 => 6,
      gd_ttf_scramble_fixed           => 6,
      gd_normal_info_text             => 6,
      gd_ttf_info_text                => 6,
      gd_normal_scramble_info_text    => 6,
      gd_ttf_scramble_info_text       => 6,
      gd_ttf_scramble_fixed_info_text => 6,
   );
   my $total  = 0;
      $total += $API{$_} foreach keys %API;
   plan tests => $total;
   require GD::SecurityImage;
   import  GD::SecurityImage;
}

use Test::GDSI;

my $tapi = 'Test::GDSI';
   $tapi->clear;

my $font = getcwd.'/StayPuft.ttf';

my %info_text = (
   text   => $tapi->the_info_text,
   ptsize => 8,
   color  => '#000000',
   scolor => '#FFFFFF',
);

foreach my $api (keys %API) {
   $tapi->options(args($api), extra($api));
   my $c = 1;
   foreach my $style ($tapi->styles) {
      ok(
         $tapi->save(
            $api->$style()->out(
               force    => 'png',
               compress => 1,
            ),
            $style,
            $api,
            $c++
         ),
         "$style - $api - $c++"
      );
   }
   $tapi->clear;
}

sub extra {
   my $name = shift;
   if ( $name =~ m{ _info_text \z}xms ) {
      my %extra = ( info_text => {%info_text} );
      if ( $name =~ m{ normal }xms ) {
         $extra{info_text}->{gd} = 1;
      }
      if ($name =~ m{ fixed }xms ) {
         # yes, we can use GD' s internal font and ttf together...
         $extra{info_text}->{gd} = 1;
      }
      return %extra;
   }
   return +();
}

sub args {
   my $name = shift;
   my %options = (
   gd_normal => {
      width      => 120,
      height     => 30,
      send_ctobg => 1,
      gd_font    => 'Giant',
   },
   gd_ttf => {
      width      => 210,
      height     => 60,
      send_ctobg => 1,
      font       => $font,
      ptsize     => 25,
   },
   gd_normal_scramble =>  {
      width      => 120,
      height     => 30,
      send_ctobg => 1,
      gd_font    => 'Giant',
      scramble   => 1,
   },
   gd_ttf_scramble =>  {
      width      => 300,
      height     => 90,
      send_ctobg => 1,
      font       => $font,
      ptsize     => 20,
      scramble   => 1,
   },
   gd_ttf_scramble_fixed =>  {
      width      => 350,
      height     => 90,
      send_ctobg => 1,
      font       => $font,
      ptsize     => 25,
      scramble   => 1,
      angle      => 30,
   },
   );
   my $o = $options{$name};
   if ( not $o ) {
     (my $tmp = $name) =~ s{ _info_text }{}xms;
      $o = $options{$tmp};
   }
   croak "Bogus arg name $name!" if not $o;
   return %{$o}
}