GD-SecurityImage-1.73000755000765000024 012457575566 14124 5ustar00burakstaff000000000000GD-SecurityImage-1.73/.perlcriticrc000444000765000024 212112457575566 16743 0ustar00burakstaff000000000000# disable these [-Miscellanea::RequireRcsKeywords] [-ValuesAndExpressions::ProhibitConstantPragma] [-ValuesAndExpressions::ProhibitLeadingZeros] [-Variables::RequireInitializationForLocalVars] [-Modules::ProhibitMultiplePackages] [-ControlStructures::ProhibitPostfixControls] [-Modules::ProhibitAutomaticExportation] [-CodeLayout::RequireTidyCode] [-Documentation::RequirePodSections] [-Variables::ProhibitPunctuationVars] [-Modules::RequireExplicitPackage] [-BuiltinFunctions::ProhibitStringyEval] [-Modules::RequireVersionVar] [-ValuesAndExpressions::RequireInterpolationOfMetachars] [-Documentation::RequirePodLinksIncludeText] # configurable parts [TestingAndDebugging::ProhibitNoStrict] allow = refs [Subroutines::ProhibitManyArgs] max_arguments = 8 [Variables::RequireLocalizedPunctuationVars] allow = %ENV %INC $| [RegularExpressions::RequireBracesForMultiline] allow_all_brackets = 1 [RegularExpressions::ProhibitUnusualDelimiters] allow_all_brackets = 1 [Variables::ProhibitPackageVars] packages = Data::Dumper File::Find FindBin Log::Log4perl Config GD-SecurityImage-1.73/Build.PL000444000765000024 44412457575566 15537 0ustar00burakstaff000000000000#!/usr/bin/env perl # This file was created automatically use 5.006; use strict; use warnings; use lib qw( builder/lib ); use Build; my $mb = Build->new; $mb->add_pod_author_copyright_license( 1 ); $mb->copyright_first_year( 2004 ); $mb->change_versions( 1 ); $mb->create_build_script; 1; GD-SecurityImage-1.73/Changes000444000765000024 4050012457575566 15573 0ustar00burakstaff000000000000Revision history for Perl extension GD::SecurityImage. Time zone is GMT+2. 1.73 Wed Jan 21 01:36:45 2015 => RT#87918. 1.72 Sun Jul 8 01:50:04 2012 => Bump version. 1.71 Sun Sep 4 00:58:52 2011 => Major Perl::Critic refactoring. => Pod fix by Gregor Herrmann. 1.70 Thu Apr 30 16:56:32 2009 => Made a mistake. version checking test is really gone now. 1.69 Thu Apr 30 15:13:19 2009 => Re-release without the version check test. 1.68 Wed Apr 22 19:49:46 2009 => Update builder. 1.67 Sat Apr 18 05:45:48 2009 => Update distro files. 1.66 Sun Jun 8 17:03:24 2008 => Fix for RT#35115. 1.65 Wed Feb 27 21:47:38 2008 => Fix for RT#33629. => All files unixified (LF). 1.64 Wed Apr 25 21:01:49 2007 => Yet another test suite update for Image::Magick. => New style "blank" added for evil purposes. => Fixed a regex in demo.pl 1.63 Sat Feb 24 16:41:03 2007 => I didn't check the existence of Image::Magick in 06-version_magick.t and this resulted with FAILs. Fixed this and updated all magick tests. They now show the real number of skipped tests (if they are skipped) 1.62 Fri Feb 23 23:13:37 2007 => Minor fixes in Pods. Added an image samples section (as HTML) and CPAN modules that are using GD::SecurityImage. Also added a SUPPORT section. => Updated demo.pl. Added "program" config option. => Refactored and cleaned up some parts and demo. Most parts are "Damianized". => New private methods _versionlt() and _versiongt() for backend version comparison. _versiongt() actually means: "greater than or equal to". => Updated tests. => Optimized styles. 1.61 Thu May 25 21:56:44 2006 => Renamed constants in GD::SecurityImage::GD: _X_ is now CH_X _Y_ is now CH_Y There is a bug in the constant pragma that is bundled with legacy perl ($] < 5.006). In these perls, the code was dying with this message: Can't define "_X_" as constant (name contains invalid characters or is empty). 1.60 Sun Feb 19 23:33:36 2006 => Removed GD::SecurityImage::AC to it's own distribution because of the increasing interest. 1.59 Fri Jan 6 13:56:41 2006 => Updated ::AC. Module. It now dies if gdbox_empty(). If libgd is compiled without TTF support, we'll get an empty image. Also added this to Pod. => Removed SIGNATURE file and signature test and anything Module::Signature related per RT #15346. I'm tired of Module::Signature. 1.583 Fri Nov 25 23:06:36 2005 => Another relase for distro/sig issues. Now all files are CRLF and signature testing is disabled if !MSWin32. Module::Signature currently (<= 0.50) can not validate CRLF files if it is working under some non-Windows OS. I'm waiting for a response from Module::Signature author on this subject. => Renamed some tests. => Updated pod. 1.582 Sat Oct 29 20:43:04 2005 => Updated test suite to increase kwalitee :) 1.581 Wed Oct 26 20:21:09 2005 => Fixed Makefile.PL. Build.PL was causing this error: "Too early to specify a build action 'Build'. Do 'Build Build' instead." Setting "PL_FILES" to an empty hashref solves the problem. This was mentioned in Module::Build::Compat, but I' ve missed it and this error does not seem to happen under Windows or with the latest version of ExtUtils::MakeMaker, I'm not sure which one is the case. 1.58 Wed Oct 26 13:28:35 2005 => Fixed a gdbox issue in ::GD backend. => Pod fixes. 1.57_02 Fri Oct 21 19:46:11 2005 => Reworked an undocumented method. New name is info_text(). You can now add information strips to the generated image. The demo already uses this undocumented feature for a while. This method can be used to add copyright information. Some free captcha services are doing that. Alternatively, you can display the image generation time like the demo does. => Added info_text() info to pod and fixed the other pod sections. => Updated test suite. 1.57_01 Wed Oct 19 14:31:22 2005 => Converted to Module::Build from ExtUtils::MakeMaker. => Nothing changed in modules. Just a test for PAUSE indexer and Module::Build. 1.57 Tue Oct 4 18:24:12 2005 => Fixed typos in pods. => Added RT Wishlist item #14618. 'angle' parameter is now used when scramble is not enabled. But this'll require a taller image, since the random code is centered inside the image. Added info about this into the pod. => Updated demo. 1.56 Sat Oct 1 14:14:34 2005 => Added GD::SecurityImage backend => 'AC'; => Updated demo Pod. => Added some tips to the pod. => Updated licenses. => Updated Makefile.PL. Removed Math::Trig from prerequisities, since it is in CORE since perl 5.004. => GD::SecurityImage::AC is now untainted (I hope). Reported by Michael B Krypel. Still no tests for this module. => Existence of setThickness() is now explicitly checked for GD < 2.07. 1.55 Wed Apr 13 17:58:37 2005 => New sub-module GD::SecurityImage::AC added as an Authen::Captcha drop-in replacement module. I currently didn't add any tests for this module. => New method 'backends' to list available back-ends. 1.54 Fri Apr 8 23:11:32 2005 => Updated pods. => If anyone adds a back-end, one must define a method to deal with colors: 'backend_cconvert'. cconvert() will forward all calls to backend_cconvert() if $BACKEND is different than /^(GD|Magick)$/. Note that this method must be capable of handling both HEX and RGB. => Finally documented this. See BACKEND_AUTHORS section in the pod (If you have a HTML version, probably you can not see this). => Removed gdbox_empty from GD::SecurityImage::Magick => The module now has an AUTOLOAD method. => Added a check for gdbox_empty in AUTOLOAD for non-GD backends. => Ooops! ellipse() added in GD 2.07 :p Thanks to ActiveState build logs. I missed that one (looks like all CPAN Testers are using recent GDs). Added a global mechanism to check this and any incompatibilities. If GD < 2.07 and you call ellipse() it will fall-back to default() style. If you call ec() style, it'll disable ellipse() call and only draw circles. => Updated GD::SecurityImage::Styles. => Updated demo program. Also, changed default type to 'png' after a little conversation with Eric Gorr. :) (some installations may have gif() method but don't have gif support enabled. This results with an empty image. Cause: old libgd). => Default image type in GD::SecurityImage::GD::out() changed to 'png'. 1.53 Wed Jan 5 18:21:59 2005 => Added a new option 'backend' to import(). With this option you can now include other back-ends: use GD::SecurityImage backend => 'Magick'; will load the GD::SecurityImage::Magick for example. If you wrote a backend for GD::SecurityImage, you can now combine your back-end with GD::SecurityImage. Like, if you created a Imager back-end named 'GD::SecurityImage::Imager', you can load it like this: use GD::SecurityImage backend => 'Imager'; No one requested this kind of functionality (yet), but I'm adding it anyway. And *NO* I will not create an Imager or any other backend myself (at least not in the near future). I' m already supporting two different interfaces. Probably cconvert() also needs a fix to support such a thing. I'll deal with that later. => If you have loaded Image::Magick outside and then you call GD::SecurityImage with the GD backend (or simply use it) your code dies with a weird error. Since it setups the interface for Image::Magick, but you didn't select Image::Magick as the backend. For example, this simple code dies if you are using 1.52 and below: use Image::Magick; use GD::SecurityImage; GD::SecurityImage->new->create; This bug cought by Dave Rolsky. => New class variable $BACKEND added to deal with this bug. The backend is now completely checked and set in import(). => Also, the module is now checking whether you called import() or not. If you didn't, it'll die (it actually checks if $BACKEND has a value). => Added a new test 'backend.t' to check these. 1.52 Tue Dec 21 15:07:37 2004 => After implementing HEX colors with cconvert, I forgot to set default colors in create() which will throw an exception without the default color values. Reported by Billy Vierra. => Updated pod. 1.51 Sun Dec 19 00:02:13 2004 => Updated demo program code. => Updated Makefile.PL. => New private method cconvert for transparent GD/Image::Magick color conversion. => Removed GD::SecurityImage::Magick::rgbx(). => The module now supports hex color codes like "#ffffff". => Updated pod. => [NOT DOCUMENTED] New private method add_strip. => [NOT DOCUMENTED] New method set_tl. => [NOT DOCUMENTED] New method change_random. => [NOT DOCUMENTED] New parameter 'text_location' added to new. => [NOT DOCUMENTED] With text_location option, you can now add info boxes to the 4 corners of the image (or you can use this for something else). => [NOT DOCUMENTED] Behavior of out() changed. If set_tl is used and you change the random code (text option) several times, it may be an array. 1.5 Sat Oct 30 17:11:53 2004 => Fixed pod. => Minor fixes. => rndmax option to new, now controls the minimum random character length, when you supply your own random string. => Updated tests. => Added a demo program to "eg/demo.pl". It needs DBI, DBD::mysql (and a MySQL server), Apache::Session, String::Random and some CORE modules to run. => GD still needs an absolute path. Fixed pod. 1.4_03 Mon Oct 11 21:55:37 2004 => Older GDs do not have setThickness. "setThickness" added in "GD 2.07 @ 24 Apr 2003". Fixed thickness option in new. Updated test api for this. Added this to Pod. => Added "compress" argument to out() for "jpeg" and "png". => But GD *again* has a problem here. Compression argument for png is implemented in "GD 2.07". out() silently ignores compression parameter, if you have an older GD and set output format to png. Added this to Pod. => Also, jpeg method and quality level for jpeg added in "GD 1.26 @ 18 Mar 2000". But currently, I didn't add any controls to detect that and I don't know who can use that pre-historic versions (other than sf.net!). => It's too hard to stay compatible with older versions! 1.4_02 Sat Oct 9 14:48:18 2004 => Fixed a bug in new for the angle parameter. => New private method setThickness. => New option 'thickness' added to new. => Replaced buggy/silly "_charw" with "ttf_info" in GD backend. Hopefully, this fixes the "scramble" implementation for GD. => Updated test suite. Now, there is a single test api and two test files. => Changed Makefile.PL. "GD" is now hardcoded as a prerequisite. Removed user input codes. The presence of "Image::Magick" is now tested inside the test file and magick test will be skipped if there is no "Image::Magick" (request from Barbie -- not exactly this, but similar). 1.4_01 Mon Sep 20 16:46:13 2004 => It looks like newer versions of GD does not have the path bug, but I do not know the exact version that this was fixed. Anyway, it looks like v2.16 does not have that bug. Also added this to Pod. => The module now automatically drops to 'normal' mode if you are using GD and your GD version is smaller than 1.20 and you have selected 'ttf' method. Q: Why? A: v1.19 and below does not have ttf support. (As mentioned in earlier releases) -- also: sf.net has GD v1.19 :). Module does this silently, so you'll not get any warnings about that. => New parameters scramble and angle added to new(). If you enable scramble, you have to generate a bigger image, since characters have three spaces between them. => I've decided to change the description of the module. Now it has the word "captcha" in it (for search engines). => Added some new constants to both backends. => Module now requires Math::Trig (which is a CORE module) for degree to radian calculation. => New tests for scramble. => New private method random_angle. 1.33 Sun Aug 22 16:50:42 2004 => Because of libgd's path bug, in some cases, GD::SecurityImage::GD::insert_text() can not get the boundary list. I've added a workaround there. If we don't get the list, then we'll use width/2 and height/2 which will generate wrong values (since the image will not include any string and because the underlying library can not find the ttf font, that's not the problem), but I can not do anything about it. GD wants an *exact* path with no spaces in it for TTF Fonts. Just don't put your codes/fonts in paths that have spaces in it. And don't try to "make test" from a location like this. You can blame windowz and/or libgd for this. Also, if Cwd::getcwd() can not get the exact path, we will have the same problem, but after this version, you'll probably not get "Use of uninitialized value" warnings. => New method gdbox_empty() added to GD::SecurityImage::GD. Also added a fake gdbox_empty() method to GD::SecurityImage::Magick for compatibility. Under GD::SecurityImage::Magick, this method always returns false. => Minor fix in create(). => Updated Pods. Sub modules have definiton of what they are now. 1.321 Wed Jul 28 21:52:04 2004 => Updated tests. Code didn't change. 1.32 Wed Jul 28 15:49:12 2004 => Minimal fix in create(). => There is a bug in PerlMagicks older than 6.0.4. From : "PerlMagick's QueryFontMetrics() incorrectly reports `unrecognized attribute'` for the `font' attribute". Image::Magick test is now skipped if your $Image::Magick::VERSION is smaller than 6.0.4. Please upgrade to 6.0.4, if you want to use Image::Magick as the backend. => Added this bug to Pod. 1.31 Sun Jun 27 00:08:49 2004 => Updated Pod. => send_ctobg is disabled automatically if style is set to 'box'. => All styles can put a frame around the image now. And this feature is enabled by default. => New option 'frame' added to new(). => Renamed constants in GD::SecurityImage::GD. => Changed tests. 1.3 Mon Jun 21 19:11:13 2004 => New method particle(). => Private method r2h(). => Fixed color conversion for Image::Magick. => out() now accepts arguments. => Updated pod. 1.2 Fri Jun 18 21:39:08 2004 => Added raw() method. => Fixed gd_font object key. => new style "ec". => Adapted Image::Magick compatibility (request from Mark Fuller). I may add Image::Magick spesific styles in future releases. => New modules added: GD::SecurityImage::GD GD::SecurityImage::Magick GD::SecurityImage::Styles and GD::SecurityImage is smaller now ;) => Renamed old tests to (added 'gd_' to names): t/gd_01_use.t t/gd_02_normal.t t/gd_03_ttf.t => Added new tests: t/im_01_use.t t/im_02_ttf.t => Altered Makefile.PL and test files to skip tests if the user selects to do so. 1.1 Fri May 14 22:08:39 2004 => Added 'send_ctobg' option to new(). => After testing the code with a *really* old GD (1.19 -- which has no ttf support), I've realized that stringFT was implemented in GD 1.31. So, the ttf test now has a skip option. => Also added stringTTF check for backward compatibility. stringTTF => (GD 1.20 @ 30 Aug 1999 ) stringFT => (GD 1.31 @ 26 Sep 2001 ) => Fixed pod. There was an '=item' instead of '=head'. => Added new styles 'circle' and 'ellipse'. => Updated 03_ttf.t 1.0 Mon Apr 26 21:40:45 2004 => First release. GD-SecurityImage-1.73/LICENSE000444000765000024 4374012457575566 15316 0ustar00burakstaff000000000000This software is copyright (c) 2015 by Burak Gursoy . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2015 by Burak Gursoy . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2015 by Burak Gursoy . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End GD-SecurityImage-1.73/Makefile.PL000444000765000024 100012457575566 16222 0ustar00burakstaff000000000000#!/usr/bin/env perl # This file was created automatically use 5.006; use strict; use warnings; use lib qw( builder/lib ); use Build::Spec qw( mm_spec ); use ExtUtils::MakeMaker; my %spec = mm_spec; WriteMakefile( NAME => $spec{module_name}, VERSION_FROM => $spec{VERSION_FROM}, PREREQ_PM => $spec{PREREQ_PM}, PL_FILES => {}, ($] >= 5.005 ? ( AUTHOR => $spec{dist_author}, ABSTRACT => $spec{ABSTRACT}, EXE_FILES => $spec{EXE_FILES}, ) : ()), ); GD-SecurityImage-1.73/MANIFEST000444000765000024 145112457575566 15413 0ustar00burakstaff000000000000.perlcriticrc Build.PL Generated automatically builder/lib/Build.pm builder/lib/Build/Constants.pm builder/lib/Build/Spec.pm builder/lib/Build/Util.pm builder/templates/pod/author.pod builder/templates/pod/monolith-warning.pod builder/templates/tools/Build.PL builder/templates/tools/builder.header builder/templates/tools/Makefile.PL builder/templates/tools/Makefile.PL.hook Changes eg/demo.pl lib/GD/SecurityImage.pm lib/GD/SecurityImage/GD.pm lib/GD/SecurityImage/Magick.pm lib/GD/SecurityImage/Styles.pm LICENSE Makefile.PL Generated automatically MANIFEST MANIFEST.bak MANIFEST.SKIP META.json META.yml README SPEC StayPuft.ttf t/03-info_text.t t/04-backend.t t/05-version.t t/06-version_magick.t t/98-gd.t t/99-magick.t t/lib/Test/GDSI.pm t/magick.pl xt/author/201-pod.t xt/author/202-pod-coverage.t GD-SecurityImage-1.73/MANIFEST.bak000444000765000024 145112457575566 16147 0ustar00burakstaff000000000000.perlcriticrc Build.PL Generated automatically builder/lib/Build.pm builder/lib/Build/Constants.pm builder/lib/Build/Spec.pm builder/lib/Build/Util.pm builder/templates/pod/author.pod builder/templates/pod/monolith-warning.pod builder/templates/tools/Build.PL builder/templates/tools/builder.header builder/templates/tools/Makefile.PL builder/templates/tools/Makefile.PL.hook Changes eg/demo.pl lib/GD/SecurityImage.pm lib/GD/SecurityImage/GD.pm lib/GD/SecurityImage/Magick.pm lib/GD/SecurityImage/Styles.pm Makefile.PL Generated automatically MANIFEST MANIFEST.bak MANIFEST.SKIP README SPEC StayPuft.ttf t/03-info_text.t t/04-backend.t t/05-version.t t/06-version_magick.t t/98-gd.t t/99-magick.t t/lib/Test/GDSI.pm t/magick.pl xt/author/201-pod.t xt/author/202-pod-coverage.t LICENSE META.yml META.json GD-SecurityImage-1.73/MANIFEST.SKIP000444000765000024 15612457575566 16141 0ustar00burakstaff000000000000#defaults ^Makefile$ ^blib/ ^pm_to_blib ^blibdirs ^Build$ ^_build/ \.tmp$ \.old$ ^MYMETA\.yml$ ^MYMETA\.json$ GD-SecurityImage-1.73/META.json000444000765000024 216612457575566 15707 0ustar00burakstaff000000000000{ "abstract" : "Security image (captcha) generator.", "author" : [ "Burak Gursoy " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4204", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "GD-SecurityImage", "no_index" : { "directory" : [ "monolithic_version", "builder", "t", "xt" ] }, "prereqs" : { "build" : { "requires" : { "Test::More" : "0.40" } }, "configure" : { "requires" : { "Module::Build" : "0.42" } }, "runtime" : { "recommends" : { "Image::Magick" : "v6.0.4" }, "requires" : { "GD" : "0" } } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "http://github.com/burak/cpan-gd-securityimage/" } }, "version" : "1.73" } GD-SecurityImage-1.73/META.yml000444000765000024 122612457575566 15533 0ustar00burakstaff000000000000--- abstract: 'Security image (captcha) generator.' author: - 'Burak Gursoy ' build_requires: Test::More: 0.40 configure_requires: Module::Build: 0.42 dynamic_config: 1 generated_by: 'Module::Build version 0.4204, CPAN::Meta::Converter version 2.133380' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: GD-SecurityImage no_index: directory: - monolithic_version - builder - t - xt recommends: Image::Magick: v6.0.4 requires: GD: 0 resources: license: http://dev.perl.org/licenses/ repository: http://github.com/burak/cpan-gd-securityimage/ version: 1.73 GD-SecurityImage-1.73/README000444000765000024 144112457575566 15141 0ustar00burakstaff000000000000GD::SecurityImage ================= Security image (captcha) generator. Read the module's POD for documentation and examples. INSTALLATION Just use the cpan shell to install this module. From a command prompt, type: cpan or perl -MCPAN -e shell to enter the cpan shell. And then enter: install GD::SecurityImage If you don't have the cpan shell available, then you have a broken perl installation. DEPENDENCIES This module requires these other modules: GD The sample TTF Font "StayPuft.ttf" is taken from John Stracke' s site at and only used by the tests. You can use another True Type in your code. "StayPuft.ttf" is Copyright (c) 2003 by John Stracke COPYRIGHT & LICENSE See the LICENSE file bundled with this distribution. GD-SecurityImage-1.73/SPEC000444000765000024 222712457575566 14741 0ustar00burakstaff000000000000print qq~ .------------------------------------------------------------. | You are about to install "GD::SecurityImage". | | | | Although it is in the GD:: namespace, the module is also | | compatible with Image::Magick. If you have "Image::Magick" | | installed, the required tests for "Image::Magick" will be | | performed. | | | | Note that "Image::Magick" is *not* a prerequisite for | | "GD::SecurityImage", but "GD" is. | ------------------------------------------------------------ ~; { module_name => 'GD::SecurityImage', requires => { 'GD' => 0, }, recommends => { 'Image::Magick' => '6.0.4', }, meta_merge => { resources => { repository => 'http://github.com/burak/cpan-gd-securityimage/', }, }, BUILDER => { change_versions => 1, copyright_first_year => '2004', add_pod_author_copyright_license => 1, }, } GD-SecurityImage-1.73/StayPuft.ttf000444000765000024 10536412457575566 16630 0ustar00burakstaff000000000000pGDEF%GPOSّGSUBְ lOS/2S5JxVcmap(cvt !yTgaspXglyfP{`uheadz@6hhea Vzx$hmtxMzLlocaOm}maxp" namerqpost!$  ,latnkernedjjjj DjFjGjHjJjL~M~PjQjRjSjTjUjVVWjXjYjZj[j\j]j jjjDFHJR )3 ,latnfrac, 1PfEd@ h8Zh|`     & I    & G &|vuip  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`absefjyqlwkthxm}don~czr{!y!n./<2<2/<2<23!%!!!M f!X ,76767'4574/&'&6'&'&76`: 0': &(  -$.0[ }Y/2\R4z $ $) 72361676'&'"727675756'&'" r  NMNM6'&'&76'&7621'&7676767676767676'&7676737676'41&'&+&'&767673676'5&'&'"'&776'&/&'&7656'&),%!&0'D!98&-.  & %&$ '& /6$0 " B5""0   .-# ++ 21 % 0/ $  '   (,  % #/5'!"<= +00 ! 44  #'  1   !&  2Ru2!:; 45&  m4&31"'&?676'&7632?676'&'&'#"'&767676'&/&'&76'&'& 229?Cz#G: A X#>6 B2  )" 87:/ $GOB+:NK  .H#%%!Z: ) 1 !"     X^*'" "!$  .,,$4Gc%7676'5&'&'6'&'&'&76767676'&'&'6'&'&76%676'&'&767676a !&1 ( #4 &   &1 '  #3&+(I6!5.* 7X   ! )3&  (6   " )3& '7* SHLH(Cd%'&'&767632?6'&'&?6&76'&'&'&'&?656'&'&#'&'&'47676@0(,2 .55 a767654'&'&'&?676ԓ! 2-7:%=<&,"f$%Ԡ5HL ;8MWW<7 > TVP6'&7667676767676?676/&76&76'&/&'&'&?6'&c!B>.  76 .=/ ;# (  6#&(89"ZD & ":71H8 ,4 %1=0"+  ID 1`."56)-2 d0 &B&'&767676''&767676'&'&'&'&767015&'&  -,# //  $0 *--  '% 6.i12A1 $. 10 # -8K-  '/  2/ -"*K76'&'&?676'&76]& 52>.#  {=l u!*816"'&776327676'5'&'&F=# <\KD !$Kjw!}S(!=/76?323276'&'&765476'&& 73  3, 0=8/  :yA~^K7 &,L$Q/Db$YC'&7676/&761767676'&'&?67676'&'&'"#&29 "  2% / 2-O!'T6> 41 $jV! 4G(  A[(V%'?9&@"    jh`@!"]?faIC&7676?676'&'&'&'&76764'&'&'&767676'&#n"  -, %  < XH 61D] ? $ 1+ $_'0 (@  3; <% .Zf$-%wM):1+2  Q>( _ C&765676'&7676/&7676'&'&'&76'&767t)() 7$       8 L 12  0C,A m"CH1  &'   .yB!7d|< $HI7 SE&'&1?61'&"767676'&'&'&'&7676'5015&Bxx& "6 C+ +' ! /U^%  $41 ) 6^6Hh.9$ "h`#  . 7%)i$J) 7t(  V A6'&'&7677676'&'&7676'&'&'&'&'&76767676u1:0:  0%5?(N 9HG[0<;  &8&*- &*/CM,,d}(z v\6F =}TN 9! B <; R*767676767676'&'&2"#''' J= ("5015. (%!  9#Z O#*3  P_P+ZQ>%  Avg!{nR&M BV&7676'&'&'&'&5476760'&'&=&54767677676'&'&'&'&$ / 1 )&!%E?D %$)(!%E?B $#$ /0  &5 #3 '2/\,&#%L7&31 (3/\,&#$K  2'53  &5 #3 B#7&'&'&76'&'&7767676'7676'&'&'&'&}'hE?3 #'S&/;0 F$ /0 x{tC,)"JT9S r8 c-1 ,,2'$T &5 #3 A !&7631'41&&7631'&M #  ! #  !'0  #' )0  #' )(K(76'&'&?676'&76'&7631'41&[& 52>.$   #  !{ =l u!*810  #' )v> 6'&'&'&'&'&7676767691vK9)f+' "## ''r@$=8 #W *." "$'&B&dv>Y V ?7&76'&76767676676?6?6'&'&# #  !o" *( , +) &"+ . J"'7+"-0 #' )30 5Ta +=8,@VGEB 9  4$L6'&'&'&76'7676'&'&7676'&'#"'&'&767676'&'&1&79 E+6V`@*JRlfN{HbPWB S bj. W (=^;5)0 %&* -/ i$ |O5$:jzhCWO{wk ,@ $ lv=4P ,H6'&'&7627654'&'&'&/&'&'&767676768!, 0#;;)7B I.;,EHG9 ") 1 >4  ] !0''#C F %C( A<1@`#  2T l>*, 0-:!2! CC0!# c6'&'&76"'&'&?676%&76767676767656'&/5&7547675654'&'&'&JF7O V E 1i% I %12 /H% P?A8 U!@x,' %B;#:9- .(*x). &YNe*0&47  <8  M$ !?&.k' .0 L (%!Y ;UD&C:&g 8&76;7676'&;67676'&'5&'&'&'&'&NPf*#5 NQUi E{ tV5 *% )R@A$/ " =7 ,>E-*@'_E$4-[[2*&buG#^a:2 < ^)0(# 7# $ (a%8!  !.$&(:'66/(= 0  K%&'&7676&76'&'&'&6'&'&7637676'41&'&'&376'&2=*_A. @$[E%- 6^x\5* buG#^a:'$ 2   oTL1% *. $ %!1+)%4!0&=/ 2 < GnY6JB % B676&7676'&;67676'&'&'&'&'&'&NO_)3 6 IOUi E{ tV A)PQT? /"T>>= RL02 1R\b"6 NJ/aiZ p8&?63276'&'&6'&'&76'&75756'41&'&!(,$ #Dz*!-LC. 'F`M3H  -F;*>M+!PN)#16)$&A#* &[2Q #B; 25`%&/&'"'&?676'&'&/&'4767?6763'&'&?6'&6  !5C>%2)& 'r?9 >-6o,"."/' !M9+: &yi7 Lw390/#(3{}%</*9:"|-F 7676/&76767&'&/&'&'&1#-#/' "M9*: SYE" !FC '01    >nXJK;!+7U5< .&8 '5k>nU~ )& OR!  /zd  C{\ +1'&'&76767&7676'45&'&uG3D 4Cu]Z YN_usmg*+]Zih}YAVoO - NMphC:][xq tonl <C6'&'&747056'7677676367676'&'&'&'"03P.$.0M3(/ &# < 3&"KG!:#(_W&2<- m8 (9:"(<LK%!mZ $=73KeO%! [`1%W "  :&L1'&'&'&'&76767&7676376'&/&76'&'#&'&uG3  (*> u\[ XO^t"Kmh++uVC % 1!:iKh%}YBV-!  NMphC:]!^wxqQG  (' scnN hY6'&'&747056'7677676767676'&'&'&'&7676?3173676'&'&'&'"3P.$.0M3(/ )% G'#+# dU"#OO  [&:#(_W&2=8:m8 (9:"(<LC'!jX %<6:M^FyAB![`1%W  ! =7&#7676'&'&'&'&'&'&7676/1&'&#"'&'&|5  !/dS)[ [-.13 'wHf,%Y210 3<l+I$Hp+ --' QOaX_-  Na9 )#2A00 6?67676'&'&/&76763276'&'&N/?M/?  -PR0 ;=< '/OZ>66+$Ait%.*;8'+ pB.>>86767676767676'&&'&'&76'&'&DK& @  ,$<7:1O'D  =E  <8C,Y~(<o4hSw7676'&&767676'4'4'&#"6+'&'5/41&'&:.MBA $ UQ@ V*+0"" 1%XB-:/ 1& Huh:*.,Fgl M<3,*'9@O<{E ;q5. "OD%7361767676'&6'"=01676?636?6761676'&'"#'p/;&JPH+)мx437-- /_p  +;~21'^5. G=L*1?>Y :#?CO@A7HPNv=76'&'&6#'77363676'&'&'&'&76/476?6" +, I / --W A( 60  +;(0 LyH0% +27b@)1  xG@=G>T@:N'7676767036376''&'&#"6L  8" !# "$)<-O$! (#!* 647 )9U7 "%"'&7%632?676'&/&'&Qh[/. .[ re/ (#  2Yf +" #+  &'&'&'&0+*  A<! kY ":5+B76'&'&7676767676'&'&'&'&?6'&!- #. K7745 E ,JE2Q'$) ("CUQ"%*  %!! OMC  5YYH-& E77676'&'&'&'?6?6'&##"'&765656/5&76.; / /> + / W&mO#34  4(. /D+( 4?>2JV R?($F[ DU('&76'&'&54767676@ -. +/1 &  9Z4,4 TR( * '5 &. A !)TWP%< GE@ a1&7676'5&'&'&5476?676'&76. *- $.Z:14 RO,5-\ eq &#A %)TWP%: "=S'  #%U77676'&76;76'5/5'&'&'&'&'&767676'&'&&''&760101*(  $2 2+ (J? kR1 )  *!  8dX2  ! Z%*H D5 0]8`g &  ,oc49;%'&'&767676767674'&7676'&'&76'&&'1. 5L1 %?b6.@ G`E2T ::8:@1& /D8(E3"/B '7b\0"VN( A 3VvVF  57&7656'&7632;676'&'&?6'&" '(   )< N'& #8.*&!JU:R@W~n")>D =F(B:"@:n)7676'&'&7676'&5676'&&4* $ ")    . ' &(6 # #38$AJE< * =H?9n'776767676'&76756'&'&'7676'&'&! ,( $B"!%9* $ "o7@ m# +K ]3R7 61(X&(6 # #3M&?6'&56'&767647676''&'&'&7676767676'&#5476'&'"-+  !     , ;(& 1 .*" &#.V% &"F^"7=l #( KA 6N$ 5*&+53/ 5   #% E.h5;'7656'&'7&'&'&2  ()  '(JwV01zN]Q7)& %r7'&'&7656'&76767767676?66'&'1#&'&776'476'&'&'&76'&'&'&'&g      >!   9!' ( *3  !+   /G<XN2      !B.k G>L$D(j&* 6# !PE "=@ 2 *) C<fK'&'&76'&'&'&'&'&'&7654'&767677676V !+      >!  AESJ "=@ 2 *) C< /G<XN2      ?  6'&'&7677676'&'&?$1 (?'5'lF>NH_jC=QBv2"A+4 'A'wPG]hFAUMcg?4 =F7676'&'&'&?656'&7676776'&'&&)+**4"63 *  !#7%#e*H(9 " '  3,/ (R'&9cvif5 *' +"I1b1;xD& /, <Z % =K'&'&767676/&5&76'&'&0''&76766)+*+4"63 *  !#7%#e*H(9 " '  3,/ )R'&9cvif5*' +"I1b1;xD& /, <Z %97'&'&77656'&767677676'&'&776'&0)8  )> ;%l', <5 (  = (  ,  YgM676'5&760176'1&#776'&'&?474756'&'&'&76&   &-        9J0"      ( $   !I" 5M!$< *&GX ( ,7 G23232367676''&7676'&'&&'&'&76745476'&)$  "N -0  0  &!$,"?SE>&0*Od(=7$  6\~"b$8@ 7+# "&76?6766#"''&'&'&L   I(%+ $/+ -6;) H@ ;Q#;;9cVe9>] c:L&/&'&"&76?5676&3676767676'&6#''015&w+# $  0&04 1!&-<" , :  ( E>-R$MW] I? L_ "+VbE"+a#5)%EQm9 1H<G676?6763'&'&'&'&'4#&'&6'&?6'&'&'&76;"  )$+,-4.?   ,!(@/@%531 9; 5H!+#+1+$$*<8 5I< &+-9&'(%#:7#'&767676'&'&'5&'&'&082191 P(% v2 , 2" -? / Qt!V7 $ cuC&?" $YP8 GgM&! 576#67676'&'&#?567676?67676'&#'D  &l/[p=:G$#J CGG  b 5C $<(-*5**% < !*9)&(3 4FQC&7676'&'&'&'4'&'&'&7676757=676?6'5&/.6 0  1@ # !# +("D^ ;1+&'VL 4 /2))7*( &(3-7276'&574'&#&7276'&574'&#&<  '! (#  '! (# %@&J;& .Q$b%@&J;& .Q$QG^h@*t$767676'&'&#'&'#&#"  : )  W@ "&" :J#  !)z1g )75676'&54767676'&#/#&'&'54/&'&#&6#0111?56?3767367676'&#'&'&76762'&/&'&/&&763767676716?676767676?167676?6'&'5&'&/#&'&1+''5'&67676?676767611#+"'&'&'&'&'&'&'456&'&'&'&'5&'&767676767676'"636767676'&#&776736#'5&/"#"/&'&/&'&+"/5/&7676767676'&76'&'&'"'&756767676776''&?576'&/&'&76767676736?6\   2;   &1 5 #  $&  l#%>%+3EGZ/ &  $BCd=0# ^96 Uh'W&"!=   !%3GX 5GY6@R '52)<K2_64+* &(?#9Z F( ".9C8  ): O(#*F0/!(0+DT>H#     U- "4K 2$   $ !   3# "!'      %./D g    WwCP3/\ P!,80 *?"$[@O&0;*{<OF6  (H(1GND++#'1 7JF=2&.   'J_.{W/  *; :$  5N!D3=4 C / ,K Q87 ?     0    8    & #   $ Cm  gY$ %$kw G@U D676"'&'&765'6'&76'&'&=476721676     -. +/1 &  9Z4,4 TR(9*%*+Q]8( * '5  &. A !)TWP%<  + l7676767676'&'&6/&'/4767676'5&'&'&'5&'&5&'&76&7676'&401'&76o,$ "DQ!":1/ -n>77   &,   6.  .D  B" j   & Y)#0 (&  $B$   A ' O-"<% %  ?@]N, ;1! &' !F`7676'&'&'767676?6366'&'&'&#'&'&'&767676'&'&'&'5&547676+2 1B%6 $2E->kB  M$  $ D&NQ U&$ -* C"6J)22J3$1   %#2uL$'K( 8 bO K) s76'&7676'&'&7676'5&'&'&743276'0/5'&54'#&76767676'4'4'&#"#&/&'&:IN >q(  &}'  BA 1m ALW="/UQ@ V*+0& 1%XB-://33"  M$..,9&2-  /& 3,*'9@OZ4;r6. 3_i'&'&7676&'&7676'&'&'&'&2'&'&'&7676&73676'&'&7;21376''". %2,0)" 75:5- < /*%76 %BA + O *A#  '3 IQ3[LT! >   (2 IQ3[KT!8> $4 '&?5676'&?5676#/  #( )/  #( ) #  ! #  !%)S7676'&'&676'&'&767676'&776'&'&=476?676cVLq_C\ZJhNw\|{WlbZ~^lfW -. +/,>/&  9Z4,4 TR(s]c KJfYI \Shu`Xjt P * '5  &. A !)TWP%< T4 .\"'&763276'&'&'6'&'&?6'76"?676'&/&'&76'&'&3(-' 9/,!V 0&' $% 039 2 /%4        73 + !=9v'_)"'&77632725676'&76'41&'&F=# <]@"$ !k#!")+&/  6%)c7676'&'&676'&'&767676'&'&775656'&?6767676'&'&75756/&'&cVLq_C\ZJhNw\|{WlbZ~^lf%2    %:  5`#) JD s]c KJfYI \Shu`Xjt $ 7`PF$ ##LB" "    4*Ik)8 6'5&5&7677676'&'&" " ; 1":1 $ $60!:3$9Z&'&76727676'&'&'&7637676''&7676'&'&'&76756'&K?!# CCSI  "A96  11" 33 '411 +$82 #  #  t$%  "  %$    ! "  #  %"  #):76'&7=76767676'5&'&'&?67676'&'&#&+1  !+" c2:(&!B: I&+  *@V+*%-%   F KD19.D31A&7676?676'&#&'&'&76766'&767637676'&#"O  !  -=/#     .B-    + "&*$@L N)(+# 0% GC@8L7676'&372367676''&7676'&'&&'&'&7676'476'&.$  #! -0  0  %" $,"?SE,a% 0 *Od(=7$  6[}"b$8@ 7+#  FZ61'&'&'&76767'&''&'&#&'&'&767676&7676'4'05&hT!K] *% ; !53-3&"KG!:#(_W883P.$.0M3(/ <%5|` (B:  YxNz%K%!mZ (F>/* KeO%! [`1%W 8 (9:"(<KNE+K7676'&'&] &'4$  (N$% ./76763676/&'&?457&'&#'! #"5  _)  `b  )d ); 'T5-="'&763276'&'&'601/&5&7677676'&'&4'-' 9/,!(#($D'6$+C%7      # * #)A7#*B';'-A!vgY@G!@I@n&7676/&7676'&7676376'&'&'&76'&173676763676'&'&7657'4'&%676'&'&767676    "   %1  #" C'! #"5  _)b+(I6!5-* 7X ,  +  // VC&#HW' 20   `b  )d  ); 5 SHLH(C S'uw&|dI@&7676/&7676'&7676376'&'&'&76'&1736&7676?676'&#&'&'&76766'&767637676'&#"676'&'&767676    "   %1  #" z  !  -=/#     .B-  +(I6!5-* 7X ,  +  // VC&#HW' 20   + "&*$@L N)(+# 0% SHLH(C V "^,N'CHC$,EgC:@$, 'Am$,'aj-$,'k=$, 's$ {&'&&7367676767676?632767676'&'&+"'&76767674'&6#'&'&?676137676'&'&6'&'&76{KC !=Z 1 =5  \ /(&$45!- # (#- 1  =6 ,35 *6p54#Kb@%*  #EPlL[7", /#0E-:!2! DB0@a*  !-K%8!!..@':%*("(=(   F %C( A<1J'{I&G'C;(8gC0,@('A('km(%+'C ,%+gC @,%'Aq,%'kDd,!`%&'&771276'&'&57676'&&2;76763276&'&'&'&6'&, ]> i.#?Z+%_02^gM( 5% _ U2 ?5 !FQB+Ah]+609L2(1aS"'%i " \&@GhZMQ:8#& /!w O+5,$%3%)%n \ 7L&!&'a1 V'CJ2 hgC\@2 'A2  'a&2 'k2/cLC6767676?6'&'&'5&'+&#&'&7676'&'&'&1 +    $ +  & !$&"c")' &)  "  *&&,    .G76767767676'&#'&'&76767&7676'45&'#&'&J?  Vf.!"uG3D9Vu]Z YN_usmg*+]ZiD]--J &n2 YBVoOC NMphC:][xq tonG 8'C88gC`@88'A88{'kG8 gC2@<%I7676'&'&'&5&7676'?5676776'/&)+**49;  0 -  %!%r%^!*$ $ 3,/ ("$/./O  ?< $h(-E 0*j7'&'&77676'&76766&'&'&'&5&767676'&'&'&'5&76?6?67676'&&2. "@l&&( % (!8$ :];   +0)/A (B2  " 3SiyD!Ii=IG"&W0S8(!# .  ( ?-%/=%5Q 2 iC8&CODgC@D&A@D'a&D &k[D&s;D a\l&741676'5&'&'&"'&'&'&7676767676'&'&'&7676"76'&32"#2%7676'&'&. *-;" + CE *.5 74 77?,'?  RO&5-\$e :!.  "0q &/E]  $$  : =S'  #) $# #  ) ]UB76'&76654'&'&76'&'&5476721676& )#  -. +/1 &  9Z4,4 TR( &C( * '5 &. A !)TWP%<  a&CHH agCP@H d&AH ua&Hk, {)77676'&5676'&&'&'&'&.!+   "/  0+*   A<! 6= ;2$ 3; =5! kN':5+ ~)77676'&5676'&6767676.!+   "/  0**  A=! 6= ;2$ 3; =5"! kN':5+ (B76767096723&76''&'&#"67676'&5676'&= *.; $@!+   "/  y  -H[.  %,  6= ;2$ 3; =5 5'&7676'&76767676'&5676'&>!  \!   !+   "/    6= ;2$ 3; =5 c%'&'&7676767/1&/&7633276'&5&57&'5'&'&'&'&7656'&#&'&276763>.:!/ 0= * - W&mO#43 B B W  . . /D+( 4?>2JV h22 *$$%+ *) 0w'aQ &CtR gC@R &AMR 'a<R &RkYz'Z&Z'7767767676'&6'&'&7677676'&'&Z-Nh "@9v`4 h?$1 (?'5'lF>NH_jC=QB0v-%"4T} 2"A+4 'A'wPG]hFAUMcg?4 &CcX gC @X &A9X &kPX: gC@\=G7676'&'&'&?674'&7676601776'&)+ *+3"73 , ) &0z... 3,/ (R'&9cvM  =_<-6 NX & $:&\k e6 6P"'&?2327676'0'&'&5./;:4-4 &1 " )1   6h!"'&?232?676'4#&'&#"82 2?=$08  %0 " (0  6#"'&?232?676'&'&'5&'&UM'(&K_^S&"! *IU !," $-  6  66'&/&.  ," ;)#%(1&  ;;+  G@ i ' i g@Gs@ ig @Gs @ i 'K ','  '"^"; '^"P '"m&&l&U_<8)h 8Z=)!M^3,TT*K^,^!^^^^ ^^ ^^A(TT^,!O%OJ&.gO  MM ^" s"TT^mm'2 u   c  T3Tu=^m5  ! 3 $\,)K+ \'XXX^,,,,,, O%O%O%O%&.....{/.MMMM   t mmmmm  u          ^ u 22     KXX++++uRl9X$k? g  & 0  $  x XCji4uh1;Xc547] Y=x ` !!|!!" %4%<%G%&X&''(C(|)))))***+X+,,),-.-7-^-. ..//00 00&020>0J1 1,181F1R1^1j1x112'232?2M2Y2e2q23O3[3i3u334444444456666)646z67'788%808>8I8U8`8p888889 9|9999:4:<:g:r:~::::::::*>@.$   B.r   < N,Yb!i   e'@Rh       B. r     <  N ,Copyright 2003 by John Stracke. Published under the GNU Lesser General Public License (LGPL): http://www.fsf.org/copyleft/lesser.htmlStayPuftMediumPfaEdit 1.0 : StayPuft : 9-8-2003StayPuftVersion 000.004 StayPuftJohn Strackehttp://www.thibault.org/fonts/Published under the GNU Lesser General Public License (LGPL): http://www.fsf.org/copyleft/lesser.htmlhttp://www.fsf.org/copyleft/lesser.htmlIt's the Stay-Puft Marshmallow Man! Created with pfaedit (http://pfaedit.sf.net).Copyright 2003 by John Stracke. Published under the GNU Lesser General Public License (LGPL): http://www.fsf.org/copyleft/lesser.htmlStayPuftMediumPfaEdit 1.0 : StayPuft : 9-8-2003StayPuftVersion 000.004 StayPuftJohn Strackehttp://www.thibault.org/fonts/Published under the GNU Lesser General Public License (LGPL): http://www.fsf.org/copyleft/lesser.htmlhttp://www.fsf.org/copyleft/lesser.htmlIt's the Stay-Puft Marshmallow Man!??Created with pfaedit (http://pfaedit.sf.net).2      !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abbcdefghjikmlnoqprsutvwxzy{}|~cdefghijspaceexclamquotedbl numbersigndollarpercent ampersand quotesingle parenleft parenrightasteriskpluscommahyphenperiodslashzeroonetwothreefourfivesixseveneightninecolon semicolonlessequalgreaterquestionatABCDEFGHIJKLMNOPQRSTUVWXYZ bracketleft backslash bracketright asciicircum underscoregraveabcdefghijklmnopqrstuvwxyz braceleftbar braceright asciitildeuni007F softhyphenuni2011 figuredash afii00208uni201Funi2047uni2048uni2049EuroGD-SecurityImage-1.73/builder000755000765000024 012457575566 15552 5ustar00burakstaff000000000000GD-SecurityImage-1.73/builder/lib000755000765000024 012457575566 16320 5ustar00burakstaff000000000000GD-SecurityImage-1.73/builder/lib/Build.pm000444000765000024 4275112457575566 20103 0ustar00burakstaff000000000000package Build; use strict; use warnings; use base qw( Module::Build ); ## no critic (InputOutput::ProhibitBacktickOperators) our $VERSION = '0.81'; use Carp qw( croak ); use Cwd qw( getcwd ); use File::Find; use File::Spec; use File::Path; use constant { CURRENT_DIR => getcwd, }; use Build::Constants qw( :all ); use Build::Spec; use Build::Util qw( slurp trim ); BEGIN { my %default = ( add_pod_author_copyright_license => 0, build_monolith => 0, change_versions => 0, copyright_first_year => 0, initialization_hook => q(), monolith_add_to_top => [], taint_mode_tests => 0, vanilla_makefile_pl => 1, ); foreach my $meth ( keys %default ) { __PACKAGE__->add_property( $meth => $default{ $meth } ); } } sub new { my $class = shift; my %opt = spec; my %def = DEFAULTS; foreach my $key ( keys %def ) { $opt{ $key } = $def{ $key } if ! defined $opt{ $key }; } $opt{no_index} ||= {}; $opt{no_index}{directory} ||= []; push @{ $opt{no_index}{directory} }, NO_INDEX; return $class->SUPER::new( %opt ); } sub create_build_script { my $self = shift; $self->_add_vanilla_makefile_pl if $self->vanilla_makefile_pl; if ( my $hook = $self->initialization_hook ) { my $eok = eval $hook; croak "Error compiling initialization_hook: $@" if $@; } return $self->SUPER::create_build_script( @_ ); } sub ACTION_dist { ## no critic (NamingConventions::Capitalization) my $self = shift; my $msg = sprintf q{RUNNING 'dist' Action from subclass %s v%s}, ref($self), $VERSION; warn "$msg\n"; my @modules; find { wanted => sub { my $file = $_; return if $file !~ m{ [.] pm \z }xms; $file = File::Spec->catfile( $file ); push @modules, $file; warn "FOUND Module: $file\n"; }, no_chdir => 1, }, 'lib'; $self->_create_taint_mode_tests if $self->taint_mode_tests; $self->_change_versions( \@modules ) if $self->change_versions; $self->_build_monolith( \@modules ) if $self->build_monolith; return $self->SUPER::ACTION_dist( @_ ); } sub ACTION_extratest { # Stolen from # http://elliotlovesperl.com/2009/11/24/explicitly-running-author-tests # my($self) = @_; $self->depends_on( 'build' ); $self->depends_on( 'manifest' ); $self->depends_on( 'distmeta' ); $self->test_files( qw< xt > ); $self->recursive_test_files(1); $self->depends_on( 'test' ); return; } sub ACTION_distdir { my ($self) = @_; $self->depends_on( 'extratest' ); return $self->SUPER::ACTION_distdir(); } sub _create_taint_mode_tests { my $self = shift; my @tests = glob 't/*.t'; my @taints; require File::Basename; foreach my $t ( @tests ) { my($num,$rest) = split /\-/xms, File::Basename::basename( $t ), 2; push @taints, "t/$num-taint-mode-$rest"; } for my $i ( 0..$#tests ) { next if $tests[$i] =~ m{ pod[.]t \z }xms; next if $tests[$i] =~ m{ pod\-coverage[.]t \z }xms; next if $tests[$i] =~ m{ all\-modules\-have\-the\-same\-version[.]t \z }xms; next if -e $taints[$i]; # already created! open my $ORIG, '<:raw', $tests[$i] or croak "Can not open file($tests[$i]): $!"; open my $DEST, '>:raw', $taints[$i] or croak "Can not open file($taints[$i]): $!"; print {$DEST} TAINT_SHEBANG or croak "Can not print to destination: $!"; while ( defined( my $line = readline $ORIG ) ) { print {$DEST} $line or croak "Can not print to destination: $!"; } close $ORIG or croak "Can not close original: $!"; close $DEST or croak "Can not close destination: $!"; $self->_write_file( '>>', 'MANIFEST', "$taints[$i]\n"); } return; } sub _change_versions_pod { my($self, $mod) = @_; my $dver = $self->dist_version; my($mday, $mon, $year) = (localtime time)[3..5]; my $date = join q{ }, $mday, [MONTHS]->[$mon], $year + YEAR_ADD; my $ns = $mod; $ns =~ s{ [\\/] }{::}xmsg; $ns =~ s{ \A lib :: }{}xms; $ns =~ s{ [.] pm \z }{}xms; my $pod = "\nThis document describes version C<$dver> of C<$ns>\n" . "released on C<$date>.\n" ; if ( $dver =~ m{[_]}xms ) { $pod .= join qq{\n}, "\nB: This version of the module is part of a", "developer (beta) release of the distribution and it is", "not suitable for production use.", ; } return $pod; } sub _change_versions { my($self, $files) = @_; my $dver = $self->dist_version; warn "CHANGING VERSIONS\n"; warn "\tDISTRO Version: $dver\n"; foreach my $mod ( @{ $files } ) { warn "\tPROCESSING $mod\n"; my $new = $mod . '.new'; open my $RO_FH, '<:raw', $mod or croak "Can not open file($mod): $!"; open my $W_FH , '>:raw', $new or croak "Can not open file($new): $!"; CHANGE_VERSION: while ( defined( my $line = readline $RO_FH ) ) { if ( $line =~ RE_VERSION_LINE ) { my $prefix = $1 || q{}; my $oldv = $2; my $remainder = $3; warn "\tCHANGED Version from $oldv to $dver\n"; printf {$W_FH} VTEMP . $remainder, $prefix, $dver; last CHANGE_VERSION; } print {$W_FH} $line or croak "Unable to print to FH: $!"; } $self->_change_pod( $RO_FH, $W_FH, $mod ); close $RO_FH or croak "Can not close file($mod): $!"; close $W_FH or croak "Can not close file($new): $!"; unlink($mod) || croak "Can not remove original module($mod): $!"; rename( $new, $mod ) || croak "Can not rename( $new, $mod ): $!"; warn "\tRENAME Successful!\n"; } return; } sub _change_pod { my($self, $RO_FH, $W_FH, $mod) = @_; my $acl = $self->add_pod_author_copyright_license; my $acl_buf; CHANGE_POD: while ( defined( my $line = readline $RO_FH ) ) { if ( $acl && $line =~ m{ \A =cut }xms ) { $acl_buf = $line; # buffer the last line last; } print {$W_FH} $line or croak "Unable to print to FH: $!"; if ( $line =~ RE_POD_LINE ) { print {$W_FH} $self->_change_versions_pod( $mod ) or croak "Unable to print to FH: $!"; } } if ( $acl && defined $acl_buf ) { warn "\tADDING AUTHOR COPYRIGHT LICENSE TO POD\n"; print {$W_FH} $self->_pod_author_copyright_license, $acl_buf or croak "Unable to print to FH: $!"; while ( defined( my $line = readline $RO_FH ) ) { print {$W_FH} $line or croak "Unable to print to FH: $!"; } } return; } sub _build_monolith { my $self = shift; my $files = shift; my @mono_dir = ( monolithic_version => split /::/xms, $self->module_name ); my $mono_file = pop(@mono_dir) . '.pm'; my $dir = File::Spec->catdir( @mono_dir ); my $mono = File::Spec->catfile( $dir, $mono_file ); my $buffer = File::Spec->catfile( $dir, 'buffer.txt' ); my $readme = File::Spec->catfile( qw( monolithic_version README ) ); my $copy = $mono . '.tmp'; mkpath $dir; warn "STARTING TO BUILD MONOLITH\n"; my(@files, $c); foreach my $f ( @{ $files }) { my(undef, undef, $base) = File::Spec->splitpath($f); if ( $base eq 'Constants.pm' ) { $c = $f; next; } push @files, $f; } push @files, $c; my $POD = $self->_monolith_merge(\@files, $mono_file, $mono, $buffer); $self->_monolith_add_pre( $mono, $copy, \@files, $buffer ); if ( $POD ) { open my $MONOX, '>>:raw', $mono or croak "Can not open file($mono): $!"; foreach my $line ( split /\n/xms, $POD ) { print {$MONOX} $line, "\n" or croak "Unable to print to FH: $!"; if ( "$line\n" =~ RE_POD_LINE ) { print {$MONOX} $self->_monolith_pod_warning or croak "Unable to print to FH: $!"; } } close $MONOX or croak "Unable to close FH: $!";; } unlink $buffer or croak "Can not delete $buffer $!"; unlink $copy or croak "Can not delete $copy $!"; print "\t" or croak "Unable to print to STDOUT: $!"; system( $^X, '-wc', $mono ) && die "$mono does not compile!\n"; $self->_monolith_prove; warn "\tADD README\n"; $self->_write_file('>', $readme, $self->_monolith_readme); warn "\tADD TO MANIFEST\n"; (my $monof = $mono ) =~ s{\\}{/}xmsg; (my $readmef = $readme) =~ s{\\}{/}xmsg; my $name = $self->module_name; $self->_write_file( '>>', 'MANIFEST', "$readmef\n", "$monof\tThe monolithic version of $name", " to ease dropping into web servers. Generated automatically.\n" ); return; } sub _monolith_merge { my($self, $files, $mono_file, $mono, $buffer) = @_; my %add_pod; my $pod = q{}; open my $MONO , '>:raw', $mono or croak "Can't open file($mono): $!"; open my $BUFFER, '>:raw', $buffer or croak "Can't open file($buffer): $!"; MONO_FILES: foreach my $mod ( reverse @{ $files } ) { warn "\tMERGE $mod\n"; my(undef, undef, $base) = File::Spec->splitpath( $mod ); my $is_eof = 0; my $is_pre = $self->_monolith_add_to_top( $base ); my $TARGET = $is_pre ? $BUFFER : $MONO; open my $RO_FH, '<:raw', $mod or croak "Can not open file($mod): $!"; MONO_MERGE: while ( defined( my $line = readline $RO_FH ) ) { chomp( my $chomped = $line ); $is_eof++ if $chomped eq '1;'; last MONO_MERGE if $is_eof && $base ne $mono_file; if ( $is_eof ) { warn "\tADD POD FROM $mod\n" if ! $add_pod{ $mod }++; $pod .= $line; next; } print { $TARGET } $line or croak "Unable to print to FH: $!"; } close $RO_FH or croak "Unable to close FH: $!"; } close $MONO or croak "Unable to close FH: $!"; close $BUFFER or croak "Unable to close FH: $!"; return $pod; } sub _monolith_prove { my($self) = @_; warn "\tTESTING MONOLITH\n"; local $ENV{AUTHOR_TESTING_MONOLITH_BUILD} = 1; require File::Basename; require File::Spec; my $pbase = File::Basename::dirname( $^X ); my $prove; find { wanted => sub { my $file = $_; return if $file !~ m{ prove }xms; $prove = $file; }, no_chdir => 1, }, $pbase; if ( ! $prove || ! -e $prove ) { croak "No `prove command found related to $^X`"; } if ( ! -x $prove ) { croak "Found prove at `$prove` but it is not executable!"; } warn "\n\tFOUND `prove` at $prove\n\n"; require IPC::Open3; my $prove_pid = IPC::Open3::open3( my($prove_in, $prove_out, $prove_err), $prove, '-I', File::Spec->catdir( CURRENT_DIR, 'lib' ), '-r', ( map { File::Spec->catdir( CURRENT_DIR, $_) } qw( t xt ) ) ); my $prove_status; while ( defined( my $result = <$prove_out> ) ) { chomp $result; $prove_status = $result; print "\t$result\n" or croak "Unable to print to STDOUT: $!"; } waitpid( $prove_pid, 0 ); my $prove_failed = $? >> 8; if ( $prove_failed || $prove_status ne 'Result: PASS' ) { croak MONOLITH_TEST_FAIL; } return; } sub _monolith_add_pre { my($self, $mono, $copy, $files, $buffer) = @_; require File::Copy; File::Copy::copy( $mono, $copy ) or croak "Copy failed: $!"; my $clean_file = sub { my $f = shift; $f =~ s{ \\ }{/}xmsg; $f =~ s{ \A lib/ }{}xms; return $f; }; my $clean_module = sub { my $m = shift; $m =~ s{ [.]pm \z }{}xms; $m =~ s{ / }{::}xmsg; return $m; }; my @inc_files = map { $clean_file->( $_ ) } @{ $files }; my @packages = map { $clean_module->( $_ ) } @inc_files; open my $W, '>:raw', $mono or croak "Can not open file($mono): $!"; printf {$W} q/BEGIN { $INC{$_} = 1 for qw(%s); }/, join q{ }, @inc_files or croak "Can not print to MONO file: $!"; print {$W} "\n" or croak "Can not print to MONO file: $!"; foreach my $name ( @packages ) { print {$W} qq/package $name;\nsub ________monolith {}\n/ or croak "Can not print to MONO file: $!"; } open my $TOP, '<:raw', $buffer or croak "Can not open file($buffer): $!"; while ( defined( my $line = <$TOP> ) ) { print {$W} $line or croak "Can not print to BUFFER file: $!"; } close $TOP or croak 'Can not close BUFFER file'; open my $COPY, '<:raw', $copy or croak "Can not open file($copy): $!"; while ( defined( my $line = <$COPY> ) ) { print {$W} $line or croak "Can not print to COPY file: $!"; } close $COPY or croak "Can't close COPY file: $!"; close $W or croak "Can't close MONO file: $!"; return; } sub _write_file { my($self, $mode, $file, @data) = @_; $mode = $mode . ':raw'; open my $FH, $mode, $file or croak "Can not open file($file): $!"; print {$FH} @data or croak "Can not print to FH: $!"; close $FH or croak "Can not close $file $!"; return; } sub _monolith_add_to_top { my $self = shift; my $base = shift; my $list = $self->monolith_add_to_top || croak 'monolith_add_to_top not set'; croak 'monolith_add_to_top is not an ARRAY' if ref $list ne 'ARRAY'; return grep { $_ eq $base } @{ $list }; } sub _monolith_readme { my $self = shift; (my $pod = $self->_monolith_pod_warning) =~ s{B<(.+?)>}{$1}xmsg; return $pod; } sub _monolith_pod_warning { my $self = shift; return $self->_compile_template( 'pod/monolith-warning.pod' => { module => $self->module_name, }, ); } sub _automatic_build_file_header { return shift->_compile_template( 'tools/builder.header' ); } sub _add_automatic_build_pl { my $self = shift; my $file = 'Build.PL'; return if -e $file; # do not overwrite $self->_write_file( '>', $file => $self->_automatic_build_pl ); $self->_write_file( '>>', MANIFEST => "$file\tGenerated automatically\n"); warn "ADDED AUTOMATIC $file\n"; return; } sub _automatic_build_pl { my $self = shift; my %spec = Build::Spec::spec( builder => 1 ); my $build = delete $spec{BUILDER} || croak 'SPEC does not have a BUILDER key'; my $methods = join ";\n", map { sprintf q{$mb->%s( %s )}, $_, $build->{ $_ } } keys %{ $build }; return join q{}, $self->_automatic_build_file_header, $self->_compile_template( 'tools/Build.PL' => { methods => $methods, }, ), ; } sub _add_vanilla_makefile_pl { my $self = shift; my $file = 'Makefile.PL'; return if -e $file; # don't overwrite $self->_write_file( '>', $file => $self->_vanilla_makefile_pl ); $self->_write_file( '>>', MANIFEST => "$file\tGenerated automatically\n"); warn "ADDED VANILLA $file\n"; return; } sub _vanilla_makefile_pl { my $self = shift; my $hook = $self->initialization_hook; if ( $hook ) { $hook = $self->_compile_template( 'tools/Makefile.PL.hook' => { hook => $hook, }, ), } return join q{}, $self->_automatic_build_file_header, $self->_compile_template( 'tools/Makefile.PL' => { hook => $hook || q{}, }, ), ; } sub _pod_author_copyright_license { my $self = shift; my $da = $self->dist_author; # support only 1 author for now my $cfy = $self->copyright_first_year; my $year = (localtime time)[YEAR_SLOT] + YEAR_ADD; my($author, $email) = $da->[0] =~ m{ (.+?) < (.+?) > }xms; $author = trim( $author ) if $author; $email = trim( $email ) if $email; $year = "$cfy - $year" if $cfy && $cfy != $year && $cfy < $year; return $self->_compile_template( 'pod/author.pod' => { author => $author, email => $email, year => $year, perl => sprintf( '%vd', $^V ), }, ); } sub _compile_template { my($self, $path, $param) = @_; my $full_path = File::Spec->catfile( qw( builder templates ), $path ); die "Can't locate template $path: $!" if ! -e $full_path; $param ||= {}; my $raw = slurp( $full_path ); my %p = map { uc( $_ ) => $param->{ $_ } } keys %{ $param }; my %seen; my $key_value = sub { my $match = shift; my $key = trim( $match ); my $value = $p{ $key }; if ( ! defined $value ) { if ( ! $seen{ $key }++ ) { warn "$path: Bogus or no value for template key '$key'"; } return q(); } return $value; }; $raw =~ s{[[][%](.+?)[%][]]}{$key_value->($1)}xmsge; return $raw; } 1; __END__ GD-SecurityImage-1.73/builder/lib/Build000755000765000024 012457575566 17357 5ustar00burakstaff000000000000GD-SecurityImage-1.73/builder/lib/Build/Constants.pm000444000765000024 220212457575566 22022 0ustar00burakstaff000000000000package Build::Constants; use strict; use warnings; our $VERSION = '0.80'; use base qw( Exporter ); use constant TAINT_SHEBANG => "#!perl -Tw\nuse constant TAINTMODE => 1;\n"; use constant RE_VERSION_LINE => qr{ \A (our\s+)? \$VERSION \s+ = \s+ ["'] (.+?) ['"] ; (.+?) \z }xms; use constant RE_POD_LINE => qr{ \A =head1 \s+ DESCRIPTION \s+ \z }xms; use constant VTEMP => q{%s$VERSION = '%s';}; use constant MONTHS => qw( January February March April May June July August September October November December ); use constant MONOLITH_TEST_FAIL => "\nFAILED! Building the monolithic version failed during unit testing\n\n"; use constant NO_INDEX => qw( monolithic_version builder t xt ); use constant DEFAULTS => qw( license perl create_license 1 sign 0 ); use constant YEAR_ADD => 1900; use constant YEAR_SLOT => 5; our @EXPORT_OK = qw( TAINT_SHEBANG RE_VERSION_LINE RE_POD_LINE VTEMP MONTHS MONOLITH_TEST_FAIL NO_INDEX DEFAULTS YEAR_ADD YEAR_SLOT ); our %EXPORT_TAGS = ( all => \@EXPORT_OK, ); 1; __END__ GD-SecurityImage-1.73/builder/lib/Build/Spec.pm000444000765000024 533012457575566 20745 0ustar00burakstaff000000000000package Build::Spec; use strict; use warnings; use Exporter (); use Carp qw( croak ); use constant DEFAULT_AUTHOR => 'Burak Gursoy '; use constant OS_ERROR => qr{OS \s+ unsupported}xms; use base qw( Exporter ); BEGIN { our $VERSION = '0.80'; our @EXPORT = qw( spec ); our @EXPORT_OK = qw( mm_spec ); } sub spec { my %opt = @_; my $file = 'SPEC'; my $spec = do $file; my %rv = $@ ? do { croak $@ =~ OS_ERROR ? $@ : "Couldn't parse $file: $@" } : ! defined $spec && $! ? croak "Couldn't do $file: $!" : ! $spec ? croak "$file did not return a true value" : ref($spec) ne 'HASH' ? croak "Return type of $file is not HASH" : ! $spec->{module_name} ? croak "The specification returned from $file does" .q{ not have the mandatory 'module_name' key} : %{ $spec }; ; # these needs to be set here $rv{dist_author} ||= DEFAULT_AUTHOR; $rv{recommends} ||= {}; $rv{requires} ||= {}; my $breq = $rv{build_requires} ||= {}; $breq->{'Test::More'} = '0.40' if ! exists $breq->{'Test::More'}; delete $rv{BUILDER} if ! $opt{builder}; return %rv; } sub trim { my $s = shift; return $s if ! $s; $s =~ s{ \A \s+ }{}xms; $s =~ s{ \s+ \z }{}xms; return $s; } # Makefile.PL related things sub mm_spec { my %spec = spec(); (my $file = $spec{module_name}) =~ s{::}{/}xmsg; $spec{VERSION_FROM} = "lib/$file.pm"; $spec{PREREQ_PM} = { %{ $spec{requires} }, %{ $spec{build_requires} } }; _mm_recommend( %spec ); $spec{ABSTRACT} = _mm_abstract( $spec{VERSION_FROM} ); $spec{EXE_FILES} = $spec{script_files} ? $spec{script_files} : []; return %spec; } sub _mm_recommend { my %spec = @_; return if ! $spec{recommends}; my %rec = %{ $spec{recommends} } or return; my $info = "\nRecommended Modules:\n\n"; foreach my $m ( sort keys %rec ) { $info .= sprintf "\t%s\tv%s\n", $m, $rec{$m}; } my $pok = print "$info\n"; return; } sub _mm_abstract { my $file = shift; require IO::File; my $fh = IO::File->new; $fh->open( $file, 'r' ) || croak "Can not read $file: $!"; binmode $fh; while ( my $line = <$fh> ) { chomp $line; last if $line eq '=head1 NAME'; } my $buf; while ( my $line = <$fh> ) { chomp $line; last if $line =~ m{ \A =head }xms; $buf .= $line; } $fh->close || croak "Can not close $file: $!"; croak 'Unable to get ABSTRACT' if ! $buf; $buf = trim( $buf ); my($mod, $desc) = split m{\-}xms, $buf, 2; $desc = trim( $desc ) || croak 'Unable to get ABSTRACT'; return $desc; } 1; __END__ GD-SecurityImage-1.73/builder/lib/Build/Util.pm000444000765000024 127112457575566 20770 0ustar00burakstaff000000000000package Build::Util; use strict; use warnings; use base qw( Exporter ); use Carp (); our $VERSION = '0.80'; our @EXPORT_OK = qw( slurp trim ); sub slurp { my $path = shift || Carp::croak( 'No file path specified' ); if ( ! -e $path ) { Carp::croak( "The specified file path $path does not exist" ); } open my $FH, '<', $path or Carp::croak( "Can not open file($path): $!" ); my $rv = do { local $/; <$FH> }; close $FH or Carp::croak( "Can't close($path): $!" ); return $rv; } sub trim { my($s, $extra) = @_; return $s if ! $s; $extra ||= q{}; $s =~ s{\A \s+ }{$extra}xms; $s =~ s{ \s+ \z}{$extra}xms; return $s; } 1; __END__ GD-SecurityImage-1.73/builder/templates000755000765000024 012457575566 17550 5ustar00burakstaff000000000000GD-SecurityImage-1.73/builder/templates/pod000755000765000024 012457575566 20332 5ustar00burakstaff000000000000GD-SecurityImage-1.73/builder/templates/pod/author.pod000444000765000024 52112457575566 22453 0ustar00burakstaff000000000000=head1 AUTHOR [%AUTHOR%] <[%EMAIL%]>. =head1 COPYRIGHT Copyright [%YEAR%] [%AUTHOR%]. 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 [%PERL%] or, at your option, any later version of Perl 5 you may have available. GD-SecurityImage-1.73/builder/templates/pod/monolith-warning.pod000444000765000024 35112457575566 24446 0ustar00burakstaff000000000000 B! This is the monolithic version of [%MODULE%] generated with an automatic build tool. If you experience problems with this version, please install and use the supported standard version. This version is B. GD-SecurityImage-1.73/builder/templates/tools000755000765000024 012457575566 20710 5ustar00burakstaff000000000000GD-SecurityImage-1.73/builder/templates/tools/Build.PL000444000765000024 11512457575566 22316 0ustar00burakstaff000000000000use Build; my $mb = Build->new; [%METHODS%]; $mb->create_build_script; 1; GD-SecurityImage-1.73/builder/templates/tools/builder.header000444000765000024 17212457575566 23625 0ustar00burakstaff000000000000#!/usr/bin/env perl # This file was created automatically use 5.006; use strict; use warnings; use lib qw( builder/lib ); GD-SecurityImage-1.73/builder/templates/tools/Makefile.PL000444000765000024 61612457575566 23002 0ustar00burakstaff000000000000use Build::Spec qw( mm_spec ); use ExtUtils::MakeMaker; my %spec = mm_spec; [%HOOK%] WriteMakefile( NAME => $spec{module_name}, VERSION_FROM => $spec{VERSION_FROM}, PREREQ_PM => $spec{PREREQ_PM}, PL_FILES => {}, ($] >= 5.005 ? ( AUTHOR => $spec{dist_author}, ABSTRACT => $spec{ABSTRACT}, EXE_FILES => $spec{EXE_FILES}, ) : ()), ); GD-SecurityImage-1.73/builder/templates/tools/Makefile.PL.hook000444000765000024 20512457575566 23733 0ustar00burakstaff000000000000my $eok = eval <<'THIS_IS_SOME_IDENTIFIER'; [%HOOK%] THIS_IS_SOME_IDENTIFIER die "Error compiling initialization_hook: $@\n" if $@; GD-SecurityImage-1.73/eg000755000765000024 012457575566 14517 5ustar00burakstaff000000000000GD-SecurityImage-1.73/eg/demo.pl000444000765000024 5144212457575566 16163 0ustar00burakstaff000000000000#!/usr/bin/perl -w # -> GD::SecurityImage demo program # -> Burak Gursoy (c) 2004-2012. # See the document section after "__END__" for license and other information. package Demo; use 5.006; use strict; use warnings; use CGI qw( header escapeHTML ); use Cwd; use Carp qw( croak ); use constant SALT_RANDOM => 100; use constant MAGICK_PTSIZE => 12; use constant GD_PTSIZE => 8; my %config = ( 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 pass => q{}, # database user's password font => getcwd.'/StayPuft.ttf', # ttf font. change this to an absolute path if getcwd is failing 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? program => q{}, # if CGI.pm fails to locate program url, set this value. ); # You'll need this to create the sessions table. # CREATE TABLE sessions ( id char(32) not null primary key, a_session text ) # - - - - - - - - - - - - > S T A R T P R O G R A M < - - - - - - - - - - - # our $VERSION = '1.51'; use constant REQUIREDMODS => qw( DBI DBD::mysql Apache::Session::MySQL String::Random GD::SecurityImage Time::HiRes ); BEGIN { my @errors; my $test = sub { # Storable' s [eval "use Log::Agent";] line breaks the handler, # since it is not a common module and does not exist generally... local $SIG{__DIE__}; local $@; my $mod = shift; my $eok = eval "require $mod; 1;"; push @errors, { module => $mod, error => $@ } if $@ || ! $eok; }; $test->($_) foreach REQUIREDMODS; if ( @errors ) { my $err = qq{
This demo program needs several CPAN modules to run:\n\n};
      foreach my $e ( @errors ) {
         $err .= q~[FAILED]~
               . qq~ $e->{module}: $e->{error}
~;
      }
      print header . $err . '
' or croak "Can not print to STDOUT: $!"; exit; } } my $NOT_EXISTS = quotemeta 'Object does not exist in the data store'; run() if not caller; # if you require this, you'll need to call demo::run() sub TEST_FONT_EXISTENCE { if ( not $config{use_magick} ) { if ( $config{font} =~ m{\s}xms ) { croak "The font path '$config{font}' has a space in it. GD hates spaces!"; } } require IO::File; my $FONTFILE = IO::File->new; if ( $FONTFILE->open( $config{font} ) ) { $FONTFILE->close; } else { croak qq~I can not open/find the font file in '$config{font}': $!~; } return; } sub new { TEST_FONT_EXISTENCE(); my $class = shift; my $self = { ISDISPLAY => 0, SID => undef, CPAN => 'http://search.cpan.org/dist', IS_GD => 0, }; bless $self, $class; return $self; } sub config { return \%config } sub run { local $SIG{__DIE__} = sub { print header . <<"ERROR" or croak "Can not print to STDOUT: $!";

FATAL ERROR

@_ ERROR exit; }; my $START = Time::HiRes::time(); my $self = shift || __PACKAGE__->new; GD::SecurityImage->import( use_magick => $config{use_magick} ); $self->{IS_GD} = $GD::SecurityImage::BACKEND eq 'GD'; $self->{cgi} = CGI->new; $self->{program} = $config{program}; if ( ! $self->{program} ){ # it is possible to get the url as "demo.pl??foo=bar" my $url = $self->{cgi}->can('self_url') ? $self->{cgi}->self_url : $self->{cgi}->url; ($self->{program}, my @jp) = split m{[?]}xms, $url; } my %options = $self->all_options; my %styles = $self->all_styles; my @optz = keys %options; my @styz = keys %styles; $self->{rnd_opt} = $options{ $optz[ int rand @optz ] }; $self->{rnd_sty} = $styles{ $styz[ int rand @styz ] }; # our database handle my $dbh = DBI->connect( "DBI:mysql:$config{database}", @config{ qw/ user pass / }, { RaiseError => 1, } ); my %session; my $create_ses = sub { # fetch/create session my $sid = @_ ? undef : $self->{cgi}->cookie('GDSI_ID'); tie %session, 'Apache::Session::MySQL', $sid, { ## no critic (Miscellanea::ProhibitTies) Handle => $dbh, LockHandle => $dbh, TableName => $config{table_name}, }; }; my $eok = eval { $create_ses->(); 1; }; # I'm doing a little trick to by-pass exceptions if the session id # coming from the user no longer exists in the database. # Also, I'm not validating the session key here, you can also check # IP and browser string to validate the session. # It is also possible to put a timeout value for security_code key. # But, all these and anything else are all beyond this demo... if ( $@ && $@ =~ m{ \A $NOT_EXISTS }xms ) { $create_ses->('new'); } if ( ! $session{security_code} ) { $session{security_code} = $self->_random; # initialize random code } $self->{ISDISPLAY} = $self->{cgi}->param('display') || 0; $self->{SID} = $session{_session_id}; my $output = q{}; # output buffer if ( $self->{ISDISPLAY} ) { $START = Time::HiRes::time(); my($image, $mime, $random) = $self->create_image($session{security_code}, $START ); $output = $self->myheader(type => "image/$mime"); $output .= $image; binmode STDOUT; } else { $output = $self->myheader . $self->html_head; $output .= $self->{cgi}->param('process') ? $self->process( $session{security_code} ) : $self->{cgi}->param('help') ? $self->help : $self->form(); $output .= '

' . $self->backenduri . $self->html_foot($START) . '

'; # make the code always random $session{security_code} = $self->_random; } untie %session; $dbh->disconnect; print $output or croak "Can not print to STDOUT: $!"; exit; } sub process { my $self = shift; my $ses = shift || croak 'Security_code from session is missing'; my $code = $self->{cgi}->param('code') || q{}; my $pass = $self->iseq( $code, $ses ); return $pass ? $self->_congrats( $code, $ses ) : $self->_failure( $code, $ses ) ; } sub backenduri { my $self = shift; my $rv = q{Security image generated with }; $rv .= $self->{IS_GD} ? qq~GD v$GD::VERSION~ : qq~Image::Magick v$Image::Magick::VERSION~; return $rv . ''; } sub _random { return String::Random->new->randregex('\d\d\d\d\d\d') } sub _failure { my $self = shift; my $code = CGI::escapeHTML(shift || q{}); my $ses = shift || q{}; my $rv = <<"FAIL"; '${code}' != '${ses}'
You have failed to identify yourself as a human!
FAIL $rv .= $self->form(); return $rv; } sub _congrats { my $self = shift; my $form = shift || q{}; my $ses = shift || q{}; return <<"PASS"; '$form' == '$ses'
Congratulations! You have passed the test!

Try again PASS } sub iseq { my $self = shift; my $form = shift || return; my $ses = shift || return; return if $form =~ m{\D}xms; return $form eq $ses; } sub myheader { my($self, %o) = @_; my $display = $self->{ISDISPLAY}; my $type = $o{type} ? $o{type} : $display ? 'image/'.$config{itype} : 'text/html'; my $c = $self->{cgi}->cookie( -name => 'GDSI_ID', -value => $self->{SID}, ); return $self->{cgi}->header( -type => $type, -cookie => $c ); } #--------------> FUNCTIONS <--------------# sub help { my $self = shift; return <<"HELP"; If you want to change the image generation options, open this file with a text editor and search for the %config hash. Database options are used to access to a MySQL Database Server. MySQL is used for session data storage.
Parameter Default Explanation
database gdsi The database name we will use for session storage
table_name sessions The name of the table for session storage. Only change this value, if you *really* have to use another table name. Also you must change the table generation (SQL) code.
user root Database user name
pass   Database password
font StayPuft.ttf TTF font for SecurityImage generation. Put the sample font into the same folder as this program.
itype gif Image format. You can set this to png or gif or jpeg.
use_magick FALSE False value: GD will be used; True value: Image::Magick will be used. If you use GD, please do not use a prehistoric version. The module itself is highly compatible with older versions, but this demo needs \$GD::VERSION >= 1.31
img_stat TRUE If has a true value, some statistics like "image generation" and "total execution" times will be placed on the image. The page you see this also shows that information, but image generation is an another process and we can only show the stats this way. This option uses the minimal amount of space, but if you want to cancel it just give it a false value.
program   Program url is automatically set by CGI.pm. Bu this may fail in some environments. If the url is not set, you can not see the image. Set this to the actual program url if there is a problem.
HELP } sub form { my $self = shift; # by-pass browser cache with this random fake value my $salt = '&salt=' . $$ . time . rand SALT_RANDOM; return <<"FORM";
Enter the security code:
to identify yourself as a human
 Security Image
FORM } sub html_head { my $self = shift; return <<"HTML_HEAD"; GD::SecurityImage v$GD::SecurityImage::VERSION - DEMO v$VERSION

GD::SecurityImage v$GD::SecurityImage::VERSION - DEMO v$VERSION

HTML_HEAD } sub html_foot { my $self = shift; my $START = shift; my $bench = sprintf 'Execution time: %.3f seconds', Time::HiRes::time() - $START; return <<"HTML_FOOTER"; | \$CPAN/Burak Gürsoy | $bench | ? HTML_FOOTER } sub create_image { # create a security image with random options and styles my $self = shift; my $code = shift; my $START = shift; my $s = $self->{rnd_sty}; my $i = GD::SecurityImage->new( lines => $s->{lines}, bgcolor => $s->{bgcolor}, %{ $self->{rnd_opt} }, ); $i->random ($code) ->create (ttf => $s->{name}, $s->{text_color}, $s->{line_color}) ->particle($s->{dots} ? ($s->{particle}, $s->{dots}) : ($s->{particle}) ); if ($i->gdbox_empty) { croak qq~An error occurred while opening the font file '$config{font}'. ~ .qq~Please set font option to an "exact" path, not relative. Error: $@~; } if ($config{img_stat}) { $i->info_text( x => 'right', y => 'up', gd => 1, strip => 1, color => '#000000', scolor => '#FFFFFF', # low-level access to an object table is not a good thing, # since the author can change/delete it without notification # in later releases ;) ptsize => $i->{IS_MAGICK} ? MAGICK_PTSIZE : GD_PTSIZE, text => sprintf('Security Image generated at %.3f seconds', Time::HiRes::time() - $START), ); } my @image = $i->out(force => $config{itype}); return @image; } # below is taken from the test api "tapi" sub all_options { my $self = shift; my %gd = ( gd_ttf => { width => 220, height => 90, send_ctobg => 1, font => $config{font}, ptsize => 30, }, gd_ttf_scramble => { width => 360, height => 110, send_ctobg => 1, font => $config{font}, ptsize => 25, scramble => 1, }, gd_ttf_scramble_fixed => { width => 360, height => 90, send_ctobg => 1, font => $config{font}, ptsize => 25, scramble => 1, angle => 30, }, ); my %magick = ( magick => { width => 250, height => 100, send_ctobg => 1, font => $config{font}, ptsize => 50, }, magick_scramble => { width => 350, height => 100, send_ctobg => 1, font => $config{font}, ptsize => 30, scramble => 1, }, magick_scramble_fixed => { width => 350, height => 80, send_ctobg => 1, font => $config{font}, ptsize => 30, scramble => 1, angle => 32, }, ); return $self->{IS_GD} ? (%gd) : (%magick); } sub all_styles { ## no critic (ValuesAndExpressions::ProhibitMagicNumbers) return ec => { name => 'ec', lines => 16, bgcolor => [ 0, 0, 0], text_color => [84, 207, 112], line_color => [ 0, 0, 0], particle => 1000, }, ellipse => { name => 'ellipse', lines => 15, bgcolor => [208, 202, 206], text_color => [184, 20, 180], line_color => [184, 20, 180], particle => 2000, }, circle => { name => 'circle', lines => 40, bgcolor => [210, 215, 196], text_color => [ 63, 143, 167], line_color => [210, 215, 196], particle => 3500, }, box => { name => 'box', lines => 6, text_color => [245, 240, 220], line_color => [115, 115, 115], particle => 3000, dots => 2, }, rect => { name => 'rect', lines => 30, text_color => [ 63, 143, 167], line_color => [226, 223, 169], particle => 2000, }, default => { name => 'default', lines => 10, text_color => [ 68, 150, 125], line_color => [255, 0, 0], particle => 5000, }, ; } 1; __END__ =pod =encoding utf8 =head1 NAME demo.pl - GD::SecurityImage demo program. =head1 SYNOPSIS This is a CGI program. Run from web. =head1 DESCRIPTION This program demonstrates the abilities of C. It needs these CPAN modules: DBI DBD::mysql Apache::Session::MySQL String::Random GD::SecurityImage (with GD or Image::Magick) and these CORE modules: CGI Cwd Time::HiRes Also, be sure to use recent versions of GD. This demo needs at least version C<1.31> of GD. And if you want to use C it must be C<6.0.4> or newer. You'll also need a MySQL server to run the program. You must create a table with this SQL code: CREATE TABLE sessions ( id char(32) not null primary key, a_session text ); If you want to use another table name (not C), set the C<$config{table_name}> to the value you want and also modify the C code above. With the default configuration option, this program assumes that you have a database named C. Change this option to the database name you want to use. Security images are generated with the sample ttf font "StayPuft.ttf". Put it into the same folder as this program or alter C<$config{font}> value. If you want to use another font file, you may need to alter the image generation options (see the C<%config> hash on top of the program code). =begin html

DEMO SCREENSHOTS

Here are some sample screen shots showing this demo in action.


Enter demo.pl


Validation Failed


Validation Succeeded

=end html =begin html

All images in this document are generously hosted by ImageShack

=end html =head1 CAVEAT EMPTOR Note that, this is only a demo. Use at your own risk! =over 4 =item * No security checks are performed. =item * This demo may not be secure or memory friendly. =item * You don't have to use the bundled sample font. If you don't like it, just use some other font that you like, but be sure to adjust several parameters for a I graphic. =item * There are several pre-defined I<"styles"> for generating images. You can create your own style(s) playing with the parameters. =item * Do B use this demo's code as a base for your application. Your own implementation will probably be much more cleaner and shorter. This demo includes dirty and undocumented code! =back =head1 SEE ALSO L. =head1 AUTHOR Burak GE<252>rsoy, EburakE<64>cpan.orgE =head1 COPYRIGHT Copyright 2004-2012 Burak Gürsoy. All rights reserved. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut GD-SecurityImage-1.73/lib000755000765000024 012457575566 14672 5ustar00burakstaff000000000000GD-SecurityImage-1.73/lib/GD000755000765000024 012457575566 15164 5ustar00burakstaff000000000000GD-SecurityImage-1.73/lib/GD/SecurityImage.pm000444000765000024 12753312457575566 20504 0ustar00burakstaff000000000000package GD::SecurityImage; use strict; use warnings; use vars qw[@ISA $VERSION $BACKEND]; use GD::SecurityImage::Styles; use Carp qw(croak); use constant RGB_WHITE => ( 255, 255, 255 ); use constant RGB_BLACK => ( 0, 0, 0 ); use constant RANDOM_DATA => ( 0..9 ); use constant FULL_CIRCLE => 360; use constant DEFAULT_ANGLES => (0,5,8,15,22,26,29,33,35,36,40,43,45,53,56); use constant DEFAULT_WIDTH => 80; use constant DEFAULT_HEIGHT => 30; use constant DEFAULT_PTSIZE => 20; use constant DEFAULT_LINES => 10; use constant MAX_RGB_VALUE => 255; use constant PARTICLE_MULTIPLIER => 20; use constant MAX_RGB_PARAMS => 3; $VERSION = '1.73'; sub import { my($class, @args) = @_; my %opt = @args % 2 ? () : @args; # init/reset globals $BACKEND = q{}; # name of the back-end @ISA = (); ## no critic (ClassHierarchies::ProhibitExplicitISA) # 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__.q{::}.$opt{backend}; my $eok = eval "require $be"; croak "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, ## no critic (ClassHierarchies::ProhibitExplicitISA) qw(GD::SecurityImage::Styles); # load styles return; } sub new { my($class, @args) = @_; $BACKEND || croak "You didn't import $class!"; my %opt = @args % 2 ? () : @args; 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_ => q{}, # 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 = $self->_new_options( %opt ); 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} = FULL_CIRCLE + $self->{angle} if $self->{angle} < 0; if ( $self->{angle} > FULL_CIRCLE ) { croak '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_} }, DEFAULT_ANGLES; # push negatives push @{ $self->{_ANGLES_} }, map {FULL_CIRCLE - $_} @{ $self->{_ANGLES_} }; } } $self->init; return $self; } sub _new_options { my($self, %opt) = @_; my %options = ( width => $opt{width} || DEFAULT_WIDTH, height => $opt{height} || DEFAULT_HEIGHT, ptsize => $opt{ptsize} || DEFAULT_PTSIZE, lines => $opt{lines} || DEFAULT_LINES, rndmax => $opt{rndmax} || $self->{_RNDMAX_}, rnd_data => $opt{rnd_data} || [ RANDOM_DATA ], font => $opt{font} || q{}, gd_font => $self->gdf($opt{gd_font}) || q{}, bgcolor => $opt{bgcolor} || [ RGB_WHITE ], 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 ); return %options; } sub backends { my $self = shift; my $class = ref($self) || $self; my(@list, @dir_list); require Symbol; foreach my $inc (@INC) { my $dir = "$inc/GD/SecurityImage"; next unless -d $dir; my $DIR = Symbol::gensym(); opendir $DIR, $dir or croak "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{ \A [.] }xms; next if $file =~ m{ \A (Styles|AC|Handler)[.]pm \z}xms; $file =~ s{ [.]pm \z}{}xms; push @list, $file; } } return @list if defined wantarray; my $report = "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; print $report or croak "Unable to print to STDOUT: $!"; return; } sub gdf { my($self, @args) = @_; return if not $self->{IS_GD}; return $self->gdfx( @args ); } 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 { return 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 defined wantarray ? $self : undef; } sub cconvert { # convert color codes # GD : return color index number # Image::Magick: return hex color code my $self = shift; my $data = shift || croak 'Empty parameter passed to cconvert'; 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; my $color_code = $data && ! $is_hex && ! ref($data) && $data !~ m{[^0-9]}xms && $data >= 0; if( $color_code ) { if ( $self->{IS_MAGICK} ) { croak "The number '$data' can not be transformed to a color code!"; } # 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); return @rgb && $self->{IS_MAGICK} ? $data : $self->_cconvert_new( $data, @rgb ); } sub _cconvert_new { my($self, $data, @rgb) = @_; $data = [@rgb] if @rgb; # initialize if not valid if(! $data || ! ref $data || ref $data ne 'ARRAY' || $#{$data} != 2) { $data = [0, 0, 0]; } foreach my $i (0..$#{$data}) { # check for bad values if ( $data->[$i] > MAX_RGB_VALUE || $data->[$i] < 0 ) { $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 if ( not $self->{IS_MAGICK} ) { $method = 'normal' if $self->_versionlt( '1.20' ); } if ( $method eq 'normal' && ! $self->{gd_font} ) { $self->{gd_font} = $self->gdf('giant'); } $style = $self->can('style_'.$style) ? 'style_'.$style : 'style_default'; $self->$style() if not $self->{send_ctobg}; $self->insert_text($method); $self->$style() if $self->{send_ctobg}; if ( $self->{frame} ) { # put a frame around the image my $w = $self->{width} - 1; my $h = $self->{height} - 1; $self->rectangle( 0, 0, $w, $h, $self->{_COLOR_}{lines} ); } $self->{_CREATECALLED_}++; return defined wantarray ? $self : undef; } sub particle { # Create random dots. They'll cover all over the surface my $self = shift; croak q{particle() must be called 'after' create()} if !$self->{_CREATECALLED_}; my $big = $self->{height} > $self->{width} ? $self->{height} : $self->{width}; my $f = shift || $big * PARTICLE_MULTIPLIER; # particle density my $dots = shift || 1; # number of multiple dots my $int = int $big / PARTICLE_MULTIPLIER; if ( ! $int ) { # RT#33629 warn "particle(): image dimension is so small to add particles\n"; return; } my @random; for (my $x = $int; $x <= $big; $x += $int) { ## no critic (ControlStructures::ProhibitCStyleForLoops) push @random, $x; } my $tc = $self->{_COLOR_}{text}; my $len = @random; my $r = sub { $random[ int rand $len ] }; for ( 1..$f ) { my $x = int rand $self->{width}; my $y = int rand $self->{height}; foreach my $z (1..$dots) { $self->setPixel($x + $z , $y + $z , $tc); $self->setPixel($x + $z + $r->(), $y + $z + $r->(), $tc); } } undef @random; undef $r; return defined wantarray ? $self : undef; } sub raw { return 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, @args) = @_; croak q{info_text() must be called 'after' create()} if ! $self->{_CREATECALLED_}; my %o = @args % 2 ? () : ( qw/ x right y up strip 1 /, @args ); return if not %o; $self->{_TEXT_LOCATION_}{_place_} = 1; $o{scolor} = $self->cconvert($o{scolor}) if $o{scolor}; my %restore = ( random => $self->{_RANDOM_NUMBER_}, color => $self->{_COLOR_}{text}, ptsize => $self->{ptsize}, scramble => $self->{scramble}, angle => $self->{angle}, ); $self->{_RANDOM_NUMBER_} = delete $o{text} if $o{text}; $self->{_COLOR_}{text} = $self->cconvert(delete $o{color}) if $o{color}; $self->{ptsize} = delete $o{ptsize} if $o{ptsize}; $self->{scramble} = 0; # disable. we need a straight text $self->{angle} = 0; # disable. RT:14618 $self->{_TEXT_LOCATION_}->{$_} = $o{$_} foreach keys %o; $self->insert_text('ttf'); # restore $self->{_RANDOM_NUMBER_} = $restore{random}; $self->{_COLOR_}{text} = $restore{color}; $self->{ptsize} = $restore{ptsize}; $self->{scramble} = $restore{scramble}; $self->{angle} = $restore{angle}; return $self; } #--------------------[ PRIVATE ]--------------------# sub add_strip { # adds a strip to the background of the text my($self, $x, $y, $box_w, $box_h) = @_; my $tl = $self->{_TEXT_LOCATION_}; my $c = $self->{_COLOR_} || {}; my $black = $self->cconvert( $c->{text} ? $c->{text} : [ RGB_BLACK ] ); my $white = $self->cconvert( $tl->{scolor} ? $tl->{scolor} : [ RGB_WHITE ] ); 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'; my $h = $self->{height}; $i->filledRectangle($up ? ($x-1, 0, $x2, $y+1) : ($x-1, $y2-1, $x2 , $h ), $black); $i->filledRectangle($up ? ($x , 1, $x2-2, $y) : ($x , $y2 , $x2-2, $h-2), $white); return; } sub r2h { # Convert RGB to Hex my($self, @args) = @_; return if @args != MAX_RGB_PARAMS; my $color = q{#}; $color .= sprintf '%02x', $_ foreach @args; return $color; } sub h2r { # Convert Hex to RGB my $self = shift; my $color = shift; return if ref $color; my @rgb = $color =~ m/\A \#([a-f0-9]{2})([a-f0-9]{2})([a-f0-9]{2}) \z/xmsi; return @rgb ? map { hex $_ } @rgb : undef; } sub is_hex { my $self = shift; my $data = shift; return $data =~ m/ \A \#([a-f0-9]{2})([a-f0-9]{2})([a-f0-9]{2}) \z /xmsi; } 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 This document describes version C<1.73> of C released on C<21 January 2015>. 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. But there are some I for several Perl FrameWorks. If you are an user of one of these frameworks, see L in L section for information. =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 parameter. 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 parameter. This parameter 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. =item B Draws nothing. See L. =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 information 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 parameter 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 useful, 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. =head2 add_strip =head2 cconvert =head2 gdf =head2 h2r =head2 is_hex =head2 r2h =head2 random_angle =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 _versiongt backend version is greater or equal to supplied param? _versionlt backend version is smaller than supplied param? 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 parameters 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. =begin html

IMAGE SAMPLES

All TTF samples generated with the bundled font StayPuft.ttf, unless stated otherwise. Most of the samples here can be generated with running the test suite that comes with the GD::SecurityImage distribution. However, images that are generated with random angles will indeed be a little different after you run the test suite on your system.

All random codes have a length of six (6) characters, unless stated otherwise. So, (for example) there is no clipping in ELLIPS.


Images generated with GD

 
Standard interface. Font: gdGiantFont Style: rect
 
Style: rect. Scrambled with random angles. Style: circle. Scrambled with a fixed angle.
 
Style: default. Scrambled with a fixed angle.
Info text at the top right.		 Style: circle. Scrambled with random angles.
Font is: Transformers.ttf

 


Images generated with Image::Magick

 
Style: circle. Style: box. Scrambled with random angles.
 
Style: circle. Scrambled with a fixed angle. Style: ellipse. Scrambled with a fixed angle.
Info text at the top right.
 
Style: ec. Scrambled with random angles.
Info text at the top right.		 Style: ec. Scrambled with random angles1.

1: This image is generated with this code:

use GD::SecurityImage backend => 'Magick';
my($data, $mime, $rnd) = GD::SecurityImage
->new(
   width      => 420,
   height     => 100,
   ptsize     => 40,
   lines      => 20,
   thickness  => 4,
   rndmax     => 5,
   scramble   => 1,
   send_ctobg => 1,
   bgcolor    => '#009999',
   font       => 'StayPuft.ttf',
)
->random('BURAK')
->create( qw/ ttf ec #0066CC #0066CC / )
->particle(300, 500)
->out;

Images hosted by ImageShack.

=end html =head2 OTHER USES C drawing capabilities can also be used for I generation or displaying arbitrary messages: use CGI qw(header); use GD::SecurityImage 1.64; # we need the "blank" style my $font = "StayPuft.ttf"; my $rnd = "10.257"; # counter data my $image = GD::SecurityImage->new( width => 140, height => 75, ptsize => 30, rndmax => 1, # keeping this low helps to display short strings frame => 0, # disable borders font => $font, ); $image->random( $rnd ); # use the blank style, so that nothing will be drawn # to distort the image. $image->create( ttf => 'blank', '#CC8A00' ); $image->info_text( text => 'You are visitor number', ptsize => 10, strip => 0, color => '#0094CC', ); $image->info_text( text => '( c ) 2 0 0 7 m y s i t e', ptsize => 10, strip => 0, color => '#d7d7d7', y => 'down', ); my($data, $mime, $random) = $image->out; binmode STDOUT; print header -type => "image/$mime"; print $data; =begin html

The generated graphic will be:

Image Hosted by ImageShack.us

Image hosted by ImageShack.

=end html =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 See the L section if you have a bug or request to report. =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 =head2 Other CAPTCHA Implementations & Perl Modules =over 4 =item * L, L =item * L, L. =item * C Perl Module (commercial): L. =item * The CAPTCHA project: L. =item * A definition of CAPTCHA (From Wikipedia, the free encyclopedia): L. =item * L: A Perl interface to I free captcha service. I also offers I