Commit 910b2b11ba688a88c50b1fd3dab6528f30a3b27f - libgd-securityimage-perl

+5

-0

Changes less more

0	0	Revision history for Perl extension GD::SecurityImage.
1	1
2	2	Time zone is GMT+2.
	3
	4	1.64 Wed Apr 25 21:01:49 2007
	5	=> Yet another test suite update for Image::Magick.
	6	=> New style "blank" added for evil purposes.
	7	=> Fixed a regex in demo.pl
3	8
4	9	1.63 Sat Feb 24 16:41:03 2007
5	10	=> I didn't check the existence of Image::Magick in

+1

-0

MANIFEST less more

9	9	t/06-version_magick.t
10	10	t/98-gd.t
11	11	t/99-magick.t
	12	t/magick.pl
12	13	t/t.api
13	14	t/skip.test
14	15	eg/demo.pl

+3

-3

META.yml less more

0	0	---
1	1	name: GD-SecurityImage
2		version: 1.63
	2	version: 1.64
3	3	author:
4	4	- 'Burak Gursoy <burak@cpan.org>'
5	5	abstract: Security image (captcha) generator.

13	13	provides:
14	14	GD::SecurityImage:
15	15	file: lib/GD/SecurityImage.pm
16		version: 1.63
	16	version: 1.64
17	17	GD::SecurityImage::GD:
18	18	file: lib/GD/SecurityImage/GD.pm
19	19	version: 1.50

22	22	version: 1.37
23	23	GD::SecurityImage::Styles:
24	24	file: lib/GD/SecurityImage/Styles.pm
25		version: 1.20
	25	version: 1.21
26	26	generated_by: Module::Build version 0.2805
27	27	meta-spec:
28	28	url: http://module-build.sourceforge.net/META-spec-v1.2.html

+4

-2

eg/demo.pl less more

24	24
25	25	# - - - - - - - - - - - - - - > S T A R T P R O G R A M < - - - - - - - - - - - - - - #
26	26
27		$VERSION = '1.40';
	27	$VERSION = '1.41';
28	28
29	29	use constant REQUIREDMODS => qw(
30	30	DBI

66	66	};
67	67	}
68	68
	69	my $NOT_EXISTS = quotemeta "Object does not exist in the data store";
	70
69	71	run() if not caller; # if you require this, you'll need to call demo::run()
70	72
71	73	sub TEST_FONT_EXISTENCE {

144	146	# IP and browser string to validate the session.
145	147	# It is also possible to put a timeout value for security_code key.
146	148	# But, all these and anything else are all beyond this demo...
147		if ( $@ && $@ =~ m{ \A Object does not exist in the data store }xms ) {
	149	if ( $@ && $@ =~ m{ \A $NOT_EXISTS }xms ) {
148	150	$create_ses->('new');
149	151	}
150	152

+3

-1

lib/GD/SecurityImage/Styles.pm less more

1	1	use strict;
2	2	use vars qw[$VERSION];
3	3
4		$VERSION = '1.20';
	4	$VERSION = '1.21';
5	5
6	6	sub style_default {
7	7	$_[0]->_drcommon(" \ lines will be drawn ");

60	60	$self->style_ellipse(@_) if not $self->{DISABLED}{ellipse}; # GD < 2.07
61	61	$self->style_circle(@_);
62	62	}
	63
	64	sub style_blank {}
63	65
64	66	sub _drcommon {
65	67	my $self = shift;

+60

-6

lib/GD/SecurityImage.pm less more

3	3	use GD::SecurityImage::Styles;
4	4	use Carp qw(croak);
5	5
6		$VERSION = '1.63';
	6	$VERSION = '1.64';
7	7
8	8	sub import {
9	9	my $class = shift;

625	625	This is the combination of ellipse and circle styles. Draws both ellipses
626	626	and circles.
627	627
	628	=item B<blank>
	629
	630	Draws nothing. See L</"OTHER USES">.
	631
628	632	=back
629	633
630	634	I<Note>: if you have a (too) old version of GD, you may not be able

978	982	<td><img border="0" src="http://img521.imageshack.us/img521/7235/magickscramble03boxmb2.png" /></td>
979	983	</tr>
980	984
981
982	985	<tr><td colspan="2"> </td></tr>
983	986	<tr>
984	987	<td>Style: <b>circle</b>. Scrambled with a fixed angle.</td>

987	990
988	991	<tr>
989	992	<td><img border="0" src="http://img139.imageshack.us/img139/7227/magickscramblefixed04cihd4.png" /></td>
990		<td><img border="0" src="http://img139.imageshack.us/img139/9484/magickscramblefixedinfooj6.png" /></td>
	993	<td><img border="0" src="http://img440.imageshack.us/img440/2647/magickscramblefixed05elnz6.png" /></td>
991	994	</tr>
992	995
993	996	<tr><td colspan="2"> </td></tr>

1030	1033	</pre>
1031	1034	</p>
1032	1035
	1036	<p>Images hosted by <a href="http://imageshack.us">ImageShack</a>.</p>
	1037
1033	1038	=end html
1034	1039
	1040	=head2 OTHER USES
	1041
	1042	C<GD::SecurityImage> drawing capabilities can also be used for
	1043	I<counter image> generation or displaying arbitrary messages:
	1044
	1045	use CGI qw(header);
	1046	use GD::SecurityImage 1.64; # we need the "blank" style
	1047
	1048	my $font = "StayPuft.ttf";
	1049	my $rnd = "10.257"; # counter data
	1050
	1051	my $image = GD::SecurityImage->new(
	1052	width => 140,
	1053	height => 75,
	1054	ptsize => 30,
	1055	rndmax => 1, # keeping this low helps to display short strings
	1056	frame => 0, # disable borders
	1057	font => $font,
	1058	);
	1059
	1060	$image->random( $rnd );
	1061	# use the blank style, so that nothing will be drawn
	1062	# to distort the image.
	1063	$image->create( ttf => 'blank', '#CC8A00' );
	1064	$image->info_text(
	1065	text => 'You are visitor number',
	1066	ptsize => 10,
	1067	strip => 0,
	1068	color => '#0094CC',
	1069	);
	1070	$image->info_text(
	1071	text => '( c ) 2 0 0 7 m y s i t e',
	1072	ptsize => 10,
	1073	strip => 0,
	1074	color => '#d7d7d7',
	1075	y => 'down',
	1076	);
	1077
	1078	my($data, $mime, $random) = $image->out;
	1079
	1080	binmode STDOUT;
	1081	print header -type => "image/$mime";
	1082	print $data;
	1083
1035	1084	=begin html
1036	1085
1037	1086	<p>
1038		All images in this document are generously hosted by
1039		<a href="http://imageshack.us">ImageShack</a>
1040		<a href="http://imageshack.us"><img src="http://imageshack.us/img/imageshack.png" border="0" /></a>
	1087	The generated graphic will be:
	1088	<br/>
	1089	<br/>
	1090	<img src = "http://img101.imageshack.us/img101/4770/gdsicountered2.png"
	1091	border = "0"
	1092	alt = "Image Hosted by ImageShack.us" />
1041	1093	</p>
	1094
	1095	<p>Image hosted by <a href="http://imageshack.us">ImageShack</a>.</p>
1042	1096
1043	1097	=end html
1044	1098

+5

-4

t/04-backend.t less more

0	0	#!/usr/bin/env perl -w
1	1	use strict;
	2	use vars qw( $MAGICK_SKIP );
2	3	use Test;
3	4	use Cwd;
4	5
5	6	BEGIN {
6		eval "require Image::Magick";
7		my $skip = $@ ? "You don't have Image::Magick installed." : '';
	7	do 't/magick.pl' \|\| die "Can not include t/magick.pl: $!";
	8
8	9	my %total = (
9	10	magick => 2,
10	11	gd => 2,

24	25
25	26	# test if we've loaded the right library
26	27	gd();
27		$skip ? skip_magick() : magick();
	28	$MAGICK_SKIP ? skip_magick() : magick();
28	29	exit;
29	30
30	31	sub gd {

36	37	$class->import( backend => 'Magick' ); ok( $class->new->raw->isa('Image::Magick') );
37	38	}
38	39	sub skip_magick {
39		skip($skip . " Skipping...", sub{1}) for 1..$total{magick};
	40	skip( $MAGICK_SKIP . " Skipping...", sub{1}) for 1..$total{magick};
40	41	}
41	42	}

+4

-16

t/06-version_magick.t less more

0	0	#!/usr/bin/env perl -w
1	1	use strict;
	2	use vars qw( $MAGICK_SKIP );
2	3	use Test;
3	4	use Cwd;
4	5
5	6	BEGIN {
6		eval "require Image::Magick;";
7		my $skip;
8
9		if ( $@ ) {
10		$skip = "You don't have Image::Magick installed.";
11		}
12		elsif ($Image::Magick::VERSION lt '6.0.4') {
13		$skip = "There may be a bug in your PerlMagick version's "
14		."($Image::Magick::VERSION) QueryFontMetrics() method. "
15		."Please upgrade to 6.0.4 or newer.";
16		}
17		else {
18		$skip = '';
19		}
	7	do 't/magick.pl' \|\| die "Can not include t/magick.pl: $!";
20	8
21	9	my $TOTAL = 6;
22	10	plan tests => $TOTAL;
23	11
24		if ($skip) {
25		skip($skip . " Skipping...", sub{1}) for 1..$TOTAL;
	12	if ( $MAGICK_SKIP ) {
	13	skip( $MAGICK_SKIP . " Skipping...", sub{1}) for 1..$TOTAL;
26	14	exit;
27	15	}
28	16	else {

+4

-17

t/99-magick.t less more

0	0	#!/usr/bin/env perl -w
1	1	use strict;
2		use vars qw( %API );
	2	use vars qw( %API $MAGICK_SKIP );
3	3	use Test;
4	4	use Cwd;
5	5
6	6	BEGIN {
7		eval "require Image::Magick;";
8		my $skip;
9
10		if ( $@ ) {
11		$skip = "You don't have Image::Magick installed.";
12		}
13		elsif ($Image::Magick::VERSION lt '6.0.4') {
14		$skip = "There may be a bug in your PerlMagick version's "
15		."($Image::Magick::VERSION) QueryFontMetrics() method. "
16		."Please upgrade to 6.0.4 or newer.";
17		}
18		else {
19		$skip = '';
20		}
	7	do 't/magick.pl' \|\| die "Can not include t/magick.pl: $!";
21	8
22	9	%API = (
23	10	magick => 6,

33	20
34	21	plan tests => $total;
35	22
36		if ($skip) {
37		skip($skip . " Skipping...", sub{1}) for 1..$total;
	23	if ( $MAGICK_SKIP ) {
	24	skip( $MAGICK_SKIP . " Skipping...", sub{1}) for 1..$total;
38	25	exit;
39	26	}
40	27	else {

+19

-0

t/magick.pl less more

	0	use strict;
	1	use vars qw($MAGICK_SKIP);
	2	BEGIN {
	3	eval "require Image::Magick;";
	4	if ( $@ ) {
	5	$MAGICK_SKIP = "You don't have Image::Magick installed.";
	6	$MAGICK_SKIP .= " $@";
	7	}
	8	elsif ( $Image::Magick::VERSION lt '6.0.4') {
	9	$MAGICK_SKIP = "There may be a bug in your PerlMagick version's "
	10	. "($Image::Magick::VERSION) QueryFontMetrics() method. "
	11	. "Please upgrade to 6.0.4 or newer.";
	12	}
	13	else {
	14	$MAGICK_SKIP = '';
	15	}
	16	}
	17
	18	1;