use strict;

use lib qw( builder );

use Build;

my $mb = Build->new;

$mb->change_versions(1);

$mb->create_build_script;

Time zone is GMT+2.

1.70 Thu Apr 30 16:56:32 2009

    => Made a mistake. version checking test is really gone now.

t/98-gd.t

t/99-magick.t

t/magick.pl

eg/demo.pl

Changes

Build.PL

{

    module_name    => 'GD::SecurityImage',

    meta_merge => {

        resources => {

            repository => 'http://bitbucket.org/burak/cpan-gd-securityimage/',

# -> GD::SecurityImage demo program

# See the document section after "__END__" for license and other information.

use strict;

use CGI  qw( header escapeHTML );

use Cwd;

   database   => 'gdsi',                 # database name (for session storage)

   table_name => 'sessions',             # only change this value, if you *really* have to use another table name. Also change the SQL code below.

   user       => 'root',                 # database user name

   itype      => 'png',                  # image format. set this to gif or png or jpeg

   use_magick => 0,                      # use Image::Magick or GD

   img_stat   => 1,                      # display statistics on the image?

);

# You'll need this to create the sessions table. 

# - - - - - - - - - - - - - - > S T A R T   P R O G R A M < - - - - - - - - - - - - - - #

use constant REQUIREDMODS => qw(

   DBI

      local $SIG{__DIE__};

      local $@;

      my $mod = shift;

   };

   $test->($_) foreach REQUIREDMODS;

   if ( @errors ) {

      my $err = qq{<pre>This demo program needs several CPAN modules to run:\n\n};

      foreach my $e ( @errors ) {

               . qq~ $e->{module}</b>: $e->{error}<br />~;

      }

      exit;

   }

}

run() if not caller; # if you require this, you'll need to call demo::run()

sub TEST_FONT_EXISTENCE {

   if ( not $config{use_magick} ) {

      }

   }

   }

   else {

   }

}

sub new {

   my $self  = {

      ISDISPLAY => 0,

      SID       => undef,

      IS_GD     => 0,

   };

   bless $self, $class;

}

sub run {

   $self->{program} = $config{program};

   if ( ! $self->{program} ){

      # it is possible to get the url as "demo.pl??foo=bar"

   }

   my %options      = $self->all_options;

   my %styles       = $self->all_styles;

   my %session;

   my $create_ses = sub { # fetch/create session

      my $sid = @_ ? undef : $self->{cgi}->cookie('GDSI_ID');

         Handle     => $dbh,

         LockHandle => $dbh,

         TableName  => $config{table_name},

      };

   };

   # I'm doing a little trick to by-pass exceptions if the session id

   # coming from the user no longer exists in the database. 

      $create_ses->('new');

   }

      $session{security_code} = $self->_random; # initialize random code

   }

   $self->{ISDISPLAY} = $self->{cgi}->param('display') || 0;

   $self->{SID}       = $session{_session_id};

   if ( $self->{ISDISPLAY} ) {

      $START = Time::HiRes::time();

   untie %session;

   $dbh->disconnect;

   exit;

}

sub process {

   my $self = shift;

   my $pass = $self->iseq( $code, $ses );

   my $meth = $pass ? '_congrats' : '_failure';

   return $self->$meth( $code, $ses );

sub backenduri {

   my $self = shift;

      $rv  .= $self->{IS_GD}

            : qq~<a href="$self->{CPAN}/PerlMagick" target="_blank">Image::Magick</a> v$Image::Magick::VERSION~;

   return $rv . '</b>';

}

sub _failure {

   my $self = shift;

      <b>'${code}' != '${ses}'</b>

      <br />

      <span style="color:red;font-weight:bold">

      You have failed to identify yourself as a human!

      </span>

   $rv .= $self->form();

   return $rv;

}

sub _congrats {

   my $self = shift;

      <b>'$form' == '$ses'</b>

      <br />

      <span style="color:#009700;font-weight:bold">

      <br />

      <br />

      <a href="$self->{program}">Try again</a>

}

sub iseq {

   my $self = shift;

   my $form = shift || return;

   my $ses  = shift || return;

   return $form eq $ses;

}

sub myheader {

   my $display = $self->{ISDISPLAY};

   my $type    = $o{type} ? $o{type}

               : $display ? 'image/'.$config{itype}

                    -value => $self->{SID},

                 );

   return $self->{cgi}->header(

      -cookie => $c

   );

}

sub help {

   my $self = shift;

If you want to change the image generation options, open this file with

a text editor and search for the <b>%config</b> hash.

</table>

}

sub form {

   my $self = shift;

   # by-pass browser cache with this random fake value

   <form action="$self->{program}" method="post">

    <table border="0" cellpadding="2" cellspacing="1">

     <tr>

     </tr>

    </table>

   </form>

}

sub html_head {

   my $self = shift;

"http://www.w3.org/TR/html4/loose.dtd">

<html>

   <head>

    <h2><a href   = "$self->{CPAN}/GD-SecurityImage"

           target = "_blank"

           >GD::SecurityImage</a> v$GD::SecurityImage::VERSION - DEMO v$VERSION</h2>

}

sub html_foot {

      lines   => $s->{lines},

      bgcolor => $s->{bgcolor},

      %{ $self->{rnd_opt} },

   );

   if ($i->gdbox_empty) {

         .qq~Please set font option to an "exact" path, not relative. Error: $@~;

   }

   if ($config{img_stat}) {

         y      => 'up',

         gd     => 1,

         strip  => 1,

         # low-level access to an object table is not a good thing,

         # since the author can change/delete it without notification 

         # in later releases ;)

                           Time::HiRes::time() - $START),

      );

   }

}

sub all_styles {

   return ec => {

      name       => 'ec',

      lines      => 16,

   },

   ellipse => {

      name       => 'ellipse',

      bgcolor    => [208, 202, 206],

      text_color => [184,  20, 180],

      line_color => [184,  20, 180],

   },

   circle => {

      name       => 'circle',

      bgcolor    => [210, 215, 196],

      line_color => [210, 215, 196],

      particle   => 3500,

   },

   rect => {

      name       => 'rect',

      lines      => 30,

      line_color => [226, 223, 169],

      particle   => 2000,

   },

package GD::SecurityImage;

use strict;

use GD::SecurityImage::Styles;

use Carp qw(croak);

sub import {

   # init/reset globals

   # load the drawing interface

   if ( exists $opt{use_magick} && $opt{use_magick} ) {

      require GD::SecurityImage::Magick;

      $BACKEND = 'Magick';

   }

   elsif ( exists $opt{backend} && $opt{backend} ) {

      croak "Unable to locate the $class back-end $be: $@" if $@;

      $BACKEND = $opt{backend} eq 'AC' ? 'GD' : $opt{backend};

   }

      require GD::SecurityImage::GD;

      $BACKEND = 'GD';

   }

   return;

}

sub new {

      $BACKEND || croak "You didn't import $class!";

   my $self  = {

      IS_MAGICK       => $BACKEND eq 'Magick',

      DISABLED        => {}, # list of methods that a backend (or some older version of backend) can't do

      MAGICK          => {}, # Image::Magick configuration options

      GDBOX_EMPTY     => 0,  # GD::SecurityImage::GD::insert_text() failed?

      _RNDMAX_        => 6,  # maximum number of characters in a random string.

      _COLOR_         => {}, # text and line colors

      _CREATECALLED_  => 0,  # create() called? (check for particle())

   };

   bless $self, $class;

   my %options = (

      rndmax     => $opt{rndmax}              || $self->{_RNDMAX_},

      send_ctobg => $opt{send_ctobg}          || 0,

      frame      => defined($opt{frame}) ? $opt{frame} : 1,

      scramble   => $opt{scramble}            || 0,

      thickness  => $opt{thickness}           || 0,

      _ANGLES_   => [], # angle list for scrambled images

   );

}

sub backends {

   my $self  = shift;

   my $class = ref($self) || $self;

   my(@list, @dir_list);

   foreach my $inc (@INC) {

      my $dir = "$inc/GD/SecurityImage";

      next unless -d $dir;

      push @dir_list, $dir;

      foreach my $file (@dir) {

         next if -d $file;

         push @list, $file;

      }

   }

}

sub gdf {

   return if not $self->{IS_GD};

}

sub random_angle {

   return $r[int rand @r];

}

sub random {

   my $self = shift;

         $random .= $keys[int rand $lk] for 1..$self->{rndmax};

         $self->{_RANDOM_NUMBER_} = $random;

   }

}

sub cconvert { # convert color codes

   # GD           : return color index number

   # Image::Magick: return hex color code

   my $self   = shift;

   return $self->backend_cconvert($data) if not $self->{IS_CORE};

   my $is_hex    = $self->is_hex($data);

   my $magick_ok = $self->{IS_MAGICK} && $data && $is_hex;

   # data is a hex color code and Image::Magick has hex support

   return $data if $magick_ok;

                    $data >= 0;

   if( $color_code ) {

   }

   my @rgb = $self->h2r($data);

   $data = [@rgb] if @rgb;

   # initialize if not valid

      $data = [0, 0, 0];

   }

   foreach my $i (0..$#{$data}) { # check for bad values

         $data->[$i] = 0;

      }

   }

   # be a smart module and auto-disable ttf if we are under a prehistoric GD

   if ( not $self->{IS_MAGICK} ) {

   }

      $self->{gd_font} = $self->gdf('giant');

   }

   }

   $self->{_CREATECALLED_}++;

}

sub particle {

   # Create random dots. They'll cover all over the surface

   my $self = shift;

   my $big  = $self->{height} > $self->{width} ? $self->{height} : $self->{width};

   my $dots = shift || 1; # number of multiple dots

   if ( ! $int ) { # RT#33629

      return;

   }

   my @random;

      push @random, $x;

   }

   my $tc  = $self->{_COLOR_}{text};

   my $len = @random;

   my $r   = sub { $random[ int rand $len ] };

         $self->setPixel($x + $z         , $y + $z         , $tc);

         $self->setPixel($x + $z + $r->(), $y + $z + $r->(), $tc);

      }

   undef @random;

   undef $r;

}

sub info_text { # set text location

   # x      => 'left|right',  # text-X

   # color  => '#000000',     # text color

   # scolor => '#FFFFFF',     # strip color

   # text   => 'blah',        # modifies random code

   return if not %o;

   $self->{_TEXT_LOCATION_}{_place_} = 1;

   $o{scolor}                        = $self->cconvert($o{scolor})       if $o{scolor};

   $self->{_TEXT_LOCATION_}->{$_} = $o{$_} foreach keys %o;

   $self->insert_text('ttf');