From 10e070060468116b1686dc01b4d26ae986920676 Mon Sep 17 00:00:00 2001 From: briandilley Date: Mon, 23 Oct 2006 22:17:02 +0000 Subject: [PATCH] added GD::SecurityImage --- deps/GD/SecurityImage.pm | 1055 +++++++++++++++++++++++++++++++ deps/GD/SecurityImage/GD.pm | 306 +++++++++ deps/GD/SecurityImage/Magick.pm | 210 ++++++ deps/GD/SecurityImage/Styles.pm | 110 ++++ 4 files changed, 1681 insertions(+) create mode 100644 deps/GD/SecurityImage.pm create mode 100644 deps/GD/SecurityImage/GD.pm create mode 100644 deps/GD/SecurityImage/Magick.pm create mode 100644 deps/GD/SecurityImage/Styles.pm diff --git a/deps/GD/SecurityImage.pm b/deps/GD/SecurityImage.pm new file mode 100644 index 0000000..21c615a --- /dev/null +++ b/deps/GD/SecurityImage.pm @@ -0,0 +1,1055 @@ +package GD::SecurityImage; +use strict; +use vars qw[@ISA $AUTOLOAD $VERSION $BACKEND]; +use GD::SecurityImage::Styles; + +$VERSION = '1.61'; + +sub import { + my $class = shift; + my %opt = scalar(@_) % 2 ? () : (@_); + # init/reset globals + $BACKEND = ''; # name of the back-end + @ISA = (); + # load the drawing interface + if (exists $opt{use_magick} && $opt{use_magick}) { + require GD::SecurityImage::Magick; + $BACKEND = 'Magick'; + } elsif (exists $opt{backend} && $opt{backend}) { + my $be = __PACKAGE__.'::'.$opt{backend}; + eval "require $be"; + die "Unable to locate the $class back-end $be: $@" if $@; + $BACKEND = $opt{backend} eq 'AC' ? 'GD' : $opt{backend}; + } else { + require GD::SecurityImage::GD; + $BACKEND = 'GD'; + } + push @ISA, 'GD::SecurityImage::' . $BACKEND; + push @ISA, qw(GD::SecurityImage::Styles); # load styles +} + +sub new { + my $class = shift; + $BACKEND || die "You didn't import $class!"; + my %opt = scalar @_ % 2 ? () : (@_); + my $self = { + IS_MAGICK => $BACKEND eq 'Magick', + IS_GD => $BACKEND eq 'GD', + IS_CORE => $BACKEND eq 'GD' || $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? + _RANDOM_NUMBER_ => '', # random security code + _RNDMAX_ => 6, # maximum number of characters in a random string. + _COLOR_ => {}, # text and line colors + _CREATECALLED_ => 0, # create() called? (check for particle()) + _TEXT_LOCATION_ => {}, # see info_text + }; + bless $self, $class; + my %options = ( + width => $opt{width} || 80, + height => $opt{height} || 30, + ptsize => $opt{ptsize} || 20, + lines => $opt{lines} || 10, + rndmax => $opt{rndmax} || $self->{_RNDMAX_}, + rnd_data => $opt{rnd_data} || [0..9], + font => $opt{font} || '', + gd_font => $self->gdf($opt{gd_font}) || '', + bgcolor => $opt{bgcolor} || [255, 255, 255], + send_ctobg => $opt{send_ctobg} || 0, + frame => defined($opt{frame}) ? $opt{frame} : 1, + scramble => $opt{scramble} || 0, + angle => $opt{angle} || 0, + thickness => $opt{thickness} || 0, + _ANGLES_ => [], # angle list for scrambled images + ); + if($opt{text_location} && ref $opt{text_location} && ref $opt{text_location} eq 'HASH') { + $self->{_TEXT_LOCATION_} = { %{$opt{text_location}}, _place_ => 1 }; + } else { + $self->{_TEXT_LOCATION_}{_place_} = 0; + } + $self->{_RNDMAX_} = $options{rndmax}; + + $self->{$_} = $options{$_} foreach keys %options; + if($self->{angle}) { # validate angle + $self->{angle} = 360 + $self->{angle} if $self->{angle} < 0; + if($self->{angle} > 360) { + die "Angle parameter can take values in the range -360..360"; + } + } + + if ($self->{scramble}) { + if ($self->{angle}) { + # Does the user want a fixed angle? + push @{ $self->{_ANGLES_} }, $self->{angle}; + } else { + # Generate angle range. The reason for hardcoding these is; + # it'll be less random for 0..60 range + push @{ $self->{_ANGLES_} }, (0,5,8,15,22,26,29,33,35,36,40,43,45,53,56); + push @{ $self->{_ANGLES_} }, map {360 - $_} @{ $self->{_ANGLES_} }; # push negatives + } + } + $self->init; + return $self; +} + +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; + local *DIR; + opendir DIR, $dir or die "opendir($dir) failed: $!"; + my @dir = readdir DIR; + closedir DIR; + push @dir_list, $dir; + foreach my $file (@dir) { + next if -d $file; + next if $file =~ m[^\.]; + next if $file =~ m[^(Styles|AC|Handler)\.pm$]; + $file =~ s[\.pm$][]; + push @list, $file; + } + } + if (defined wantarray) { + return @list; + } else { + print "Available back-ends in $class v$VERSION are:\n\t" + .join("\n\t", @list) + ."\n\n" + ."Search directories:\n\t" + .join("\n\t", @dir_list); + } +} + +sub gdf { + my $self = shift; + return if not $self->{IS_GD}; + return $self->gdfx(@_); +} + +sub random_angle { + my $self = shift; + my @angles = @{ $self->{_ANGLES_} }; + my @r; + push @r, $angles[int rand @angles] for 0..$#angles; + return $r[int rand @r]; +} + +sub random_str { shift->{_RANDOM_NUMBER_} } + +sub random { + my $self = shift; + my $user = shift; + if($user and length($user) >= $self->{_RNDMAX_}) { + $self->{_RANDOM_NUMBER_} = $user; + } else { + my @keys = @{ $self->{rnd_data} }; + my $lk = scalar @keys; + my $random; + $random .= $keys[int rand $lk] for 1..$self->{rndmax}; + $self->{_RANDOM_NUMBER_} = $random; + } + return $self if defined wantarray; +} + +sub cconvert { # convert color codes + # GD : return color index number + # Image::Magick: return hex color code + my $self = shift; + my $data = shift || die "Empty parameter passed to cconvert!"; + unless($self->{IS_CORE}) { + return $self->backend_cconvert($data); + } + my $is_hex = $self->is_hex($data); + if($data && $self->{IS_MAGICK} && $is_hex) { + return $data; # data is a hex color code and Image::Magick has hex support + } + if( $data && + ! $is_hex && + ! ref($data) && + $data !~ m{[^0-9]} && + $data >= 0 + ) { + if ($self->{IS_MAGICK}) { + die "The number '$data' can not be transformed to a color code!"; + } else { + # data is a GD color index number ... + # ... or it is any number! since there is no way to determine this. + # GD object' s rgb() method returns 0,0,0 upon failure... + return $data; + } + } + my @rgb = $self->h2r($data); + if(@rgb and $self->{IS_MAGICK}) { + return $data; + } else { + $data = [@rgb] if @rgb; + # initialize if not valid + if(not $data || not ref $data || ref $data ne 'ARRAY' || $#{$data} != 2) { + $data = [0, 0, 0]; + } + foreach my $i (0..$#{$data}) { # check for bad values + $data->[$i] = 0 if $data->[$i] > 255 or $data->[$i] < 0; + } + } + return $self->{IS_MAGICK} ? $self->r2h(@{$data}) # convert to hex + : $self->{image}->colorAllocate(@{$data}); +} + +sub create { + my $self = shift; + my $method = shift || 'normal'; # ttf or normal + my $style = shift || 'default'; # default or rect or box + my $col1 = shift || [ 0, 0, 0]; # text color + my $col2 = shift || [ 0, 0, 0]; # line/box color + + $self->{send_ctobg} = 0 if $style eq 'box'; # disable for that style + $self->{_COLOR_} = { # set the color hash + text => $self->cconvert($col1), + lines => $self->cconvert($col2), + }; + + # be a smart module and auto-disable ttf if we are under a prehistoric GD + unless ($self->{IS_MAGICK}) { + $method = 'normal' if defined $GD::VERSION and $GD::VERSION < 1.20; + } + + if($method eq 'normal' and not $self->{gd_font}) { + $self->{gd_font} = $self->gdf('giant'); + } + + $style = $self->can('style_'.$style) ? 'style_'.$style : 'style_default'; + $self->$style() unless $self->{send_ctobg}; + $self->insert_text($method); + $self->$style() if $self->{send_ctobg}; + $self->rectangle(0,0,$self->{width}-1,$self->{height}-1, $self->{_COLOR_}{lines}) + if $self->{frame}; # put a frame around the image + $self->{_CREATECALLED_}++; + return $self if defined wantarray; +} + +sub particle { + # Create random dots. They'll cover all over the surface + my $self = shift; + die "particle() must be called 'after' create()!" unless $self->{_CREATECALLED_}; + my $big = $self->{height} > $self->{width} ? $self->{height} : $self->{width}; + my $f = shift || $big * 20; # particle density + my $dots = shift || 1; # number of multiple dots + my $int = int $big / 20; + my @random; + for (my $x = $int; $x <= $big; $x += $int) { + push @random, $x; + } + my($x, $y, $z); + for (1..$f) { + $x = int rand $self->{width}; + $y = int rand $self->{height}; + foreach $z (1..$dots) { + $self->setPixel($x + $z , $y + $z , $self->{_COLOR_}{text}); + $self->setPixel($x + $z + $random[int rand @random], $y + $z + $random[int rand @random], $self->{_COLOR_}{text}); + } + } + return $self if defined wantarray; +} + +sub raw {shift->{image}} # raw image object + +sub info_text { # set text location + # x => 'left|right', # text-X + # y => 'up|low|down', # text-Y + # strip => 1|0, # add strip? + # gd => 1|0, # use default GD font? + # ptsize => 10, # point size + # color => '#000000', # text color + # scolor => '#FFFFFF', # strip color + # text => 'blah', # modifies random code + my $self = shift; + die "info_text() must be called 'after' create()!" unless $self->{_CREATECALLED_}; + my %o = scalar(@_) % 2 ? () : (qw/x right y up strip 1/, @_); + return unless %o; + + $o{scolor} = $self->cconvert($o{scolor}) if $o{scolor}; + $self->{_TEXT_LOCATION_}->{_place_} = 1; + local $self->{_RANDOM_NUMBER_} = delete $o{text} if $o{text}; + local $self->{_COLOR_}{text} = $self->cconvert(delete $o{color}) if $o{color}; + local $self->{ptsize} = delete $o{ptsize} if $o{ptsize}; + + local $self->{scramble} = 0; # disable. we need a straight text + local $self->{angle} = 0; # disable. RT:14618 + + $self->{_TEXT_LOCATION_}->{$_} = $o{$_} foreach keys %o; + $self->insert_text('ttf'); + $self; +} + +#--------------------[ PRIVATE ]--------------------# + +sub add_strip { # adds a strip to the background of the text + my $self = shift; + my($x, $y, $box_w, $box_h) = @_; + my $tl = $self->{_TEXT_LOCATION_}; + my $black = $self->cconvert($self->{_COLOR_}{text} ? $self->{_COLOR_}{text} : [0,0,0]); + my $white = $self->cconvert($tl->{scolor} ? $tl->{scolor} : [255,255,255]); + my $x2 = $tl->{x} eq 'left' ? $box_w : $self->{width}; + my $y2 = $self->{height} - $box_h; + my $i = $self->{IS_MAGICK} ? $self : $self->{image}; + my $up = $tl->{y} eq 'up'; + $i->filledRectangle($up ? ($x-1, 0, $x2, $y+1) : ($x-1, $y2-1, $x2 , $self->{height} ), $black); + $i->filledRectangle($up ? ($x , 1, $x2-2, $y) : ($x , $y2 , $x2-2, $self->{height}-2), $white); +} + +sub r2h { + # Convert RGB to Hex + my $self = shift; + @_ == 3 || return; + my $color = '#'; + $color .= sprintf("%02x", $_) foreach @_; + $color; +} + +sub h2r { + # Convert Hex to RGB + my $self = shift; + my $color = shift; + return if ref $color; + my @rgb = $color =~ m[^#([a-f0-9]{2})([a-f0-9]{2})([a-f0-9]{2})$]i; + return @rgb ? map { hex $_ } @rgb : undef; +} + +sub is_hex { + my $self = shift; + my $data = shift; + return $data =~ m[^#([a-f0-9]{2})([a-f0-9]{2})([a-f0-9]{2})$]i; +} + +sub AUTOLOAD { + my $self = shift; + (my $name = $AUTOLOAD) =~ s,.*:,,; + if ($name eq 'gdbox_empty') { # fake method for GD compatibility. only GD has this + return 0; + } + die "Unknown ".ref($self)." method '$name'!"; +} + +sub DESTROY {} + +1; + +__END__ + +=head1 NAME + +GD::SecurityImage - Security image (captcha) generator. + +=head1 SYNOPSIS + + use GD::SecurityImage; + + # Create a normal image + my $image = GD::SecurityImage->new(width => 80, + height => 30, + lines => 10, + gd_font => 'giant'); + $image->random($your_random_str); + $image->create(normal => 'rect'); + my($image_data, $mime_type, $random_number) = $image->out; + +or + + # use external ttf font + my $image = GD::SecurityImage->new(width => 100, + height => 40, + lines => 10, + font => "/absolute/path/to/your.ttf", + scramble => 1); + $image->random($your_random_str); + $image->create(ttf => 'default'); + $image->particle; + my($image_data, $mime_type, $random_number) = $image->out; + +or you can just say (most of the public methods can be chained) + + my($image, $type, $rnd) = GD::SecurityImage->new->random->create->particle->out; + +to create a security image with the default settings. But that may not +be useful. If you C the module, you B import it: + + require GD::SecurityImage; + GD::SecurityImage->import; + +The module also supports C, but the default interface +uses the C module. To enable C support, you must +call the module with the C option: + + use GD::SecurityImage use_magick => 1; + +If you C the module, you B import it: + + require GD::SecurityImage; + GD::SecurityImage->import(use_magick => 1); + +The module does not I anything actually. But C loads +the necessary sub modules. If you don' t C, the required +modules will not be loaded and probably, you'll C. + +=head1 DESCRIPTION + +The (so called) I<"Security Images"> are so popular. Most internet +software use these in their registration screens to block robot programs +(which may register tons of fake member accounts). Security images are +basicaly, graphical Bs (Bompletely Butomated B

ublic +Buring Test to Tell Bomputers and Bumans Bpart). This +module gives you a basic interface to create such an image. The final +output is the actual graphic data, the mime type of the graphic and the +created random string. The module also has some I<"styles"> that are +used to create the background (or foreground) of the image. + +If you are an C user, see L +for migration from C to C. + +This module is B. Not a I. +The validation of the generated graphic is left to your programming +taste. + +=head1 COLOR PARAMETERS + +This module can use both RGB and HEX values as the color +parameters. HEX values are recommended, since they are +widely used and recognised. + + $color = '#80C0F0'; # HEX + $color2 = [15, 100, 75]; # RGB + $i->create($meth, $style, $color, $color2) + + $i->create(ttf => 'box', '#80C0F0', '#0F644B') + +RGB values must be passed as an array reference including the three +Ied>, Ireen> and Ilue> values. + +Color conversion is transparent to the user. You can use hex values +under both C and C. They' ll be automagically +converted to RGB if you are under C. + +=head1 METHODS + +=head2 new + +The constructor. C method takes several arguments. These +arguments are listed below. + +=over 4 + +=item width + +The width of the image (in pixels). + +=item height + +The height of the image (in pixels). + +=item ptsize + +Numerical value. The point size of the ttf character. +Only necessarry if you want to use a ttf font in the image. + +=item lines + +The number of lines that you' ll see in the background of the image. +The alignment of lines can be vertical, horizontal or angled or +all of them. If you increase this parameter' s value, the image will +be more cryptic. + +=item font + +The absolute path to your TrueType (.ttf) font file. Be aware that +relative font paths are not recognized due to problems in the C +library. + +If you are sure that you've set this parameter to a correct value and +you get warnings or you get an empty image, be sure that your path +does not include spaces in it. It looks like libgd also have problems +with this kind of paths (eg: '/Documents and Settings/user' under Windows). + +Set this parameter if you want to use ttf in your image. + +=item gd_font + +If you want to use the default interface, set this paramater. The +recognized values are C, C, C, C, C. +The names are case-insensitive; you can pass lower-cased parameters. + +=item bgcolor + +The background color of the image. + +=item send_ctobg + +If has a true value, the random security code will be displayed in the +background and the lines will pass over it. +(send_ctobg = send code to background) + +=item frame + +If has a true value, a frame will be added around the image. This +option is enabled by default. + +=item scramble + +If set, the characters will be scrambled. If you enable this option, +be sure to use a wider image, since the characters will be separated +with three spaces. + +=item angle + +Sets the angle for scrambled/normal characters. Beware that, if you pass +an C parameter, the characters in your random string will have +a fixed angle. If you do not set an C parameter, the angle(s) +will be random. + +When the scramble option is not enabled, this parameter still controls +the angle of the text. But, since the text will be centered inside the +image, using this parameter without scramble option will require a +taller image. Clipping will occur with smaller height values. + +Unlike the GD interface, C is in Cs and can take values +between C<0> and C<360>. + +=item thickness + +Sets the line drawing width. Can take numerical values. +Default values are C<1> for GD and C<0.6> for Image:Magick. + +=item rndmax + +The minimum length of the random string. Default value is C<6>. + +=item rnd_data + +Default character set used to create the random string is C<0..9>. +But, if you want to use letters also, you can set this paramater. +This paramater takes an array reference as the value. + +B +B + +=back + +=head2 random + +Creates the random security string or B to +the value you have passed. If you pass your own random string, be aware +that it must be at least six (defined in C) characters +long. + +=head2 random_str + +Returns the random string. Must be called after C. + +=head2 create + +This method creates the actual image. It takes four arguments, but +none are mandatory. + + $image->create($method, $style, $text_color, $line_color); + +C<$method> can be B> or B>. + +C<$style> can be one of the following (some of the styles may not work +if you are using a really old version of GD): + +=over 4 + +=item B + +The default style. Draws horizontal, vertical and angular lines. + +=item B + +Draws horizontal and vertical lines + +=item B + +Draws two filled rectangles. + +The C option passed to L, controls the size of the inner rectangle +for this style. If you increase the C, you'll get a smaller internal +rectangle. Using smaller values like C<5> can be better. + +=item B + +Draws circles. + +=item B + +Draws ellipses. + +=item B + +This is the combination of ellipse and circle styles. Draws both ellipses +and circles. + +=back + +I: if you have a (too) old version of GD, you may not be able +to use some of the styles. + +You can use this code to get all available style names: + + my @styles = grep {s/^style_//} keys %GD::SecurityImage::Styles::; + +The last two arguments (C<$text_color> and C<$line_color>) are the +colors used in the image (text and line color -- respectively): + + $image->create($method, $style, [0,0,0], [200,200,200]); + $image->create($method, $style, '#000000', '#c8c8c8'); + +=head2 particle + +Must be called after L. + +Adds random dots to the image. They'll cover all over the surface. +Accepts two parameters; the density (number) of the particles and +the maximum number of dots around the main dot. + + $image->particle($density, $maxdots); + +Default value of C<$density> is dependent on your image' s width or +height value. The greater value of width and height is taken and +multiplied by twenty. So; if your width is C<200> and height is C<70>, +C<$density> is C<200 * 20 = 4000> (unless you pass your own value). +The default value of C<$density> can be too much for smaller images. + +C<$maxdots> defines the maximum number of dots near the default dot. +Default value is C<1>. If you set it to C<4>, The selected pixel and 3 +other pixels near it will be used and colored. + +The color of the particles are the same as the color of your text +(defined in L). + +=head2 info_text + +This method must be called after L. If you call it +early, you'll die. C adds an extra text to the generated +image. You can also put a strip under the text. The purpose of this +method is to display additional information on the image. Copyright +informations can be an example for that. + + $image->info_text( + x => 'right', + y => 'up', + gd => 1, + strip => 1, + color => '#000000', + scolor => '#FFFFFF', + text => 'Generated by GD::SecurityImage', + ); + +Options: + +=over 4 + +=item x + +Controls the horizontal location of the information text. Can be +either C or C. + +=item y + +Controls the vertical location of the information text. Can be +either C or C. + +=item strip + +If has a true value, a strip will be added to the background of the +information text. + +=item gd + +This option can only be used under C. Has no effect under +Image::Magick. If has a true value, the standard GD font C +will be used for the information text. + +If this option is not present or has a false value, the TTF font +parameter passed to C will be used instead. + +=item ptsize + +The ptsize value of the information text to be used with the TTF font. +TTF font paramter can not be set with C. The value passed +to C will be used instead. + +=item color + +The color of the information text. + +=item scolor + +The color of the strip. + +=item text + +This parameter controls the displayed text. If you want to display +long texts, be sure to adjust the image, or clipping will occur. + +=back + +=head2 out + +This method finally returns the created image, the mime type of the +image and the random number(s) generated. Older versions of GD only support +C type, while new versions support C and C +(B: beginning with v2.15, GD resumed gif support). + +The returned mime type is C or C or C for C and +C for C (if you do not C some other format). + +C method accepts arguments: + + @data = $image->out(%args); + +=over 4 + +=item force + +You can set the output format with the C parameter: + + @data = $image->out(force => 'png'); + +If C is supported by the interface (via C or C); +you'll get a png image, if the interface does not support this format, +C method will use it's default configuration. + +=item compress + +And with the C parameter, you can define the compression +for C and quality for C: + + @data = $image->out(force => 'png' , compress => 1); + @data = $image->out(force => 'jpeg', compress => 100); + +When you use C with C format, the value of C +is ignored and it is only checked if it has a true value. With C +the compression will always be C<9> (maximum compression). eg: + + @data = $image->out(force => 'png' , compress => 1); + @data = $image->out(force => 'png' , compress => 3); + @data = $image->out(force => 'png' , compress => 5); + @data = $image->out(force => 'png' , compress => 1500); + +All will default to C<9>. But this will disable compression: + + @data = $image->out(force => 'png' , compress => 0); + +But the behaviour changes if the format is C; the value of +C will be used for C quality; which is in the range +C<1..100>. + +Compression and quality operations are disabled by default. + +=back + +=head2 raw + +Depending on your usage of the module; returns the raw C +object: + + my $gd = $image->raw; + print $gd->png; + +or the raw C object: + + my $magick = $image->raw; + $magick->Write("gif:-"); + +Can be usefull, if you want to modify the graphic yourself. If you +want to get an I see the C option in C. + +=head2 gdbox_empty + +See L in L for usage and other information +on this method. + +=head1 UTILITY METHODS + +=head2 backends + +Returns a list of available GD::SecurityImage back-ends. + + my @be = GD::SecurityImage->backends; + +or + + my @be = $image->backends; + +If called in a void context, prints a verbose list of available +GD::SecurityImage back-ends: + + Available back-ends in GD::SecurityImage v1.55 are: + GD + Magick + + Search directories: + /some/@INC/dir/containing/GDSI + +you can see the output with this command: + + perl -MGD::SecurityImage -e 'GD::SecurityImage->backends' + +or under windows: + + perl -MGD::SecurityImage -e "GD::SecurityImage->backends" + +=begin BACKEND_AUTHORS + +If you want to write a new back-end to GD::SecurityImage, you must define +this mandatory methods. + + init initializes your image object + out defines output format and returns the image data + insert_text inserts text to the image + setPixel sets a pixel' s color defined by it's (x,y) values + line draws a line + rectangle draws a rectangle + filledRectangle draws a filled rectangle + ellipse draws an ellipse + arc draws an arc + setThickness sets the thickness of the lines when drawing something + +and + + backend_cconvert for HEX & RGB color handling + +See GD::SecurityImage::Magick for the first part of methods and see +cconvert() method in GD::SecurityImage to define such a method. Your +backend_cconvert() method must be capable of handling both HEX and RGB +values. The parametes passed to drawing methods (like line()) are +in GD format. See the L module for examples. + +You can then name your distro as 'GD::SecurityImage::X' and anyone can use +it like: + + use GD::SecurityImage backend => 'X'; + +=end BACKEND_AUTHORS + +=head1 EXAMPLES + +See the tests in the distribution. Also see the demo program +"eg/demo.pl" for an C implementation of +C. + +Download the distribution from a CPAN mirror near you, if you +don't have the files. + +=head1 ERROR HANDLING + +C is called in some methods if something fails. You may need to +C your code to catch exceptions. + +=head1 TIPS + +If you look at the demo program (not just look at it, try to run it) +you'll see that the random code changes after every request (successful +or not). If you do not change the random code after a failed request and +display the random code inside HTML (like I<"Wrong! It must be ErandomE">), +then you are doing a logical mistake, since the user (or robot) can now +copy & paste the random code into your validator without looking at the +security image and will pass the test. Just don't do that. Random code +must change after every validation. + +If you want to be a little more strict, you can also add a timeout key +to the session (this feature currently does not exits in the demo) and +expire the related random code after the timeout. Since robots can call +the image generator directly (without requiring the HTML form), they can +examine the image for a while without changing it. A timeout implemetation +may prevent this. + +=head1 BUGS + +Contact the author if you find any bugs. You can also send requests. + +=head2 Image::Magick bug + +There is a bug in PerlMagick' s C method. ImageMagick +versions smaller than 6.0.4 is affected. Below text is from the ImageMagick +6.0.4 Changelog: L. + +"2004-05-06 PerlMagick's C incorrectly reports `unrecognized +attribute'` for the `font' attribute." + +Please upgrade to ImageMagick 6.0.4 or any newer version, if your ImageMagick +version is smaller than 6.0.4 and you want to use Image::Magick as the backend +for GD::SecurityImage. + +=head2 GD bug + +=head3 path bug + +libgd and GD.pm don't like relative paths and paths that have spaces +in them. If you pass a font path that is not an B or a path that +have a space in it, you may get an empty image. + +To check if the module failed to find the ttf font (when using C), a new +method added: C. It must be called after C: + + $image->create; + die "Error loading ttf font for GD: $@" if $image->gdbox_empty; + +C always returns false, if you are using C. + +=head1 COMMON ERRORS + +=head2 Wrong GD installation + +I got some error reports saying that GD::SecurityImage dies +with this error: + + Can't locate object method "new" via package "GD::Image" + (perhaps you forgot to load "GD::Image"?) at ... + +This is due to a I installation of the L module. GD +includes C code and it needs to be compiled. You can't just +copy/paste the I and expect it to work. It will not. +If you are under Windows and don't have a C compiler, you have +to add new repositories to install I, since ActiveState' s own +repositories don't include I. Randy Kobes and J-L Morel have +ppm repositories for both 5.6.x and 5.8.x and they both have I: + + http://www.bribes.org/perl/ppmdir.html + http://theoryx5.uwinnipeg.ca/ + +I also has a I ppd, so you can just +install I from that repository. + +=head2 libgd errors + +There are some issues related to wrong/incomplete compiling +of libgd and old/new version conflicts. + +=head3 libgd without TTF support + +If your libgd is compiled without TTF support, you'll get an I +image. The lines will be drawn, but there will be no text. You can +check it with L method. + +=head3 GIF - Old libgd or libgd without GIF support enabled + +If your GD has a C method, but you get empty images with C +method, you have to update your libgd or compile it with GIF enabled. + +You can test if C is working from the command line: + + perl -MGD -e '$_=GD::Image->new;$_->colorAllocate(0,0,0);print$_->gif' + +or under windows: + + perl -MGD -e "$_=GD::Image->new;$_->colorAllocate(0,0,0);print$_->gif" + +Conclusions: + +=over 4 + +=item * + +If it dies, your GD is very old. + +=item * + +If it prints nothing, your libgd was compiled without GIF enabled (upgrade or re-compile). + +=item * + +If it prints out a junk that starts with 'GIF87a', everything is OK. + +=back + +=head1 CAVEAT EMPTOR + +=over 4 + +=item * + +Using the default library C is a better choice. Since it is faster +and does not use that much memory, while C is slower and +uses more memory. + +=item * + +The internal random code generator is used B for demonstration +purposes for this module. It may not be I. You must supply +your own random code and use this module to display it. + +=item * + +B<[GD] png compression> + +Support for compression level argument to png() added in v2.07. If +your GD version is smaller than this, compress option to C +will be silently ignored. + +=item * + +B<[GD] setThickness> + +setThickness implemented in GD v2.07. If your GD version is smaller +than that and you set thickness option, nothing will happen. + +=item * + +B<[GD] ellipse> + +C method added in GD 2.07. + +If your GD version is smaller than 2.07 and you use C, +the C style will be returned. + +If your GD is smaller than 2.07 and you use C, only the circles will +be drawn. + +=back + +=head1 SEE ALSO + +=over 4 + +=item * + +L, L, L, L. + +=item * + +L: C drop-in replacement module. + +=item * + +C Perl Module (commercial): L. + +=item * + +The CAPTCHA project: L. + +=item * + +A definition of CAPTCHA (From Wikipedia, the free encyclopedia): +L. + +=back + +=head1 AUTHOR + +Burak Gürsoy, EburakE<64>cpan.orgE + +=head1 COPYRIGHT + +Copyright 2004-2006 Burak Gürsoy. All rights reserved. + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.7 or, +at your option, any later version of Perl 5 you may have available. + +=cut diff --git a/deps/GD/SecurityImage/GD.pm b/deps/GD/SecurityImage/GD.pm new file mode 100644 index 0000000..415e652 --- /dev/null +++ b/deps/GD/SecurityImage/GD.pm @@ -0,0 +1,306 @@ +package GD::SecurityImage::GD; +use strict; +use vars qw[$VERSION $methTTF]; + +use constant LOW_LEFT_X => 0; # Lower left corner x +use constant LOW_LEFT_Y => 1; # Lower left corner y +use constant LOW_RIGHT_X => 2; # Lower right corner x +use constant LOW_RIGHT_Y => 3; # Lower right corner y +use constant UP_RIGHT_X => 4; # Upper right corner x +use constant UP_RIGHT_Y => 5; # Upper right corner y +use constant UP_LEFT_X => 6; # Upper left corner x +use constant UP_LEFT_Y => 7; # Upper left corner y + +use constant CH_X => 0; # character-X +use constant CH_Y => 1; # character-Y +use constant CHAR => 2; # character +use constant ANGLE => 3; # character angle + +use constant MAX_COMPRESS => 9; + +use GD; + +$VERSION = '1.49'; +$methTTF = $GD::VERSION >= 1.31 ? 'stringFT' : 'stringTTF'; # define the tff drawing method. + +sub init { + # Create the image object + my $self = shift; + $self->{image} = GD::Image->new($self->{width}, $self->{height}); + $self->cconvert($self->{bgcolor}); # set background color + $self->setThickness($self->{thickness}) if $self->{thickness}; + if($GD::VERSION < 2.07) { + $self->{DISABLED}{$_} = 1 foreach qw[ellipse setThickness _png_compression]; + } +} + +sub out { + # return $image_data, $image_mime_type, $random_number + my $self = shift; + my %opt = scalar @_ % 2 ? () : (@_); + my $type; + if($opt{force} and $self->{image}->can($opt{force})){ + $type = $opt{force}; + } else { + # define the output format. png is first due to various problems with gif() format + foreach (qw( png gif jpeg )) { + if($self->{image}->can($_)) { + $type = $_; + last; + } + } + } + my @args = (); + if ($opt{'compress'}) { + push @args, MAX_COMPRESS if $type eq 'png' and not $self->{DISABLED}{_png_compression}; + push @args, $opt{'compress'} if $type eq 'jpeg'; + } + return $self->{image}->$type(@args), $type, $self->{_RANDOM_NUMBER_}; +} + +sub gdbox_empty {shift->{GDBOX_EMPTY}} + +sub gdfx { + # Sets the font for simple GD usage. + # Unfortunately, Image::Magick does not have a similar interface. + my $self = shift; + my $font = shift || return; + $font = lc $font; + # GD' s standard fonts + my %f = map { lc $_ => $_ } qw[ Small Large MediumBold Tiny Giant ]; + if (exists $f{$font}) { + $font = $f{$font}; + return GD::Font->$font(); + } +} + +sub insert_text { + # Draw text using GD + my $self = shift; + my $method = shift; + my $key = $self->{_RANDOM_NUMBER_}; # random string + if ($method eq 'ttf') { + require Math::Trig; + # don' t draw. we just need info... + my $info = sub { + my $txt = shift; + my $ang = shift || 0; + $ang = Math::Trig::deg2rad($ang) if $ang; + my @box = GD::Image->$methTTF($self->{_COLOR_}{text},$self->{font},$self->{ptsize},$ang,0,0,$txt); + unless (@box) { # use fake values instead of die-ing + $self->{GDBOX_EMPTY} = 1; # set this for error checking. + $#box = 7; + # lets initialize to silence the warnings + $box[$_] = 1 for 0..$#box; + } + return @box; + }; + if ($self->{scramble}) { + my @char; + my $anglex; + my $total = 0; + my $space = [$self->ttf_info(0, 'A'),0,' ']; + my @randomy; + my $sy = $space->[CH_Y] || 1; + push(@randomy, $_, - $_) foreach $sy*1.2,$sy, $sy/2, $sy/4, $sy/8; + foreach (split //, $key) { # get char parameters + $anglex = $self->random_angle; + $total += $space->[CH_X]; + push @char, [$self->ttf_info($anglex, $_), $anglex, $_], $space, $space, $space; + } + $total *= 2; + my @config = ($self->{_COLOR_}{text}, $self->{font}, $self->{ptsize}); + my($x,$y); + foreach my $box (reverse @char) { + $x = $self->{width} / 2 + ($box->[CH_X] - $total); + $y = $self->{height} / 2 + $box->[CH_Y]; + $y += $randomy[int rand @randomy]; + $self->{image}->$methTTF(@config, Math::Trig::deg2rad($box->[CHAR]), $x, $y, $box->[ANGLE]); + $total -= $space->[CH_X]; + } + } else { + my(@box,$x,$y); + my $tl = $self->{_TEXT_LOCATION_}; + if ($tl->{_place_}) { + # put the text to one of the four corners in the image + my $white = $self->cconvert([255,255,255]); + my $black = $self->cconvert($self->{_COLOR_}{text}); + if ($tl->{gd}) { # draw with standard gd fonts + $self->place_gd($key, $tl->{x}, $tl->{y}); + return; # by-pass ttf method call... + } else { + @box = $info->($key); + $x = $tl->{x} eq 'left'? 0 : ($self->{width} - ($box[LOW_RIGHT_X] - $box[LOW_LEFT_X])); + $y = $tl->{y} eq 'up' ? ($box[LOW_LEFT_Y] - $box[UP_LEFT_Y]) : $self->{height}-2; + if ($tl->{strip}) { + $self->add_strip($x, $y, $box[LOW_RIGHT_X] - $box[LOW_LEFT_X], $box[LOW_LEFT_Y] - $box[UP_LEFT_Y]); + } + } + } else { + @box = $info->($key); + $x = ($self->{width} - ($box[LOW_RIGHT_X] - $box[LOW_LEFT_X])) / 2; + $y = ($self->{height} - ($box[UP_LEFT_Y] - $box[LOW_LEFT_Y])) / 2; + } + # this needs a fix. adjust x,y + if ($self->{angle}) { + require Math::Trig; + $self->{angle} = Math::Trig::deg2rad($self->{angle}); + } else { + $self->{angle} = 0; + } + $self->{image}->$methTTF($self->{_COLOR_}{text}, $self->{font}, $self->{ptsize}, $self->{angle}, $x, $y, $key); + } + } else { + if ($self->{scramble}) { + # without ttf, we can only have 0 and 90 degrees. + my @char; + my @styles = qw(string stringUp); + my $style = $styles[int rand @styles]; + foreach (split //, $key) { # get char parameters + push @char, [$_, $style], [' ','string']; + $style = $style eq 'string' ? 'stringUp' : 'string'; + } + my $sw = $self->{gd_font}->width; + my $sh = $self->{gd_font}->height; + my($x, $y, $m); + my $total = $sw * @char; + foreach my $c (@char) { + $m = $c->[1]; + $x = ($self->{width} - $total) / 2; + $y = $self->{height}/2 + ($m eq 'string' ? -$sh : $sh/2) / 2; + $total -= $sw * 2; + $self->{image}->$m($self->{gd_font}, $x, $y, $c->[0], $self->{_COLOR_}{text}); + } + } else { + my $sw = $self->{gd_font}->width * length($key); + my $sh = $self->{gd_font}->height; + my $x = ($self->{width} - $sw) / 2; + my $y = ($self->{height} - $sh) / 2; + $self->{image}->string($self->{gd_font}, $x, $y, $key, $self->{_COLOR_}{text}); + } + } +} + +sub place_gd { + my $self = shift; + my($key, $tX, $tY) = @_; + my $tl = $self->{_TEXT_LOCATION_}; + my $black = $self->cconvert($self->{_COLOR_}{text}); + my $white = $self->cconvert($tl->{scolor}); + my $font = GD::Font->Tiny; + my $fx = (length($key)+1)*$font->width; + my $x1 = $self->{width} - $fx; + my $y1 = $tY eq 'up' ? 0 : $self->{height} - $font->height; + if ($tY eq 'up') { + if($tX eq 'left') { + $self->filledRectangle(0, $y1 , $fx , $font->height+2, $black); + $self->filledRectangle(1, $y1+1, $fx-1, $font->height+1, $white); + } else { + $self->filledRectangle($x1-$font->width - 1, $y1 , $self->{width} , $font->height+2, $black); + $self->filledRectangle($x1-$font->width , $y1+1, $self->{width}-2, $font->height+1, $white); + } + } else { + if($tX eq 'left') { + $self->filledRectangle(0, $y1-2, $fx , $self->{height} , $black); + $self->filledRectangle(1 , $y1-1, $fx-1, $self->{height}-2, $white); + } else { + $self->filledRectangle($x1-$font->width - 1, $y1-2, $self->{width} , $self->{height} , $black); + $self->filledRectangle($x1-$font->width , $y1-1, $self->{width}-2, $self->{height}-2, $white); + } + } + $self->{image}->string($font, $tX eq 'left' ? 2 : $x1, $tY eq 'up' ? $y1+1 : $y1-1, $key, $self->{_COLOR_}{text}); +} + +sub ttf_info { + my $self = shift; + my $angle = shift || 0; + my $text = shift; + my $x = 0; + my $y = 0; + my @box = GD::Image->$methTTF($self->{_COLOR_}{text},$self->{font}, $self->{ptsize},Math::Trig::deg2rad($angle),0,0,$text); + unless (@box) { # use fake values instead of die-ing + $self->{GDBOX_EMPTY} = 1; # set this for error checking. + $#box = 7; + # lets initialize to silence the warnings + $box[$_] = 1 for 0..$#box; + } + my $bx = $box[LOW_LEFT_X] - $box[LOW_RIGHT_X]; + my $by = $box[LOW_LEFT_Y] - $box[LOW_RIGHT_Y]; + + if($angle == 0 or $angle == 180 or $angle == 360) { + $by = $box[ UP_LEFT_Y ] - $box[LOW_LEFT_Y ]; + } elsif ($angle == 90 or $angle == 270) { + $bx = $box[ UP_LEFT_X ] - $box[LOW_LEFT_X ]; + } elsif($angle > 270 and $angle < 360) { + $bx = $box[ LOW_LEFT_X ] - $box[ UP_LEFT_X ]; + } elsif ($angle > 180 and $angle < 270) { + $by = $box[ LOW_LEFT_Y ] - $box[LOW_RIGHT_Y]; + $bx = $box[ LOW_RIGHT_X] - $box[ UP_RIGHT_X]; + } elsif($angle > 90 and $angle < 180) { + $bx = $box[ LOW_RIGHT_X] - $box[ LOW_LEFT_X]; + $by = $box[ LOW_RIGHT_Y] - $box[ UP_RIGHT_Y]; + } elsif ($angle > 0 and $angle < 90) { + $by = $box[ UP_LEFT_Y ] - $box[ LOW_LEFT_Y]; + } else {} + + if ($angle == 0 ) { $x += $bx/2; $y -= $by/2; } + elsif ($angle > 0 and $angle < 90 ) { $x += $bx/2; $y -= $by/2; } + elsif ($angle == 90 ) { $x -= $bx/2; $y += $by/2; } + elsif ($angle > 90 and $angle < 180) { $x -= $bx/2; $y += $by/2; } + elsif ($angle == 180 ) { $x += $bx/2; $y -= $by/2; } + elsif ($angle > 180 and $angle < 270) { $x += $bx/2; $y += $by/2; } + elsif ($angle == 270 ) { $x -= $bx/2; $y += $by/2; } + elsif ($angle > 270 and $angle < 360) { $x += $bx/2; $y += $by/2; } + elsif ($angle == 360 ) { $x += $bx/2; $y -= $by/2; } + return $x, $y; +} + +sub setPixel {shift->{image}->setPixel(@_) } +sub line {shift->{image}->line(@_) } +sub rectangle {shift->{image}->rectangle(@_) } +sub filledRectangle {shift->{image}->filledRectangle(@_)} +sub ellipse {shift->{image}->ellipse(@_) } +sub arc {shift->{image}->arc(@_) } + +sub setThickness { + my $self = shift; + if($self->{image}->can('setThickness')) { # $GD::VERSION >= 2.07 + $self->{image}->setThickness(@_); + } +} + +1; + +__END__ + +=head1 NAME + +GD::SecurityImage::GD - GD backend for GD::SecurityImage. + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +Used internally by L. Nothing public here. + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Burak Gürsoy, EburakE<64>cpan.orgE + +=head1 COPYRIGHT + +Copyright 2004-2006 Burak Gürsoy. All rights reserved. + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.7 or, +at your option, any later version of Perl 5 you may have available. + +=cut diff --git a/deps/GD/SecurityImage/Magick.pm b/deps/GD/SecurityImage/Magick.pm new file mode 100644 index 0000000..20faee7 --- /dev/null +++ b/deps/GD/SecurityImage/Magick.pm @@ -0,0 +1,210 @@ +package GD::SecurityImage::Magick; +# GD method emulation class for Image::Magick +use strict; +use vars qw[$VERSION]; + +use constant X_PPEM => 0; # character width +use constant Y_PPEM => 1; # character height +use constant ASCENDER => 2; # ascender +use constant DESCENDER => 3; # descender +use constant WIDTH => 4; # text width +use constant HEIGHT => 5; # text height +use constant MAX_ADVANCE => 6; # maximum horizontal advance + +use constant ANGLE => -2; +use constant CHAR => -1; + +use constant MAX_COMPRESS => 100; + +use Image::Magick; + +$VERSION = '1.36'; + +sub init { + # Create the image object + my $self = shift; + my $bg = $self->cconvert($self->{bgcolor}); + $self->{image} = Image::Magick->new; + $self->{image}->Set(size=> "$self->{width}x$self->{height}"); + $self->{image}->Read('null:' . $bg); + $self->{image}->Set(background => $bg); + $self->{MAGICK} = {strokewidth => 0.6}; + $self->setThickness($self->{thickness}) if $self->{thickness}; +} + +sub out { + my $self = shift; + my %opt = scalar @_ % 2 ? () : (@_); + my $type = 'gif'; # default format + if ($opt{force}) { + my %g = map {$_, 1} $self->{image}->QueryFormat; + $type = $opt{force} if exists $g{$opt{force}}; + } + $self->{image}->Set(magick => $type); + if ($opt{'compress'} and $type =~ m[^(png|jpeg)$]) { + if($type eq 'png') { + $opt{'compress'} = MAX_COMPRESS; + $self->{image}->Set(compression => 'Zip'); + } + $self->{image}->Set(quality => $opt{'compress'}); + } + return $self->{image}->ImageToBlob, $type, $self->{_RANDOM_NUMBER_}; +} + +sub insert_text { + # Draw text using Image::Magick + my $self = shift; + my $method = shift; # not needed with Image::Magick (always use ttf) + my $key = $self->{_RANDOM_NUMBER_}; # random string + my $info = sub {$self->{image}->QueryFontMetrics(font => $self->{font}, text => shift, pointsize => $self->{ptsize})}; + my %same = (font => $self->{font}, + encoding => 'UTF-8', + pointsize => $self->{ptsize}, + fill => $self->cconvert($self->{_COLOR_}{text}), + ); + if ($self->{scramble}) { + my $space = [$info->(' '), 0, ' ']; # get " " parameters + my @randomy; + my $sy = $space->[ASCENDER] || 1; + push(@randomy, $_, - $_) foreach $sy/2, $sy/4, $sy/8; + my @char; + foreach (split //, $key) { + push @char, [$info->($_), $self->random_angle, $_], $space, $space, $space; + } + my $total = 0; + $total += $_->[WIDTH] foreach @char; + foreach my $magick (@char) { + $total -= $magick->[WIDTH] * 2; + $self->{image}->Annotate(text => $magick->[CHAR], + x => ($self->{width} - $total - $magick->[WIDTH] ) / 2, + y => (($self->{height} + $magick->[ASCENDER]) / 2) + $randomy[int rand @randomy], + rotate => $magick->[ANGLE], + %same); + } + } else { + my @metric = $info->($key); + my($x, $y); + my $tl = $self->{_TEXT_LOCATION_}; + if ($tl->{_place_}) { + # put the text to one of the four corners in the image + $x = $tl->{x} eq 'left' ? 2 : $self->{width}-$metric[WIDTH]-2; + $y = $tl->{y} eq 'up' ? $metric[ASCENDER]+1 : $self->{height}-2; + $self->add_strip($x, $y, $metric[WIDTH], $metric[ASCENDER]) if $tl->{strip}; + } else { + $x = ($self->{width} - $metric[WIDTH] ) / 2; + $y = ($self->{height} + $metric[ASCENDER]) / 2; + } + $self->{image}->Annotate(%same, + text => $key, + x => $x, + y => $y, + rotate => $self->{angle} ? 360 - $self->{angle} : 0, + ); + } +} + +sub setPixel { + my $self = shift; + my($x, $y, $color) = @_; + $self->{image}->Set("pixel[$x,$y]" => $self->cconvert($color) ); +} + +sub line { + my $self = shift; + my($x1, $y1, $x2, $y2, $color) = @_; + $self->{image}->Draw( + primitive => "line", + points => "$x1,$y1 $x2,$y2", + stroke => $self->cconvert($color), + strokewidth => $self->{MAGICK}{strokewidth}, + ); +} + +sub rectangle { + my $self = shift; + my($x1,$y1,$x2,$y2,$color) = @_; + $self->{image}->Draw( + primitive => "rectangle", + points => "$x1,$y1 $x2,$y2", + stroke => $self->cconvert($color), + strokewidth => $self->{MAGICK}{strokewidth}, + ); +} + +sub filledRectangle { + my $self = shift; + my($x1,$y1,$x2,$y2,$color) = @_; + $self->{image}->Draw( + primitive => "rectangle", + points => "$x1,$y1 $x2,$y2", + fill => $self->cconvert($color), + stroke => $self->cconvert($color), + strokewidth => 0, + ); +} + +sub ellipse { + my $self = shift; + my($cx,$cy,$width,$height,$color) = @_; + $self->{image}->Draw( + primitive => "ellipse", + points => "$cx,$cy $width,$height 0,360", + stroke => $self->cconvert($color), + strokewidth => $self->{MAGICK}{strokewidth}, + ); +} + +sub arc { + my $self = shift; + my($cx,$cy,$width,$height,$start,$end,$color) = @_; + $self->{image}->Draw( + primitive => "ellipse", # I couldn't do that with "arc" primitive. patches are welcome, but this seems to work :) + points => "$cx,$cy $width,$height $start,$end", + stroke => $self->cconvert($color), + strokewidth => $self->{MAGICK}{strokewidth}, + ); +} + +sub setThickness { + my $self = shift; + my $thickness = shift; + $self->{MAGICK}{strokewidth} = $thickness * $self->{MAGICK}{strokewidth} if $thickness; +} + +1; + +__END__ + +=head1 NAME + +GD::SecurityImage::Magick - Image::Magick backend for GD::SecurityImage. + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +Includes GD method emulations for Image::Magick. + +Used internally by L. Nothing public here. + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Burak Gürsoy, EburakE<64>cpan.orgE + +=head1 COPYRIGHT + +Copyright 2004-2006 Burak Gürsoy. All rights reserved. + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.7 or, +at your option, any later version of Perl 5 you may have available. + +=cut diff --git a/deps/GD/SecurityImage/Styles.pm b/deps/GD/SecurityImage/Styles.pm new file mode 100644 index 0000000..5b2bd54 --- /dev/null +++ b/deps/GD/SecurityImage/Styles.pm @@ -0,0 +1,110 @@ +package GD::SecurityImage::Styles; +use strict; +use vars qw[$VERSION]; + +$VERSION = "1.12"; + +sub style_default { + my $self = shift; + my $fx = $self->{width} / $self->{lines}; + my $fy = $self->{height} / $self->{lines}; + + for my $i (0..$self->{lines}) { + $self->line($i * $fx, 0, $i * $fx , $self->{height}, $self->{_COLOR_}{lines}); # | line + $self->line($i * $fx, 0, ($i * $fx)+$fx, $self->{height}, $self->{_COLOR_}{lines}); # \ line + } + + for my $i (1..$self->{lines}) { + $self->line(0, $i * $fy, $self->{width}, $i * $fy, $self->{_COLOR_}{lines}); # - line + } +} + +sub style_rect { + my $self = shift; + my $fx = $self->{width} / $self->{lines}; + my $fy = $self->{height} / $self->{lines}; + + for my $i (0..$self->{lines}) { + $self->line($i * $fx, 0, $i * $fx , $self->{height}, $self->{_COLOR_}{lines}); # | line + } + + for my $i (1..$self->{lines}) { + $self->line(0, $i * $fy, $self->{width}, $i * $fy, $self->{_COLOR_}{lines}); # - line + } +} + +sub style_box { + my $self = shift; + my $w = $self->{lines}; + $self->filledRectangle(0 , 0 , $self->{width} , $self->{height} , $self->{_COLOR_}{text}); + $self->filledRectangle($w, $w, $self->{width} - $w - 1, $self->{height} - $w - 1, $self->{_COLOR_}{lines} ); +} + +sub style_circle { + my $self = shift; + my $cx = $self->{width} / 2; + my $cy = $self->{height} / 2; + my $max = int $self->{width} / $self->{lines}; + $max++; + + for(1..$self->{lines}){ + $self->arc($cx,$cy,$max*$_,$max*$_,0,360,$self->{_COLOR_}{lines}); + } +} + +sub style_ellipse { + my $self = shift; + return $self->style_default if $self->{DISABLED}{ellipse}; # GD < 2.07 + my $cx = $self->{width} / 2; + my $cy = $self->{height} / 2; + my $max = int $self->{width} / $self->{lines}; + $max++; + + for(1..$self->{lines}){ + $self->ellipse($cx,$cy,$max*$_*2,$max*$_,$self->{_COLOR_}{lines}); + } +} + +sub style_ec { + my $self = shift; + $self->style_ellipse(@_) unless $self->{DISABLED}{ellipse}; # GD < 2.07 + $self->style_circle(@_); +} + +1; + +__END__ + +=head1 NAME + +GD::SecurityImage::Styles - Drawing styles for GD::SecurityImage. + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +This module contains the styles used in the security image. + +Used internally by L. Nothing public here. + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Burak Gürsoy, EburakE<64>cpan.orgE + +=head1 COPYRIGHT + +Copyright 2004-2006 Burak Gürsoy. All rights reserved. + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.7 or, +at your option, any later version of Perl 5 you may have available. + +=cut