From 44cf8ec67278bd1ab6c7f83a9993f7a5686a9541 Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sat, 9 Mar 2024 01:06:44 +0100 Subject: Adding upstream version 0.23.93. Signed-off-by: Daniel Baumann --- perl/COPYING.LIB | 504 +++++ perl/Changes | 51 + perl/MANIFEST | 26 + perl/MANIFEST.SKIP | 4 + perl/Makefile.PL | 64 + perl/README | 38 + perl/ZBar.pm | 216 ++ perl/ZBar.xs | 869 ++++++++ perl/ZBar/Image.pod | 145 ++ perl/ZBar/ImageScanner.pod | 103 + perl/ZBar/Processor.pod | 157 ++ perl/ZBar/Symbol.pod | 179 ++ perl/examples/paginate.pl | 71 + perl/examples/processor.pl | 35 + perl/examples/read_one.pl | 29 + perl/examples/scan_image.pl | 37 + perl/inc/Devel/CheckLib.pm | 350 +++ perl/ppport.h | 5097 +++++++++++++++++++++++++++++++++++++++++++ perl/t/Decoder.t | 111 + perl/t/Image.t | 186 ++ perl/t/Processor.t | 140 ++ perl/t/Scanner.t | 23 + perl/t/ZBar.t | 68 + perl/t/barcode.png | Bin 0 -> 1182 bytes perl/t/pod-coverage.t | 12 + perl/t/pod.t | 12 + perl/typemap | 66 + 27 files changed, 8593 insertions(+) create mode 100644 perl/COPYING.LIB create mode 100644 perl/Changes create mode 100644 perl/MANIFEST create mode 100644 perl/MANIFEST.SKIP create mode 100644 perl/Makefile.PL create mode 100644 perl/README create mode 100644 perl/ZBar.pm create mode 100644 perl/ZBar.xs create mode 100644 perl/ZBar/Image.pod create mode 100644 perl/ZBar/ImageScanner.pod create mode 100644 perl/ZBar/Processor.pod create mode 100644 perl/ZBar/Symbol.pod create mode 100755 perl/examples/paginate.pl create mode 100755 perl/examples/processor.pl create mode 100755 perl/examples/read_one.pl create mode 100755 perl/examples/scan_image.pl create mode 100644 perl/inc/Devel/CheckLib.pm create mode 100644 perl/ppport.h create mode 100755 perl/t/Decoder.t create mode 100755 perl/t/Image.t create mode 100755 perl/t/Processor.t create mode 100755 perl/t/Scanner.t create mode 100755 perl/t/ZBar.t create mode 100644 perl/t/barcode.png create mode 100644 perl/t/pod-coverage.t create mode 100644 perl/t/pod.t create mode 100644 perl/typemap (limited to 'perl') diff --git a/perl/COPYING.LIB b/perl/COPYING.LIB new file mode 100644 index 0000000..5ab7695 --- /dev/null +++ b/perl/COPYING.LIB @@ -0,0 +1,504 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 51 Franklin Street, 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. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. + + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it becomes +a de-facto standard. To achieve this, non-free programs must be +allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. + + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete 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 License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + 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. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser 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 Library +specifies a version number of this 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 Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +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 + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "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 +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. 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 LIBRARY 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 +LIBRARY (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 LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. 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) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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 + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; 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. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random Hacker. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! + + diff --git a/perl/Changes b/perl/Changes new file mode 100644 index 0000000..6707766 --- /dev/null +++ b/perl/Changes @@ -0,0 +1,51 @@ +Revision history for Perl extension Barcode::ZBar. + +0.10 2022-02-08 Official Release to CPAN + * Barcode::ZBar 0.10 update version + +0.09 2022-02-08 + * bdf1a10 Barcode::ZBar 0.09 update version and Changes + * 08ac997 Barcode::ZBar fix test + +0.08 2022-02-07 + * 0a2fa55 Barcode::ZBar update version for release + * 889cc66 perl skip more tests if DISPLAY not set and set prereqs in Makefile.PL + * c77594e Barcode::ZBar Update Changes and Increment Version + +0.07 2022-02-06 + * d0428ef Barcode::ZBar - Image::Magick not installed skip 3 more tests + * 576355e Fixes rt.cpan.org 122061 - test fails when DISPLAY not set + * e9a0cf2 Update Barcode::ZBar Changes + +0.06 2022-02-06 + * 93564a5 Add provides and min-perl version to meta files + * b01a86f perl module Increment version for cpan release and update changes + +0.05 2022-02-05 - Updates from mchehab/zbar + * 0d1d582 perl some packaging improvements + * 5b3c33d Enforce a coding style + * 2b841d5 Update ZBar's main URL location + * d1397ff Fix typos found by codespell. + * edcf08b Add support for using versions with major.minor.patch + * cd5b63e Update to the very latest version of zbar + +current spadix + * add Symbol orientation and Decoder direction interfaces + +0.04 2009-10-23 spadix + * add result query interfaces to ImageScanner and Processor + +0.03 2009-09-24 spadix + * add support for binary symbol data + * fix symbol leaks + * add symbol quality metric + * add support for QR Code + +0.02 2009-04-16 spadix + * project name change: package becomes Barcode::ZBar + +0.01 2009-02-28 spadix + * add Barcode:: namespace prefix + * add a few new/missing APIs + * add most documentation + * first draft: Processor, Scanner and Decoder basic function diff --git a/perl/MANIFEST b/perl/MANIFEST new file mode 100644 index 0000000..8be0421 --- /dev/null +++ b/perl/MANIFEST @@ -0,0 +1,26 @@ +Changes +COPYING.LIB +examples/paginate.pl +examples/processor.pl +examples/read_one.pl +examples/scan_image.pl +inc/Devel/CheckLib.pm +Makefile.PL +MANIFEST This list of files +ppport.h +README +t/barcode.png +t/Decoder.t +t/Image.t +t/pod-coverage.t +t/pod.t +t/Processor.t +t/Scanner.t +t/ZBar.t +typemap +ZBar.pm +ZBar.xs +ZBar/Image.pod +ZBar/ImageScanner.pod +ZBar/Processor.pod +ZBar/Symbol.pod diff --git a/perl/MANIFEST.SKIP b/perl/MANIFEST.SKIP new file mode 100644 index 0000000..a888bf9 --- /dev/null +++ b/perl/MANIFEST.SKIP @@ -0,0 +1,4 @@ +MANIFEST.bak +MANIFEST.SKIP +MYMETA.* +^Makefile$ diff --git a/perl/Makefile.PL b/perl/Makefile.PL new file mode 100644 index 0000000..3a4ddf0 --- /dev/null +++ b/perl/Makefile.PL @@ -0,0 +1,64 @@ +use 5.006; +use ExtUtils::MakeMaker; + +use lib qw(inc); +use Devel::CheckLib; + +check_lib_or_exit( + lib => 'zbar', + header => 'zbar.h', + LIBS => join(' ', map({ /^LIBS=(.*)/; $1 } grep(/^LIBS=/, @ARGV))), + INC => join(' ', map({ /^INC=(.*)/; $1 } grep(/^INC=/, @ARGV))), +); + +WriteMakefile( + NAME => 'Barcode::ZBar', + VERSION_FROM => "ZBar.pm", + ABSTRACT_FROM => "ZBar.pm", + AUTHOR => 'Jeff Brown ', + LICENSE => 'lgpl_2_1', + LIBS => ['-lzbar'], + MIN_PERL_VERSION => '5.006', + META_MERGE => { + "meta-spec" => { + version => '2', + url => 'https://metacpan.org/pod/CPAN::Meta::Spec', + }, + prereqs => { + build => { + requires => { + 'Test::More' => 0, + }, + }, + test => { + recommends => { + 'Image::Magick' => 0, + }, + }, + develop => { + recommends => { + 'Test::Pod::Coverage' => 0, + 'Test::Pod' => 0, + }, + } + }, + resources => { + homepage => 'https://metacpan.org/pod/Barcode::ZBar/', + repository => { + type => 'git', + url => 'https://github.com/mchehab/zbar.git', + web => 'https://github.com/mchehab/zbar', + } + }, + provides => { + 'Barcode::ZBar' => { + file => 'ZBar.pm', + version => '0.10', + }, + 'Barcode::ZBar::Error' => { + file => 'ZBar.pm', + version => '0.10', + }, + } + }, +); diff --git a/perl/README b/perl/README new file mode 100644 index 0000000..85758fd --- /dev/null +++ b/perl/README @@ -0,0 +1,38 @@ +Barcode::ZBar Perl module +========================= + +ZBar Bar Code Reader is an open source software suite for reading bar +codes from various sources, such as video streams, image files and raw +intensity sensors. It supports EAN-13/UPC-A, UPC-E, EAN-8, Code 128, +Code 93, Code 39, Codabar, Interleaved 2 of 5 and QR Code. These are +the Perl bindings for the library. + +Check the ZBar project home page for the latest release, mailing +lists, etc. + https://github.com/mchehab/zbar + + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + + +DEPENDENCIES + +This module requires the ZBar Bar Code Reader, which may be obtained +from: + + https://github.com/mchehab/zbar + + +COPYRIGHT AND LICENCE + +Licensed under the GNU Lesser General Public License, version 2.1. +http://www.gnu.org/licenses/old-licenses/lgpl-2.1.txt + +Copyright 2008-2010 (c) Jeff Brown diff --git a/perl/ZBar.pm b/perl/ZBar.pm new file mode 100644 index 0000000..c9c474e --- /dev/null +++ b/perl/ZBar.pm @@ -0,0 +1,216 @@ +#------------------------------------------------------------------------ +# Copyright 2008-2010 (c) Jeff Brown +# +# This file is part of the ZBar Bar Code Reader. +# +# The ZBar Bar Code Reader is free software; you can redistribute it +# and/or modify it under the terms of the GNU Lesser Public License as +# published by the Free Software Foundation; either version 2.1 of +# the License, or (at your option) any later version. +# +# The ZBar Bar Code Reader 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 Lesser Public License for more details. +# +# You should have received a copy of the GNU Lesser Public License +# along with the ZBar Bar Code Reader; if not, write to the Free +# Software Foundation, Inc., 51 Franklin St, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# http://sourceforge.net/projects/zbar +#------------------------------------------------------------------------ +package Barcode::ZBar; + +use 5.006; +use strict; +use warnings; +use Carp; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(SPACE BAR + version increase_verbosity set_verbosity); + +our $VERSION = '0.10'; + +require XSLoader; +XSLoader::load('Barcode::ZBar', $VERSION); + +package Barcode::ZBar::Error; + +use overload '""' => sub { return($_[0]->error_string()) }; + +1; +__END__ + + +=head1 NAME + +Barcode::ZBar - Perl interface to the ZBar Barcode Reader + + +=head1 SYNOPSIS + +setup: + + use Barcode::ZBar; + + my $reader = Barcode::ZBar::Processor->new(); + $reader->init(); + $reader->set_data_handler(\&my_handler); + +scan an image: + + my $image = Barcode::ZBar::Image->new(); + $image->set_format('422P'); + $image->set_size(114, 80); + $image->set_data($raw_bits); + $reader->process_image($image); + +scan from video: + + $reader->set_visible(); + $reader->set_active(); + $reader->user_wait(); + +collect results: + + my @symbols = $image->get_symbols(); + foreach my $sym (@symbols) { + print("decoded: " . $sym->get_type() . ":" . $sym->get_data()); + } + + +=head1 DESCRIPTION + +The ZBar Bar Code Reader is a library for scanning and decoding bar +codes from various sources such as video streams, image files or raw +intensity sensors. It supports EAN-13/UPC-A, UPC-E, EAN-8, Code 128, +Code 93, Code 39, Codabar, Interleaved 2 of 5 and QR Code. + +These are the bindings for interacting directly with the library from +Perl. + + +=head1 REFERENCE + +=head2 Functions + +=over 4 + +=item version() + +Returns the version of the zbar library as "I.I". + +=item increase_verbosity() + +Increases global library debug by one level. + +=item set_verbosity(I) + +Sets global library debug to the indicated level. Higher numbers give +more verbosity. + +=item parse_config(I) + +Parse a decoder configuration setting into a list containing the +symbology constant, config constant, and value to set. See the +documentation for C/C for available configuration +options. + +=back + +=head2 Constants + +Width stream "color" constants: + +=over 4 + +=item SPACE + +Light area or space between bars. + +=item BAR + +Dark area or colored bar segment. + +=back + +Decoder configuration constants: + +=over 4 + +=item Config::ENABLE + +=item Config::ADD_CHECK + +=item Config::EMIT_CHECK + +=item Config::ASCII + +=item Config::MIN_LEN + +=item Config::MAX_LEN + +=item Config::POSITION + +=item Config::X_DENSITY + +=item Config::Y_DENSITY + +=back + +Symbology modifier constants: + +=over 4 + +=item Modifier::GS1 + +=item Modifier::AIM + +=back + +Symbol orientation constants: + +=over 4 + +=item Orient::UNKNOWN + +=item Orient::UP + +=item Orient::RIGHT + +=item Orient::DOWN + +=item Orient::LEFT + +=back + + +=head1 SEE ALSO + +Barcode::ZBar::Processor, Barcode::ZBar::ImageScanner, +Barcode::ZBar::Image, Barcode::ZBar::Symbol, +Barcode::ZBar::Scanner, Barcode::ZBar::Decoder + +zbarimg(1), zbarcam(1) + +http://zbar.sf.net + + +=head1 AUTHOR + +Jeff Brown, Espadix@users.sourceforge.netE + + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008-2010 (c) Jeff Brown Espadix@users.sourceforge.netE + +The ZBar Bar Code Reader is free software; you can redistribute it +and/or modify it under the terms of the GNU Lesser Public License as +published by the Free Software Foundation; either version 2.1 of +the License, or (at your option) any later version. + +=cut diff --git a/perl/ZBar.xs b/perl/ZBar.xs new file mode 100644 index 0000000..0e340f6 --- /dev/null +++ b/perl/ZBar.xs @@ -0,0 +1,869 @@ +//------------------------------------------------------------------------ +// Copyright 2008-2010 (c) Jeff Brown +// +// This file is part of the ZBar Bar Code Reader. +// +// The ZBar Bar Code Reader is free software; you can redistribute it +// and/or modify it under the terms of the GNU Lesser Public License as +// published by the Free Software Foundation; either version 2.1 of +// the License, or (at your option) any later version. +// +// The ZBar Bar Code Reader 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 Lesser Public License for more details. +// +// You should have received a copy of the GNU Lesser Public License +// along with the ZBar Bar Code Reader; if not, write to the Free +// Software Foundation, Inc., 51 Franklin St, Fifth Floor, +// Boston, MA 02110-1301 USA +// +// http://sourceforge.net/projects/zbar +//------------------------------------------------------------------------ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include "ppport.h" + +#include + +typedef zbar_symbol_t *Barcode__ZBar__Symbol; +typedef zbar_image_t *Barcode__ZBar__Image; +typedef zbar_processor_t *Barcode__ZBar__Processor; +typedef zbar_video_t *Barcode__ZBar__Video; +typedef zbar_window_t *Barcode__ZBar__Window; +typedef zbar_image_scanner_t *Barcode__ZBar__ImageScanner; +typedef zbar_decoder_t *Barcode__ZBar__Decoder; +typedef zbar_scanner_t *Barcode__ZBar__Scanner; +typedef void *Barcode__ZBar__Error; + +typedef unsigned long fourcc_t; +typedef int timeout_t; +typedef int config_error; + +typedef struct handler_wrapper_s { + SV *instance; + SV *handler; + SV *closure; +} handler_wrapper_t; + + +static AV *LOOKUP_zbar_color_t = NULL; +static AV *LOOKUP_zbar_symbol_type_t = NULL; +static AV *LOOKUP_zbar_error_t = NULL; +static AV *LOOKUP_zbar_config_t = NULL; +static AV *LOOKUP_zbar_modifier_t = NULL; +static AV *LOOKUP_zbar_orientation_t = NULL; + +#define CONSTANT(typ, prefix, sym, name) \ + do { \ + SV *c = newSViv(ZBAR_ ## prefix ## sym); \ + sv_setpv(c, name); \ + SvIOK_on(c); \ + newCONSTSUB(stash, #sym, c); \ + av_store(LOOKUP_zbar_ ## typ ## _t, \ + ZBAR_ ## prefix ## sym, \ + SvREFCNT_inc(c)); \ + } while(0) + +#define LOOKUP_ENUM(typ, val) \ + lookup_enum(LOOKUP_zbar_ ## typ ## _t, val) + +static inline SV *lookup_enum (AV *lookup, int val) +{ + SV **tmp = av_fetch(lookup, val, 0); + return((tmp) ? *tmp : sv_newmortal()); +} + +static inline void check_error (int rc, void *obj) +{ + if(rc < 0) { + sv_setref_pv(get_sv("@", TRUE), "Barcode::ZBar::Error", obj); + croak(NULL); + } +} + +#define PUSH_SYMS(x) \ + do { \ + const zbar_symbol_t *sym = (const zbar_symbol_t*)(x); \ + for(; sym; sym = zbar_symbol_next(sym)) { \ + zbar_symbol_t *s = (zbar_symbol_t*)sym; \ + zbar_symbol_ref(s, 1); \ + XPUSHs(sv_setref_pv(sv_newmortal(), "Barcode::ZBar::Symbol", \ + (void*)sym)); \ + } \ + } while(0); + +#define PUSH_ENUM_MASK(typ, TYP, val) \ + do { \ + unsigned mask = (val); \ + int i; \ + for(i = 0; i < ZBAR_ ## TYP ## _NUM; i++, mask >>= 1) \ + if(mask & 1) \ + XPUSHs(LOOKUP_ENUM(typ, i)); \ + } while(0); + +static void image_cleanup_handler (zbar_image_t *image) +{ + SV *data = zbar_image_get_userdata(image); + if(!data) + /* FIXME this is internal error */ + return; + + /* release reference to cleanup data */ + SvREFCNT_dec(data); +} + +static inline int set_handler (handler_wrapper_t **wrapp, + SV *instance, + SV *handler, + SV *closure) +{ + handler_wrapper_t *wrap = *wrapp; + if(!handler || !SvOK(handler)) { + if(wrap) { + if(wrap->instance) SvREFCNT_dec(wrap->instance); + if(wrap->handler) SvREFCNT_dec(wrap->handler); + if(wrap->closure) SvREFCNT_dec(wrap->closure); + wrap->instance = wrap->handler = wrap->closure = NULL; + } + return(0); + } + + if(!wrap) { + Newxz(wrap, 1, handler_wrapper_t); + wrap->instance = newSVsv(instance); + wrap->closure = newSV(0); + *wrapp = wrap; + } + + if(wrap->handler) + SvSetSV(wrap->handler, handler); + else + wrap->handler = newSVsv(handler); + + if(!closure || !SvOK(closure)) + SvSetSV(wrap->closure, &PL_sv_undef); + else + SvSetSV(wrap->closure, closure); + return(1); +} + +static inline void activate_handler (handler_wrapper_t *wrap, + SV *param) +{ + dSP; + if(!wrap) + /* FIXME this is internal error */ + return; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + EXTEND(SP, 3); + PUSHs(sv_mortalcopy(wrap->instance)); + if(param) + PUSHs(param); + PUSHs(sv_mortalcopy(wrap->closure)); + PUTBACK; + + call_sv(wrap->handler, G_DISCARD); + + FREETMPS; + LEAVE; +} + +static void processor_handler (zbar_image_t *image, + const void *userdata) +{ + SV *img; + zbar_image_ref(image, 1); + img = sv_setref_pv(newSV(0), "Barcode::ZBar::Image", image); + activate_handler((void*)userdata, img); + SvREFCNT_dec(img); +} + +static void decoder_handler (zbar_decoder_t *decoder) +{ + activate_handler(zbar_decoder_get_userdata(decoder), NULL); +} + + +MODULE = Barcode::ZBar PACKAGE = Barcode::ZBar PREFIX = zbar_ + +PROTOTYPES: ENABLE + +BOOT: + { + HV *stash = gv_stashpv("Barcode::ZBar", TRUE); + + LOOKUP_zbar_color_t = newAV(); + CONSTANT(color, , SPACE, "SPACE"); + CONSTANT(color, , BAR, "BAR"); + } + +SV * +zbar_version() + PREINIT: + unsigned major; + unsigned minor; + CODE: + zbar_version(&major, &minor, NULL); + RETVAL = newSVpvf("%u.%u", major, minor); + OUTPUT: + RETVAL + +void +zbar_increase_verbosity() + +void +zbar_set_verbosity(verbosity) + int verbosity + +SV * +parse_config(config_string) + const char * config_string + PREINIT: + zbar_symbol_type_t sym; + zbar_config_t cfg; + int val; + PPCODE: + if(zbar_parse_config(config_string, &sym, &cfg, &val)) + croak("invalid configuration setting: %s", config_string); + EXTEND(SP, 3); + PUSHs(LOOKUP_ENUM(symbol_type, sym)); + PUSHs(LOOKUP_ENUM(config, cfg)); + mPUSHi(val); + + +MODULE = Barcode::ZBar PACKAGE = Barcode::ZBar::Error PREFIX = zbar_ + +BOOT: + { + HV *stash = gv_stashpv("Barcode::ZBar::Error", TRUE); + + LOOKUP_zbar_error_t = newAV(); + CONSTANT(error, ERR_, NOMEM, "out of memory"); + CONSTANT(error, ERR_, INTERNAL, "internal library error"); + CONSTANT(error, ERR_, UNSUPPORTED, "unsupported request"); + CONSTANT(error, ERR_, INVALID, "invalid request"); + CONSTANT(error, ERR_, SYSTEM, "system error"); + CONSTANT(error, ERR_, LOCKING, "locking error"); + CONSTANT(error, ERR_, BUSY, "all resources busy"); + CONSTANT(error, ERR_, XDISPLAY, "X11 display error"); + CONSTANT(error, ERR_, XPROTO, "X11 protocol error"); + CONSTANT(error, ERR_, CLOSED, "output window is closed"); + CONSTANT(error, ERR_, WINAPI, "windows system error"); + } + +zbar_error_t +get_error_code(err) + Barcode::ZBar::Error err + CODE: + RETVAL = _zbar_get_error_code(err); + OUTPUT: + RETVAL + +const char * +error_string(err) + Barcode::ZBar::Error err + CODE: + RETVAL = _zbar_error_string(err, 1); + OUTPUT: + RETVAL + + +MODULE = Barcode::ZBar PACKAGE = Barcode::ZBar::Config PREFIX = zbar_config_ + +BOOT: + { + HV *stash = gv_stashpv("Barcode::ZBar::Config", TRUE); + + LOOKUP_zbar_config_t = newAV(); + CONSTANT(config, CFG_, ENABLE, "enable"); + CONSTANT(config, CFG_, ADD_CHECK, "add-check"); + CONSTANT(config, CFG_, EMIT_CHECK, "emit-check"); + CONSTANT(config, CFG_, ASCII, "ascii"); + CONSTANT(config, CFG_, MIN_LEN, "min-length"); + CONSTANT(config, CFG_, MAX_LEN, "max-length"); + CONSTANT(config, CFG_, UNCERTAINTY, "uncertainty"); + CONSTANT(config, CFG_, POSITION, "position"); + CONSTANT(config, CFG_, X_DENSITY, "x-density"); + CONSTANT(config, CFG_, Y_DENSITY, "y-density"); + } + +MODULE = Barcode::ZBar PACKAGE = Barcode::ZBar::Modifier PREFIX = zbar_mod_ + +BOOT: + { + HV *stash = gv_stashpv("Barcode::ZBar::Modifier", TRUE); + + LOOKUP_zbar_modifier_t = newAV(); + CONSTANT(modifier, MOD_, GS1, "GS1"); + CONSTANT(modifier, MOD_, AIM, "AIM"); + } + +MODULE = Barcode::ZBar PACKAGE = Barcode::ZBar::Orient PREFIX = zbar_orientation_ + +BOOT: + { + HV *stash = gv_stashpv("Barcode::ZBar::Orient", TRUE); + + LOOKUP_zbar_orientation_t = newAV(); + CONSTANT(orientation, ORIENT_, UNKNOWN, "UNKNOWN"); + CONSTANT(orientation, ORIENT_, UP, "UP"); + CONSTANT(orientation, ORIENT_, RIGHT, "RIGHT"); + CONSTANT(orientation, ORIENT_, DOWN, "DOWN"); + CONSTANT(orientation, ORIENT_, LEFT, "LEFT"); + } + + +MODULE = Barcode::ZBar PACKAGE = Barcode::ZBar::Symbol PREFIX = zbar_symbol_ + +BOOT: + { + HV *stash = gv_stashpv("Barcode::ZBar::Symbol", TRUE); + + LOOKUP_zbar_symbol_type_t = newAV(); + CONSTANT(symbol_type, , NONE, "None"); + CONSTANT(symbol_type, , PARTIAL, "Partial"); + CONSTANT(symbol_type, , EAN8, zbar_get_symbol_name(ZBAR_EAN8)); + CONSTANT(symbol_type, , UPCE, zbar_get_symbol_name(ZBAR_UPCE)); + CONSTANT(symbol_type, , ISBN10, zbar_get_symbol_name(ZBAR_ISBN10)); + CONSTANT(symbol_type, , UPCA, zbar_get_symbol_name(ZBAR_UPCA)); + CONSTANT(symbol_type, , EAN13, zbar_get_symbol_name(ZBAR_EAN13)); + CONSTANT(symbol_type, , ISBN13, zbar_get_symbol_name(ZBAR_ISBN13)); + CONSTANT(symbol_type, , DATABAR, zbar_get_symbol_name(ZBAR_DATABAR)); + CONSTANT(symbol_type, , DATABAR_EXP, + zbar_get_symbol_name(ZBAR_DATABAR_EXP)); + CONSTANT(symbol_type, , I25, zbar_get_symbol_name(ZBAR_I25)); + CONSTANT(symbol_type, , CODABAR, zbar_get_symbol_name(ZBAR_CODABAR)); + CONSTANT(symbol_type, , CODE39, zbar_get_symbol_name(ZBAR_CODE39)); + CONSTANT(symbol_type, , PDF417, zbar_get_symbol_name(ZBAR_PDF417)); + CONSTANT(symbol_type, , QRCODE, zbar_get_symbol_name(ZBAR_QRCODE)); + CONSTANT(symbol_type, , CODE93, zbar_get_symbol_name(ZBAR_CODE93)); + CONSTANT(symbol_type, , CODE128, zbar_get_symbol_name(ZBAR_CODE128)); + } + +void +DESTROY(symbol) + Barcode::ZBar::Symbol symbol + CODE: + zbar_symbol_ref(symbol, -1); + +zbar_symbol_type_t +zbar_symbol_get_type(symbol) + Barcode::ZBar::Symbol symbol + +SV * +zbar_symbol_get_configs(symbol) + Barcode::ZBar::Symbol symbol + PPCODE: + PUSH_ENUM_MASK(config, CFG, zbar_symbol_get_configs(symbol)); + +SV * +zbar_symbol_get_modifiers(symbol) + Barcode::ZBar::Symbol symbol + PPCODE: + PUSH_ENUM_MASK(modifier, MOD, zbar_symbol_get_modifiers(symbol)); + +SV * +zbar_symbol_get_data(symbol) + Barcode::ZBar::Symbol symbol + CODE: + RETVAL = newSVpvn(zbar_symbol_get_data(symbol), + zbar_symbol_get_data_length(symbol)); + OUTPUT: + RETVAL + +int +zbar_symbol_get_count(symbol) + Barcode::ZBar::Symbol symbol + +int +zbar_symbol_get_quality(symbol) + Barcode::ZBar::Symbol symbol + +SV * +zbar_symbol_get_loc(symbol) + Barcode::ZBar::Symbol symbol + PREINIT: + unsigned i, size; + PPCODE: + size = zbar_symbol_get_loc_size(symbol); + EXTEND(SP, size); + for(i = 0; i < size; i++) { + AV *pt = (AV*)sv_2mortal((SV*)newAV()); + PUSHs(newRV((SV*)pt)); + av_push(pt, newSVuv(zbar_symbol_get_loc_x(symbol, i))); + av_push(pt, newSVuv(zbar_symbol_get_loc_y(symbol, i))); + } + +zbar_orientation_t +zbar_symbol_get_orientation(symbol) + Barcode::ZBar::Symbol symbol + +SV * +get_components(symbol) + Barcode::ZBar::Symbol symbol + PPCODE: + PUSH_SYMS(zbar_symbol_first_component(symbol)); + + +MODULE = Barcode::ZBar PACKAGE = Barcode::ZBar::Image PREFIX = zbar_image_ + +Barcode::ZBar::Image +new(package) + char * package + CODE: + RETVAL = zbar_image_create(); + OUTPUT: + RETVAL + +void +DESTROY(image) + Barcode::ZBar::Image image + CODE: + zbar_image_destroy(image); + +Barcode::ZBar::Image +zbar_image_convert(image, format) + Barcode::ZBar::Image image + fourcc_t format + +Barcode::ZBar::Image +zbar_image_convert_resize(image, format, width, height) + Barcode::ZBar::Image image + fourcc_t format + unsigned width + unsigned height + +fourcc_t +zbar_image_get_format(image) + Barcode::ZBar::Image image + +unsigned +zbar_image_get_sequence(image) + Barcode::ZBar::Image image + +void +get_size(image) + Barcode::ZBar::Image image + PPCODE: + EXTEND(SP, 2); + mPUSHu(zbar_image_get_width(image)); + mPUSHu(zbar_image_get_height(image)); + +void +get_crop(image) + Barcode::ZBar::Image image + PREINIT: + unsigned x, y, w, h; + PPCODE: + zbar_image_get_crop(image, &x, &y, &w, &h); + EXTEND(SP, 4); + mPUSHu(x); + mPUSHu(y); + mPUSHu(w); + mPUSHu(h); + +SV * +zbar_image_get_data(image) + Barcode::ZBar::Image image + CODE: + RETVAL = newSVpvn(zbar_image_get_data(image), + zbar_image_get_data_length(image)); + OUTPUT: + RETVAL + +SV * +get_symbols(image) + Barcode::ZBar::Image image + PPCODE: + PUSH_SYMS(zbar_image_first_symbol(image)); + +void +zbar_image_set_format(image, format) + Barcode::ZBar::Image image + fourcc_t format + +void +zbar_image_set_sequence(image, seq_num) + Barcode::ZBar::Image image + unsigned seq_num + +void +zbar_image_set_size(image, width, height) + Barcode::ZBar::Image image + int width + if(width < 0) width = 0; + int height + if(height < 0) height = 0; + +void +zbar_image_set_crop(image, x, y, width, height) + Barcode::ZBar::Image image + int x + if(x < 0) { width += x; x = 0; } + int y + if(y < 0) { height += y; y = 0; } + int width + int height + +void +zbar_image_set_data(image, data) + Barcode::ZBar::Image image + SV * data + PREINIT: + SV *old; + CODE: + if(!data || !SvOK(data)) { + zbar_image_set_data(image, NULL, 0, NULL); + zbar_image_set_userdata(image, NULL); + } + else if(SvPOK(data)) { + /* FIXME is this copy of data or new ref to same data? + * not sure this is correct: + * need to retain a reference to image data, + * but do not really want to copy it...maybe an RV? + */ + SV *copy = newSVsv(data); + STRLEN len; + void *raw = SvPV(copy, len); + zbar_image_set_data(image, raw, len, image_cleanup_handler); + zbar_image_set_userdata(image, copy); + } + else + croak("image data must be binary string"); + + +MODULE = Barcode::ZBar PACKAGE = Barcode::ZBar::Processor PREFIX = zbar_processor_ + +Barcode::ZBar::Processor +new(package, threaded=0) + char * package + bool threaded + CODE: + RETVAL = zbar_processor_create(threaded); + OUTPUT: + RETVAL + +void +DESTROY(processor) + Barcode::ZBar::Processor processor + CODE: + zbar_processor_destroy(processor); + +void +zbar_processor_init(processor, video_device="", enable_display=1) + Barcode::ZBar::Processor processor + const char * video_device + bool enable_display + CODE: + check_error(zbar_processor_init(processor, video_device, enable_display), + processor); + +void +zbar_processor_request_size(processor, width, height) + Barcode::ZBar::Processor processor + unsigned width + unsigned height + CODE: + check_error(zbar_processor_request_size(processor, width, height), + processor); + +void +zbar_processor_force_format(processor, input_format=0, output_format=0) + Barcode::ZBar::Processor processor + fourcc_t input_format + fourcc_t output_format + CODE: + check_error(zbar_processor_force_format(processor, input_format, output_format), + processor); + +void +zbar_processor_set_config(processor, symbology, config, value=1) + Barcode::ZBar::Processor processor + zbar_symbol_type_t symbology + zbar_config_t config + int value + +config_error +zbar_processor_parse_config(processor, config_string) + Barcode::ZBar::Processor processor + const char *config_string + +bool +zbar_processor_is_visible(processor) + Barcode::ZBar::Processor processor + CODE: + check_error((RETVAL = zbar_processor_is_visible(processor)), + processor); + OUTPUT: + RETVAL + +void +zbar_processor_set_visible(processor, visible=1) + Barcode::ZBar::Processor processor + bool visible + CODE: + check_error(zbar_processor_set_visible(processor, visible), + processor); + +void +zbar_processor_set_active(processor, active=1) + Barcode::ZBar::Processor processor + bool active + CODE: + check_error(zbar_processor_set_active(processor, active), + processor); + +SV * +get_results(processor) + Barcode::ZBar::Processor processor + PREINIT: + const zbar_symbol_set_t *syms; + PPCODE: + syms = zbar_processor_get_results(processor); + PUSH_SYMS(zbar_symbol_set_first_symbol(syms)); + zbar_symbol_set_ref(syms, -1); + +int +zbar_processor_user_wait(processor, timeout=-1) + Barcode::ZBar::Processor processor + timeout_t timeout + CODE: + check_error((RETVAL = zbar_processor_user_wait(processor, timeout)), + processor); + OUTPUT: + RETVAL + +int +process_one(processor, timeout=-1) + Barcode::ZBar::Processor processor + timeout_t timeout + CODE: + check_error((RETVAL = zbar_process_one(processor, timeout)), + processor); + OUTPUT: + RETVAL + +int +process_image(processor, image) + Barcode::ZBar::Processor processor + Barcode::ZBar::Image image + CODE: + check_error((RETVAL = zbar_process_image(processor, image)), + processor); + OUTPUT: + RETVAL + +void +zbar_processor_set_data_handler(processor, handler = 0, closure = 0) + Barcode::ZBar::Processor processor + SV * handler + SV * closure + PREINIT: + handler_wrapper_t *wrap; + zbar_image_data_handler_t *callback = NULL; + CODE: + wrap = zbar_processor_get_userdata(processor); + if(set_handler(&wrap, ST(0), handler, closure)) + callback = processor_handler; + zbar_processor_set_data_handler(processor, callback, wrap); + + +MODULE = Barcode::ZBar PACKAGE = Barcode::ZBar::ImageScanner PREFIX = zbar_image_scanner_ + +Barcode::ZBar::ImageScanner +new(package) + char * package + CODE: + RETVAL = zbar_image_scanner_create(); + OUTPUT: + RETVAL + +void +DESTROY(scanner) + Barcode::ZBar::ImageScanner scanner + CODE: + zbar_image_scanner_destroy(scanner); + +void +zbar_image_scanner_set_config(scanner, symbology, config, value=1) + Barcode::ZBar::ImageScanner scanner + zbar_symbol_type_t symbology + zbar_config_t config + int value + +config_error +zbar_image_scanner_parse_config(scanner, config_string) + Barcode::ZBar::ImageScanner scanner + const char *config_string + +void +zbar_image_scanner_enable_cache(scanner, enable) + Barcode::ZBar::ImageScanner scanner + int enable + +void +zbar_image_scanner_recycle_image(scanner, image) + Barcode::ZBar::ImageScanner scanner + Barcode::ZBar::Image image + +SV * +get_results(scanner) + Barcode::ZBar::ImageScanner scanner + PREINIT: + const zbar_symbol_set_t *syms; + PPCODE: + syms = zbar_image_scanner_get_results(scanner); + PUSH_SYMS(zbar_symbol_set_first_symbol(syms)); + +int +scan_image(scanner, image) + Barcode::ZBar::ImageScanner scanner + Barcode::ZBar::Image image + CODE: + RETVAL = zbar_scan_image(scanner, image); + OUTPUT: + RETVAL + + +MODULE = Barcode::ZBar PACKAGE = Barcode::ZBar::Decoder PREFIX = zbar_decoder_ + +Barcode::ZBar::Decoder +new(package) + char * package + CODE: + RETVAL = zbar_decoder_create(); + OUTPUT: + RETVAL + +void +DESTROY(decoder) + Barcode::ZBar::Decoder decoder + CODE: + /* FIXME cleanup handler wrapper */ + zbar_decoder_destroy(decoder); + +void +zbar_decoder_set_config(decoder, symbology, config, value=1) + Barcode::ZBar::Decoder decoder + zbar_symbol_type_t symbology + zbar_config_t config + int value + +config_error +zbar_decoder_parse_config(decoder, config_string) + Barcode::ZBar::Decoder decoder + const char *config_string + +void +zbar_decoder_reset(decoder) + Barcode::ZBar::Decoder decoder + +void +zbar_decoder_new_scan(decoder) + Barcode::ZBar::Decoder decoder + +zbar_symbol_type_t +decode_width(decoder, width) + Barcode::ZBar::Decoder decoder + unsigned width + CODE: + RETVAL = zbar_decode_width(decoder, width); + OUTPUT: + RETVAL + +zbar_color_t +zbar_decoder_get_color(decoder) + Barcode::ZBar::Decoder decoder + +SV * +zbar_decoder_get_data(decoder) + Barcode::ZBar::Decoder decoder + CODE: + RETVAL = newSVpvn(zbar_decoder_get_data(decoder), + zbar_decoder_get_data_length(decoder)); + OUTPUT: + RETVAL + +zbar_symbol_type_t +zbar_decoder_get_type(decoder) + Barcode::ZBar::Decoder decoder + +SV * +zbar_decoder_get_configs(decoder, symbology) + Barcode::ZBar::Decoder decoder + zbar_symbol_type_t symbology + PPCODE: + if(symbology == ZBAR_NONE) + symbology = zbar_decoder_get_type(decoder); + PUSH_ENUM_MASK(config, CFG, zbar_decoder_get_configs(decoder, symbology)); + +SV * +zbar_decoder_get_modifiers(decoder) + Barcode::ZBar::Decoder decoder + PPCODE: + PUSH_ENUM_MASK(modifier, MOD, zbar_decoder_get_modifiers(decoder)); + +int +zbar_decoder_get_direction(decoder) + Barcode::ZBar::Decoder decoder + +void +zbar_decoder_set_handler(decoder, handler = 0, closure = 0) + Barcode::ZBar::Decoder decoder + SV * handler + SV * closure + PREINIT: + handler_wrapper_t *wrap; + CODE: + wrap = zbar_decoder_get_userdata(decoder); + zbar_decoder_set_handler(decoder, NULL); + if(set_handler(&wrap, ST(0), handler, closure)) { + zbar_decoder_set_userdata(decoder, wrap); + zbar_decoder_set_handler(decoder, decoder_handler); + } + + +MODULE = Barcode::ZBar PACKAGE = Barcode::ZBar::Scanner PREFIX = zbar_scanner_ + +Barcode::ZBar::Scanner +new(package, decoder = 0) + char * package + Barcode::ZBar::Decoder decoder + CODE: + RETVAL = zbar_scanner_create(decoder); + OUTPUT: + RETVAL + +void +DESTROY(scanner) + Barcode::ZBar::Scanner scanner + CODE: + zbar_scanner_destroy(scanner); + +zbar_symbol_type_t +zbar_scanner_reset(scanner) + Barcode::ZBar::Scanner scanner + +zbar_symbol_type_t +zbar_scanner_new_scan(scanner) + Barcode::ZBar::Scanner scanner + +zbar_color_t +zbar_scanner_get_color(scanner) + Barcode::ZBar::Scanner scanner + +unsigned +zbar_scanner_get_width(scanner) + Barcode::ZBar::Scanner scanner + +zbar_symbol_type_t +scan_y(scanner, y) + Barcode::ZBar::Scanner scanner + int y + CODE: + RETVAL = zbar_scan_y(scanner, y); + OUTPUT: + RETVAL diff --git a/perl/ZBar/Image.pod b/perl/ZBar/Image.pod new file mode 100644 index 0000000..6848bdd --- /dev/null +++ b/perl/ZBar/Image.pod @@ -0,0 +1,145 @@ +#------------------------------------------------------------------------ +# Copyright 2008-2009 (c) Jeff Brown +# +# This file is part of the ZBar Bar Code Reader. +# +# The ZBar Bar Code Reader is free software; you can redistribute it +# and/or modify it under the terms of the GNU Lesser Public License as +# published by the Free Software Foundation; either version 2.1 of +# the License, or (at your option) any later version. +# +# The ZBar Bar Code Reader 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 Lesser Public License for more details. +# +# You should have received a copy of the GNU Lesser Public License +# along with the ZBar Bar Code Reader; if not, write to the Free +# Software Foundation, Inc., 51 Franklin St, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# http://sourceforge.net/projects/zbar +#------------------------------------------------------------------------ + +=pod + +=head1 NAME + +Barcode::ZBar::Image - image object to scan for bar codes + +=head1 SYNOPSIS + + use Barcode::ZBar; + + my $image = Barcode::ZBar::Image->new(); + $image->set_format('422P'); + $image->set_size(114, 80); + $image->set_data($raw_bits); + + my @symbols = $image->get_symbols(); + +=head1 DESCRIPTION + +Barcode::ZBar::Image is used to pass images to the bar code scanner. +It wraps raw image data with the meta-data required to interpret it +(size, pixel format, etc) + +=head2 Image Formats + +Image data formats are represented by (relatively) standard "Four +Character Codes" (fourcc), represented by four character strings in +Perl. A list of supported formats is available on the project wiki. + +Examples: + +=over 2 + +=item * + +'GREY' - single 8bpp intensity plane + +=item * + +'BGR3' - 24bpp packed RGB component format + +=item * + +'YUYV' - 12bpp packed luminance/chrominance (YCbCr) format + +=back + +=head1 REFERENCE + +=head2 Methods + +=over 4 + +=item new() + +Create a new Barcode::ZBar::Image object. The size, pixel format and +data must be defined before the object may be used. + +=item get_format() + +=item set_format(I) + +Return/specify the fourcc code corresponding to the image pixel format. + +=item get_sequence() + +=item set_sequence(I) + +Return/specify the video frame or page number associated with the image. + +=item get_size() + +=item set_size(I, I) + +Return/specify the (I, I) image size tuple. + +=item get_data() + +=item set_data(I) + +Return/specify the raw image data as a binary string. + +=item get_symbols() + +Return a list of scanned Barcode::ZBar::Symbol results attached to +this image. + +=item convert_resize(I, I, I) + +=item convert(I) + +Return a new Barcode::ZBar::Image object converted to the indicated +fourcc format. Returns C if the conversion is not supported. +Conversion complexity ranges from CPU intensive to trivial depending +on the formats involved. Note that only a few conversions retain +color information. convert actually calls convert_resize using the +source width and height. + +=back + +=head1 SEE ALSO + +Barcode::ZBar, Barcode::ZBar::Image, Barcode::ZBar::Symbol + +zbarimg(1), zbarcam(1) + +http://zbar.sf.net + +=head1 AUTHOR + +Jeff Brown, Espadix@users.sourceforge.netE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008-2010 (c) Jeff Brown Espadix@users.sourceforge.netE + +The ZBar Bar Code Reader is free software; you can redistribute it +and/or modify it under the terms of the GNU Lesser Public License as +published by the Free Software Foundation; either version 2.1 of +the License, or (at your option) any later version. + +=cut diff --git a/perl/ZBar/ImageScanner.pod b/perl/ZBar/ImageScanner.pod new file mode 100644 index 0000000..dcbc21c --- /dev/null +++ b/perl/ZBar/ImageScanner.pod @@ -0,0 +1,103 @@ +#------------------------------------------------------------------------ +# Copyright 2008-2009 (c) Jeff Brown +# +# This file is part of the ZBar Bar Code Reader. +# +# The ZBar Bar Code Reader is free software; you can redistribute it +# and/or modify it under the terms of the GNU Lesser Public License as +# published by the Free Software Foundation; either version 2.1 of +# the License, or (at your option) any later version. +# +# The ZBar Bar Code Reader 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 Lesser Public License for more details. +# +# You should have received a copy of the GNU Lesser Public License +# along with the ZBar Bar Code Reader; if not, write to the Free +# Software Foundation, Inc., 51 Franklin St, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# http://sourceforge.net/projects/zbar +#------------------------------------------------------------------------ + +=pod + +=head1 NAME + +Barcode::ZBar::ImageScanner - scan images for bar codes + +=head1 SYNOPSIS + + use Barcode::ZBar; + + my $scanner = Barcode::ZBar::ImageScanner->new(); + $scanner->parse_config('i25.disable'); + $scanner->scan_image($image); + +=head1 DESCRIPTION + +A Barcode::ZBar::ImageScanner is used to scan for bar codes in a +Barcode::ZBar::Image. + +=head1 REFERENCE + +=head2 Methods + +=over 4 + +=item new() + +Create a new bar code image scanner instance. + +=item get_results() + +Return a list of Barcode::ZBar::Symbol results from the last scanned +image. + +=item scan_image([I]) + +Scan a Barcode::ZBar::Image for bar codes. The image must be in the +"Y800" format. If necessary, use C<< I<$image>->convert("Y800") >> to +convert from other supported formats to Y800 before scanning. + +=item enable_cache([I]) + +Enable the inter-image result consistency cache. + +=item set_config(I, I, I) + +Set config for indicated symbology (0 for all) to specified value. + +=item parse_config(I) + +Apply a decoder configuration setting. See the documentation for +C/C for available configuration options. + +=item recycle_image([I]) + +Remove previously decoded results from a Barcode::ZBar::Image and +recycle the associated memory. + +=back + +=head1 SEE ALSO + +Barcode::ZBar, Barcode::ZBar::Image, zbarimg(1), zbarcam(1) + +http://zbar.sf.net + +=head1 AUTHOR + +Jeff Brown, Espadix@users.sourceforge.netE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008-2010 (c) Jeff Brown Espadix@users.sourceforge.netE + +The ZBar Bar Code Reader is free software; you can redistribute it +and/or modify it under the terms of the GNU Lesser Public License as +published by the Free Software Foundation; either version 2.1 of +the License, or (at your option) any later version. + +=cut diff --git a/perl/ZBar/Processor.pod b/perl/ZBar/Processor.pod new file mode 100644 index 0000000..96b1982 --- /dev/null +++ b/perl/ZBar/Processor.pod @@ -0,0 +1,157 @@ +#------------------------------------------------------------------------ +# Copyright 2008-2009 (c) Jeff Brown +# +# This file is part of the ZBar Bar Code Reader. +# +# The ZBar Bar Code Reader is free software; you can redistribute it +# and/or modify it under the terms of the GNU Lesser Public License as +# published by the Free Software Foundation; either version 2.1 of +# the License, or (at your option) any later version. +# +# The ZBar Bar Code Reader 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 Lesser Public License for more details. +# +# You should have received a copy of the GNU Lesser Public License +# along with the ZBar Bar Code Reader; if not, write to the Free +# Software Foundation, Inc., 51 Franklin St, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# http://sourceforge.net/projects/zbar +#------------------------------------------------------------------------ + +=pod + +=head1 NAME + +Barcode::ZBar::Processor - self-contained bar code reader + +=head1 SYNOPSIS + +setup: + + use Barcode::ZBar; + + my $reader = Barcode::ZBar::Processor->new(); + $reader->init("/dev/video1", 1); + $reader->parse_config('code39.disable'); + $reader->set_data_handler(\&my_handler); + +scan an image: + + $reader->process_image($image); + +scan from video: + + $reader->set_visible(); + $reader->set_active(); + $reader->user_wait(); + +=head1 DESCRIPTION + +A Barcode::ZBar::Processor may be used to quickly create stand-alone +bar code scanning applications. It has interfaces to scan images or +video and to optionally display a video/image preview to a window. + +This interface is not well suited for integration with an existing +GUI, as the library manages the optional preview window and any user +interaction. Use a Barcode::ZBar::ImageScanner or Investigate the +available widget interfaces for GUI applications. + +=head1 REFERENCE + +=head2 Methods + +=over 4 + +=item new() + +Create a new bar code reader instance. + +=item init([I], [I]) + +Open a video input device and/or prepare to display output. + +=item set_data_handler([I], [I]) + +Setup a callback to process results whenever new results are available +from the video stream or a static image. The specified callable will +be invoked with the associated Barcode::ZBar::Processor object and +I as arguments. Closure may be achieved either using +standard Perl closure or by manually passing a scalar via I. + +=item is_visible() + +=item set_visible([I]) + +Test/set visibility of the output window. + +=item set_active([I]) + +Enable/disable video streaming and scanning for bar codes. + +=item get_results() + +Return a list of Barcode::ZBar::Symbol results from the last scanned +image or video frame. + +=item user_wait([I]) + +Wait for the user to press a key/button or close the window. Bar +codes will continue to be processed if video is active. + +=item process_one([I]) + +Enable video and scan until at least one barcode is found. Note that +multiple results may still be returned. + +=item process_image([I]) + +Scan a Barcode::ZBar::Image for bar codes. + +=item parse_config(I) + +Apply a decoder configuration setting. See the documentation for +C/C for available configuration options. + +=item request_size(I, I) + +Request a preferred size for the video image from the device. The +request may be adjusted or completely ignored by the driver. Must be +called before C + +=item force_format(I, I) + +force specific input and output formats for debug/testing. + +=item set_config(I, I, I) + +Set config for indicated symbology (0 for all) to specified value. +@returns 0 for success, non-0 for failure (config does not apply to +specified symbology, or value out of range) + +=back + +=head1 SEE ALSO + +Barcode::ZBar, Barcode::ZBar::Image, Barcode::ZBar::ImageScanner + +zbarimg(1), zbarcam(1) + +http://zbar.sf.net + +=head1 AUTHOR + +Jeff Brown, Espadix@users.sourceforge.netE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008-2010 (c) Jeff Brown Espadix@users.sourceforge.netE + +The ZBar Bar Code Reader is free software; you can redistribute it +and/or modify it under the terms of the GNU Lesser Public License as +published by the Free Software Foundation; either version 2.1 of +the License, or (at your option) any later version. + +=cut diff --git a/perl/ZBar/Symbol.pod b/perl/ZBar/Symbol.pod new file mode 100644 index 0000000..6a21b1e --- /dev/null +++ b/perl/ZBar/Symbol.pod @@ -0,0 +1,179 @@ +#------------------------------------------------------------------------ +# Copyright 2008-2010 (c) Jeff Brown +# +# This file is part of the ZBar Bar Code Reader. +# +# The ZBar Bar Code Reader is free software; you can redistribute it +# and/or modify it under the terms of the GNU Lesser Public License as +# published by the Free Software Foundation; either version 2.1 of +# the License, or (at your option) any later version. +# +# The ZBar Bar Code Reader 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 Lesser Public License for more details. +# +# You should have received a copy of the GNU Lesser Public License +# along with the ZBar Bar Code Reader; if not, write to the Free +# Software Foundation, Inc., 51 Franklin St, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# http://sourceforge.net/projects/zbar +#------------------------------------------------------------------------ + +=pod + +=head1 NAME + +Barcode::ZBar::Symbol - bar code scan result object + +=head1 SYNOPSIS + + my @symbols = $image->get_symbols(); + foreach my $sym (@symbols) { + print("decoded: " . $sym->get_type() . + ":" . $sym->get_data(). + "(" . $sym->get_count() . ")"); + } + +=head1 DESCRIPTION + +Barcode::ZBar::Symbol objects are constant results returned for each +bar code scanned from images or video. This object wraps the raw +symbol data with additional information about the decode (symbology, +confidence, location, etc) + +=head1 REFERENCE + +=head2 Methods + +=over 4 + +=item get_type() + +The type of bar code "symbology" from which the data was decoded. + +=item get_data() + +The decoded data string. Note that some symbologies can encode binary +data. + +=item get_quality() + +Confidence metric. An unscaled integer value that indicates something +(intentionally unspecified) about the reliability of this result +relative to another. Larger values are better than smaller values, +where "large" and "small" are application dependent. Expect this +definition to become more specific as the metric is enhanced. + +=item get_count() + +Current cache count of the symbol. This integer value provides +inter-scan reliability and redundancy information if enabled at the +Barcode::ZBar::ImageScanner. + +=item get_orientation() + +General orientation of decoded symbol. This returns one of the +Barcode::ZBar::Orient constants, which provide a coarse, axis-aligned +indication of symbol orientation. + +=item get_components() + +Components of a composite result. This yields an array of physical +component symbols that were combined to form a composite result. + +=item get_configs() + +Retrieve symbology boolean config settings. Returns a bitmask +indicating which configs were set for the detected +symbology during decoding. + +=item get_modifiers() + +Retrieve symbology modifier flag settings. Returns a bitmask +indicating which characteristics were detected during decoding. + +=item get_loc() + +Retrieve an array of symbol location points (x,y) + +=over 2 + +=item * + +A negative value indicates that this result is still uncertain + +=item * + +A zero value indicates the first occurrence of this result with high +confidence + +=item * + +A positive value indicates a duplicate scan + +=back + +=back + +=head2 Constants + +Bar code type "symbology" constants: + +=over 4 + +=item NONE + +=item PARTIAL + +=item EAN13 + +=item EAN8 + +=item UPCA + +=item UPCE + +=item ISBN10 + +=item ISBN13 + +=item I25 + +=item CODABAR + +=item CODE39 + +=item CODE93 + +=item CODE128 + +=item QRCODE + +=item PDF417 + +=back + +=head1 SEE ALSO + +Barcode::ZBar, Barcode::ZBar::Image + +zbarimg(1), zbarcam(1) + +http://zbar.sf.net + +=head1 AUTHOR + +Jeff Brown, Espadix@users.sourceforge.netE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008-2010 (c) Jeff Brown Espadix@users.sourceforge.netE + +The ZBar Bar Code Reader is free software; you can redistribute it +and/or modify it under the terms of the GNU Lesser Public License as +published by the Free Software Foundation; either version 2.1 of +the License, or (at your option) any later version. + +=cut diff --git a/perl/examples/paginate.pl b/perl/examples/paginate.pl new file mode 100755 index 0000000..68ffe50 --- /dev/null +++ b/perl/examples/paginate.pl @@ -0,0 +1,71 @@ +#!/usr/bin/perl +#------------------------------------------------------------------------ +# Copyright 2009 (c) Jeff Brown +# +# This file is part of the ZBar Bar Code Reader. +# +# The ZBar Bar Code Reader is free software; you can redistribute it +# and/or modify it under the terms of the GNU Lesser Public License as +# published by the Free Software Foundation; either version 2.1 of +# the License, or (at your option) any later version. +# +# The ZBar Bar Code Reader 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 Lesser Public License for more details. +# +# You should have received a copy of the GNU Lesser Public License +# along with the ZBar Bar Code Reader; if not, write to the Free +# Software Foundation, Inc., 51 Franklin St, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# http://sourceforge.net/projects/zbar +#------------------------------------------------------------------------ +use warnings; +use strict; + +use Barcode::ZBar; +use Image::Magick; + +warn("no input files specified?\n") if(!@ARGV); + +# running output document +my $out = undef; + +# barcode scanner +my $scanner = Barcode::ZBar::ImageScanner->new(); + +foreach my $file (@ARGV) { + print "scanning from \"$file\"\n"; + my $imseq = Image::Magick->new(); + my $err = $imseq->Read($file); + warn($err) if($err); + + foreach my $page (@$imseq) { + # convert ImageMagick page to ZBar image + my $zimg = Barcode::ZBar::Image->new(); + $zimg->set_format('Y800'); + $zimg->set_size($page->Get(qw(columns rows))); + $zimg->set_data($page->Clone()->ImageToBlob(magick => 'GRAY', depth => 8)); + + # scan for barcodes + if($scanner->scan_image($zimg)) { + # write out previous document + $out->write() if($out); + + # use first symbol found to name next image (FIXME sanitize) + my $data = ($zimg->get_symbols())[0]->get_data(); + my $idx = $page->Get('scene') + 1; + print "splitting $data from page $idx\n"; + + # create new output document + $out = Image::Magick->new(filename => $data); + } + + # append this page to current output + push(@$out, $page) if($out); + } + + # write out final document + $out->write() if($out); +} diff --git a/perl/examples/processor.pl b/perl/examples/processor.pl new file mode 100755 index 0000000..d2d1e91 --- /dev/null +++ b/perl/examples/processor.pl @@ -0,0 +1,35 @@ +#!/usr/bin/env perl +use warnings; +use strict; +require Barcode::ZBar; + +# create a Processor +my $proc = Barcode::ZBar::Processor->new(); + +# configure the Processor +$proc->parse_config("enable"); + +# initialize the Processor +$proc->init($ARGV[0] || '/dev/video0'); + +# setup a callback +sub my_handler { + my ($proc, $image, $closure) = @_; + + # extract results + foreach my $symbol ($proc->get_results()) { + # do something useful with results + print('decoded ' . $symbol->get_type() . + ' symbol "' . $symbol->get_data() . "\"\n"); + } +} +$proc->set_data_handler(\&my_handler); + +# enable the preview window +$proc->set_visible(); + +# initiate scanning +$proc->set_active(); + +# keep scanning until user provides key/mouse input +$proc->user_wait(); diff --git a/perl/examples/read_one.pl b/perl/examples/read_one.pl new file mode 100755 index 0000000..d64860c --- /dev/null +++ b/perl/examples/read_one.pl @@ -0,0 +1,29 @@ +#!/usr/bin/env perl +use warnings; +use strict; +require Barcode::ZBar; + +# create a Processor +my $proc = Barcode::ZBar::Processor->new(); + +# configure the Processor +$proc->parse_config("enable"); + +# initialize the Processor +$proc->init($ARGV[0] || '/dev/video0'); + +# enable the preview window +$proc->set_visible(); + +# read at least one barcode (or until window closed) +$proc->process_one(); + +# hide the preview window +$proc->set_visible(0); + +# extract results +foreach my $symbol ($proc->get_results()) { + # do something useful with results + print('decoded ' . $symbol->get_type() . + ' symbol "' . $symbol->get_data() . "\"\n"); +} diff --git a/perl/examples/scan_image.pl b/perl/examples/scan_image.pl new file mode 100755 index 0000000..39d460e --- /dev/null +++ b/perl/examples/scan_image.pl @@ -0,0 +1,37 @@ +#!/usr/bin/perl +use warnings; +use strict; +require Image::Magick; +require Barcode::ZBar; + +$ARGV[0] || die; + +# create a reader +my $scanner = Barcode::ZBar::ImageScanner->new(); + +# configure the reader +$scanner->parse_config("enable"); + +# obtain image data +my $magick = Image::Magick->new(); +$magick->Read($ARGV[0]) && die; +my $raw = $magick->ImageToBlob(magick => 'GRAY', depth => 8); + +# wrap image data +my $image = Barcode::ZBar::Image->new(); +$image->set_format('Y800'); +$image->set_size($magick->Get(qw(columns rows))); +$image->set_data($raw); + +# scan the image for barcodes +my $n = $scanner->scan_image($image); + +# extract results +foreach my $symbol ($image->get_symbols()) { + # do something useful with results + print('decoded ' . $symbol->get_type() . + ' symbol "' . $symbol->get_data() . "\"\n"); +} + +# clean up +undef($image); diff --git a/perl/inc/Devel/CheckLib.pm b/perl/inc/Devel/CheckLib.pm new file mode 100644 index 0000000..be40780 --- /dev/null +++ b/perl/inc/Devel/CheckLib.pm @@ -0,0 +1,350 @@ +# $Id: CheckLib.pm,v 1.22 2008/03/12 19:52:50 drhyde Exp $ + +package Devel::CheckLib; + +use strict; +use vars qw($VERSION @ISA @EXPORT); +$VERSION = '0.5'; +use Config; + +use File::Spec; +use File::Temp; + +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(assert_lib check_lib_or_exit); + +# localising prevents the warningness leaking out of this module +local $^W = 1; # use warnings is a 5.6-ism + +_findcc(); # bomb out early if there's no compiler + +=head1 NAME + +Devel::CheckLib - check that a library is available + +=head1 DESCRIPTION + +Devel::CheckLib is a perl module that checks whether a particular C +library and its headers are available. + +=head1 SYNOPSIS + + # in a Makefile.PL or Build.PL + use lib qw(inc); + use Devel::CheckLib; + + check_lib_or_exit( lib => 'jpeg', header => 'jpeglib.h' ); + check_lib_or_exit( lib => [ 'iconv', 'jpeg' ] ); + + # or prompt for path to library and then do this: + check_lib_or_exit( lib => 'jpeg', libpath => $additional_path ); + +=head1 HOW IT WORKS + +You pass named parameters to a function, describing to it how to build +and link to the libraries. + +It works by trying to compile this: + + int main(void) { return 0; } + +and linking it to the specified libraries. If something pops out the end +which looks executable, then we know that it worked. That tiny program is +built once for each library that you specify, and (without linking) once +for each header file. + +=head1 FUNCTIONS + +All of these take the same named parameters and are exported by default. +To avoid exporting them, C. + +=head2 assert_lib + +This takes several named parameters, all of which are optional, and dies +with an error message if any of the libraries listed can +not be found. B: dying in a Makefile.PL or Build.PL may provoke +a 'FAIL' report from CPAN Testers' automated smoke testers. Use +C instead. + +The named parameters are: + +=over + +=item lib + +Must be either a string with the name of a single +library or a reference to an array of strings of library names. Depending +on the compiler found, library names will be fed to the compiler either as +C<-l> arguments or as C<.lib> file names. (E.g. C<-ljpeg> or C) + +=item libpath + +a string or an array of strings +representing additional paths to search for libraries. + +=item LIBS + +a C-style space-seperated list of +libraries (each preceded by '-l') and directories (preceded by '-L'). + +=back + +And libraries are no use without header files, so ... + +=over + +=item header + +Must be either a string with the name of a single +header file or a reference to an array of strings of header file names. + +=item incpath + +a string or an array of strings +representing additional paths to search for headers. + +=item INC + +a C-style space-seperated list of +incpaths, each preceded by '-I'. + +=back + +=head2 check_lib_or_exit + +This behaves exactly the same as C except that instead of +dying, it warns (with exactly the same error message) and exits. +This is intended for use in Makefile.PL / Build.PL +when you might want to prompt the user for various paths and +things before checking that what they've told you is sane. + +If any library or header is missing, it exits with an exit value of 0 to avoid +causing a CPAN Testers 'FAIL' report. CPAN Testers should ignore this +result -- which is what you want if an external library dependency is not +available. + +=cut + +sub check_lib_or_exit { + eval 'assert_lib(@_)'; + if($@) { + warn $@; + exit; + } +} + +sub assert_lib { + my %args = @_; + my (@libs, @libpaths, @headers, @incpaths); + + # FIXME: these four just SCREAM "refactor" at me + @libs = (ref($args{lib}) ? @{$args{lib}} : $args{lib}) + if $args{lib}; + @libpaths = (ref($args{libpath}) ? @{$args{libpath}} : $args{libpath}) + if $args{libpath}; + @headers = (ref($args{header}) ? @{$args{header}} : $args{header}) + if $args{header}; + @incpaths = (ref($args{incpath}) ? @{$args{incpath}} : $args{incpath}) + if $args{incpath}; + + # work-a-like for Makefile.PL's LIBS and INC arguments + if(defined($args{LIBS})) { + foreach my $arg (split(/\s+/, $args{LIBS})) { + die("LIBS argument badly-formed: $arg\n") unless($arg =~ /^-l/i); + push @{$arg =~ /^-l/ ? \@libs : \@libpaths}, substr($arg, 2); + } + } + if(defined($args{INC})) { + foreach my $arg (split(/\s+/, $args{INC})) { + die("INC argument badly-formed: $arg\n") unless($arg =~ /^-I/); + push @incpaths, substr($arg, 2); + } + } + + my @cc = _findcc(); + my @missing; + + # first figure out which headers we can't find ... + for my $header (@headers) { + my($ch, $cfile) = File::Temp::tempfile( + 'assertlibXXXXXXXX', SUFFIX => '.c' + ); + print $ch qq{#include <$header>\nint main(void) { return 0; }\n}; + close($ch); + my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe}; + my @sys_cmd; + # FIXME: re-factor - almost identical code later when linking + if ( $Config{cc} eq 'cl' ) { # Microsoft compiler + require Win32; + @sys_cmd = (@cc, $cfile, "/Fe$exefile", (map { '/I'.Win32::GetShortPathName($_) } @incpaths)); + } elsif($Config{cc} =~ /bcc32(\.exe)?/) { # Borland + @sys_cmd = (@cc, (map { "-I$_" } @incpaths), "-o$exefile", $cfile); + } else { # Unix-ish + # gcc, Sun, AIX (gcc, cc) + @sys_cmd = (@cc, $cfile, (map { "-I$_" } @incpaths), "-o", "$exefile"); + } + warn "# @sys_cmd\n" if $args{debug}; + my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd); + push @missing, $header if $rv != 0 || ! -x $exefile; + _cleanup_exe($exefile); + unlink $cfile; + } + + # now do each library in turn with no headers + my($ch, $cfile) = File::Temp::tempfile( + 'assertlibXXXXXXXX', SUFFIX => '.c' + ); + print $ch "int main(void) { return 0; }\n"; + close($ch); + for my $lib ( @libs ) { + my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe}; + my @sys_cmd; + if ( $Config{cc} eq 'cl' ) { # Microsoft compiler + require Win32; + my @libpath = map { + q{/libpath:} . Win32::GetShortPathName($_) + } @libpaths; + @sys_cmd = (@cc, $cfile, "${lib}.lib", "/Fe$exefile", + "/link", @libpath + ); + } elsif($Config{cc} eq 'CC/DECC') { # VMS + } elsif($Config{cc} =~ /bcc32(\.exe)?/) { # Borland + my @libpath = map { "-L$_" } @libpaths; + @sys_cmd = (@cc, "-o$exefile", "-l$lib", @libpath, $cfile); + } else { # Unix-ish + # gcc, Sun, AIX (gcc, cc) + my @libpath = map { "-L$_" } @libpaths; + @sys_cmd = (@cc, $cfile, "-o", "$exefile", "-l$lib", @libpath); + } + warn "# @sys_cmd\n" if $args{debug}; + my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd); + push @missing, $lib if $rv != 0 || ! -x $exefile; + _cleanup_exe($exefile); + } + unlink $cfile; + + my $miss_string = join( q{, }, map { qq{'$_'} } @missing ); + die("Can't link/include $miss_string\n") if @missing; +} + +sub _cleanup_exe { + my ($exefile) = @_; + my $ofile = $exefile; + $ofile =~ s/$Config{_exe}$/$Config{_o}/; + unlink $exefile if -f $exefile; + unlink $ofile if -f $ofile; + unlink "$exefile\.manifest" if -f "$exefile\.manifest"; + return +} + +sub _findcc { + my @paths = split(/$Config{path_sep}/, $ENV{PATH}); + my @cc = split(/\s+/, $Config{cc}); + return @cc if -x $cc[0]; + foreach my $path (@paths) { + my $compiler = File::Spec->catfile($path, $cc[0]) . $Config{_exe}; + return ($compiler, @cc[1 .. $#cc]) if -x $compiler; + } + die("Couldn't find your C compiler\n"); +} + +# code substantially borrowed from IPC::Run3 +sub _quiet_system { + my (@cmd) = @_; + + # save handles + local *STDOUT_SAVE; + local *STDERR_SAVE; + open STDOUT_SAVE, ">&STDOUT" or die "CheckLib: $! saving STDOUT"; + open STDERR_SAVE, ">&STDERR" or die "CheckLib: $! saving STDERR"; + + # redirect to nowhere + local *DEV_NULL; + open DEV_NULL, ">" . File::Spec->devnull + or die "CheckLib: $! opening handle to null device"; + open STDOUT, ">&" . fileno DEV_NULL + or die "CheckLib: $! redirecting STDOUT to null handle"; + open STDERR, ">&" . fileno DEV_NULL + or die "CheckLib: $! redirecting STDERR to null handle"; + + # run system command + my $rv = system(@cmd); + + # restore handles + open STDOUT, ">&" . fileno STDOUT_SAVE + or die "CheckLib: $! restoring STDOUT handle"; + open STDERR, ">&" . fileno STDERR_SAVE + or die "CheckLib: $! restoring STDERR handle"; + + return $rv; +} + +=head1 PLATFORMS SUPPORTED + +You must have a C compiler installed. We check for C<$Config{cc}>, +both literally as it is in Config.pm and also in the $PATH. + +It has been tested with varying degrees on rigourousness on: + +=over + +=item gcc (on Linux, *BSD, Mac OS X, Solaris, Cygwin) + +=item Sun's compiler tools on Solaris + +=item IBM's tools on AIX + +=item Microsoft's tools on Windows + +=item MinGW on Windows (with Strawberry Perl) + +=item Borland's tools on Windows + +=back + +=head1 WARNINGS, BUGS and FEEDBACK + +This is a very early release intended primarily for feedback from +people who have discussed it. The interface may change and it has +not been adequately tested. + +Feedback is most welcome, including constructive criticism. +Bug reports should be made using L or by email. + +When submitting a bug report, please include the output from running: + + perl -V + perl -MDevel::CheckLib -e0 + +=head1 SEE ALSO + +L + +L + +=head1 AUTHORS + +David Cantrell Edavid@cantrell.org.ukE + +David Golden Edagolden@cpan.orgE + +Thanks to the cpan-testers-discuss mailing list for prompting us to write it +in the first place; + +to Chris Williams for help with Borland support. + +=head1 COPYRIGHT and LICENCE + +Copyright 2007 David Cantrell. Portions copyright 2007 David Golden. + +This module is free-as-in-speech software, and may be used, distributed, +and modified under the same conditions as perl itself. + +=head1 CONSPIRACY + +This module is also free-as-in-mason software. + +=cut + +1; diff --git a/perl/ppport.h b/perl/ppport.h new file mode 100644 index 0000000..63a8cb1 --- /dev/null +++ b/perl/ppport.h @@ -0,0 +1,5097 @@ +#if 0 +<<'SKIP'; +#endif +/* +---------------------------------------------------------------------- + + ppport.h -- Perl/Pollution/Portability Version 3.06_01 + + Automatically created by Devel::PPPort running under + perl 5.008008 on Fri Nov 14 08:58:38 2008. + + Do NOT edit this file directly! -- Edit PPPort_pm.PL and the + includes in parts/inc/ instead. + + Use 'perldoc ppport.h' to view the documentation below. + +---------------------------------------------------------------------- + +SKIP + +=pod + +=head1 NAME + +ppport.h - Perl/Pollution/Portability version 3.06_01 + +=head1 SYNOPSIS + + perl ppport.h [options] [source files] + + Searches current directory for files if no [source files] are given + + --help show short help + + --patch=file write one patch file with changes + --copy=suffix write changed copies with suffix + --diff=program use diff program and options + + --compat-version=version provide compatibility with Perl version + --cplusplus accept C++ comments + + --quiet don't output anything except fatal errors + --nodiag don't show diagnostics + --nohints don't show hints + --nochanges don't suggest changes + --nofilter don't filter input files + + --list-provided list provided API + --list-unsupported list unsupported API + --api-info=name show Perl API portability information + +=head1 COMPATIBILITY + +This version of F is designed to support operation with Perl +installations back to 5.003, and has been tested up to 5.9.3. + +=head1 OPTIONS + +=head2 --help + +Display a brief usage summary. + +=head2 --patch=I + +If this option is given, a single patch file will be created if +any changes are suggested. This requires a working diff program +to be installed on your system. + +=head2 --copy=I + +If this option is given, a copy of each file will be saved with +the given suffix that contains the suggested changes. This does +not require any external programs. + +If neither C<--patch> or C<--copy> are given, the default is to +simply print the diffs for each file. This requires either +C or a C program to be installed. + +=head2 --diff=I + +Manually set the diff program and options to use. The default +is to use C, when installed, and output unified +context diffs. + +=head2 --compat-version=I + +Tell F to check for compatibility with the given +Perl version. The default is to check for compatibility with Perl +version 5.003. You can use this option to reduce the output +of F if you intend to be backward compatible only +up to a certain Perl version. + +=head2 --cplusplus + +Usually, F will detect C++ style comments and +replace them with C style comments for portability reasons. +Using this option instructs F to leave C++ +comments untouched. + +=head2 --quiet + +Be quiet. Don't print anything except fatal errors. + +=head2 --nodiag + +Don't output any diagnostic messages. Only portability +alerts will be printed. + +=head2 --nohints + +Don't output any hints. Hints often contain useful portability +notes. + +=head2 --nochanges + +Don't suggest any changes. Only give diagnostic output and hints +unless these are also deactivated. + +=head2 --nofilter + +Don't filter the list of input files. By default, files not looking +like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped. + +=head2 --list-provided + +Lists the API elements for which compatibility is provided by +F. Also lists if it must be explicitly requested, +if it has dependencies, and if there are hints for it. + +=head2 --list-unsupported + +Lists the API elements that are known not to be supported by +F and below which version of Perl they probably +won't be available or work. + +=head2 --api-info=I + +Show portability information for API elements matching I. +If I is surrounded by slashes, it is interpreted as a regular +expression. + +=head1 DESCRIPTION + +In order for a Perl extension (XS) module to be as portable as possible +across differing versions of Perl itself, certain steps need to be taken. + +=over 4 + +=item * + +Including this header is the first major one. This alone will give you +access to a large part of the Perl API that hasn't been available in +earlier Perl releases. Use + + perl ppport.h --list-provided + +to see which API elements are provided by ppport.h. + +=item * + +You should avoid using deprecated parts of the API. For example, using +global Perl variables without the C prefix is deprecated. Also, +some API functions used to have a C prefix. Using this form is +also deprecated. You can safely use the supported API, as F +will provide wrappers for older Perl versions. + +=item * + +If you use one of a few functions that were not present in earlier +versions of Perl, and that can't be provided using a macro, you have +to explicitly request support for these functions by adding one or +more C<#define>s in your source code before the inclusion of F. + +These functions will be marked C in the list shown by +C<--list-provided>. + +Depending on whether you module has a single or multiple files that +use such functions, you want either C or global variants. + +For a C function, use: + + #define NEED_function + +For a global function, use: + + #define NEED_function_GLOBAL + +Note that you mustn't have more than one global request for one +function in your project. + + Function Static Request Global Request + ----------------------------------------------------------------------------------------- + eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL + grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL + grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL + grok_number() NEED_grok_number NEED_grok_number_GLOBAL + grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL + grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL + newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL + newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL + sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL + sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL + sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL + sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL + sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL + sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL + vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL + +To avoid namespace conflicts, you can change the namespace of the +explicitly exported functions using the C macro. +Just C<#define> the macro before including C: + + #define DPPP_NAMESPACE MyOwnNamespace_ + #include "ppport.h" + +The default namespace is C. + +=back + +The good thing is that most of the above can be checked by running +F on your source code. See the next section for +details. + +=head1 EXAMPLES + +To verify whether F is needed for your module, whether you +should make any changes to your code, and whether any special defines +should be used, F can be run as a Perl script to check your +source code. Simply say: + + perl ppport.h + +The result will usually be a list of patches suggesting changes +that should at least be acceptable, if not necessarily the most +efficient solution, or a fix for all possible problems. + +If you know that your XS module uses features only available in +newer Perl releases, if you're aware that it uses C++ comments, +and if you want all suggestions as a single patch file, you could +use something like this: + + perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff + +If you only want your code to be scanned without any suggestions +for changes, use: + + perl ppport.h --nochanges + +You can specify a different C program or options, using +the C<--diff> option: + + perl ppport.h --diff='diff -C 10' + +This would output context diffs with 10 lines of context. + +To display portability information for the C function, +use: + + perl ppport.h --api-info=newSVpvn + +Since the argument to C<--api-info> can be a regular expression, +you can use + + perl ppport.h --api-info=/_nomg$/ + +to display portability information for all C<_nomg> functions or + + perl ppport.h --api-info=/./ + +to display information for all known API elements. + +=head1 BUGS + +If this version of F is causing failure during +the compilation of this module, please check if newer versions +of either this module or C are available on CPAN +before sending a bug report. + +If F was generated using the latest version of +C and is causing failure of this module, please +file a bug report using the CPAN Request Tracker at L. + +Please include the following information: + +=over 4 + +=item 1. + +The complete output from running "perl -V" + +=item 2. + +This file. + +=item 3. + +The name and version of the module you were trying to build. + +=item 4. + +A full log of the build that failed. + +=item 5. + +Any other information that you think could be relevant. + +=back + +For the latest version of this code, please get the C +module from CPAN. + +=head1 COPYRIGHT + +Version 3.x, Copyright (c) 2004-2005, Marcus Holland-Moritz. + +Version 2.x, Copyright (C) 2001, Paul Marquess. + +Version 1.x, Copyright (C) 1999, Kenneth Albanowski. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +See L. + +=cut + +use strict; + +my %opt = ( + quiet => 0, + diag => 1, + hints => 1, + changes => 1, + cplusplus => 0, + filter => 1, +); + +my($ppport) = $0 =~ /([\w.]+)$/; +my $LF = '(?:\r\n|[\r\n])'; # line feed +my $HS = "[ \t]"; # horizontal whitespace + +eval { + require Getopt::Long; + Getopt::Long::GetOptions(\%opt, qw( + help quiet diag! filter! hints! changes! cplusplus + patch=s copy=s diff=s compat-version=s + list-provided list-unsupported api-info=s + )) or usage(); +}; + +if ($@ and grep /^-/, @ARGV) { + usage() if "@ARGV" =~ /^--?h(?:elp)?$/; + die "Getopt::Long not found. Please don't use any options.\n"; +} + +usage() if $opt{help}; + +if (exists $opt{'compat-version'}) { + my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) }; + if ($@) { + die "Invalid version number format: '$opt{'compat-version'}'\n"; + } + die "Only Perl 5 is supported\n" if $r != 5; + die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000; + $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s; +} +else { + $opt{'compat-version'} = 5; +} + +# Never use C comments in this file!!!!! +my $ccs = '/'.'*'; +my $cce = '*'.'/'; +my $rccs = quotemeta $ccs; +my $rcce = quotemeta $cce; + +my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/ + ? ( $1 => { + ($2 ? ( base => $2 ) : ()), + ($3 ? ( todo => $3 ) : ()), + (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()), + (index($4, 'p') >= 0 ? ( provided => 1 ) : ()), + (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()), + } ) + : die "invalid spec: $_" } qw( +AvFILLp|5.004050||p +AvFILL||| +CLASS|||n +CX_CURPAD_SAVE||| +CX_CURPAD_SV||| +CopFILEAV|5.006000||p +CopFILEGV_set|5.006000||p +CopFILEGV|5.006000||p +CopFILESV|5.006000||p +CopFILE_set|5.006000||p +CopFILE|5.006000||p +CopSTASHPV_set|5.006000||p +CopSTASHPV|5.006000||p +CopSTASH_eq|5.006000||p +CopSTASH_set|5.006000||p +CopSTASH|5.006000||p +CopyD|5.009002||p +Copy||| +CvPADLIST||| +CvSTASH||| +CvWEAKOUTSIDE||| +DEFSV|5.004050||p +END_EXTERN_C|5.005000||p +ENTER||| +ERRSV|5.004050||p +EXTEND||| +EXTERN_C|5.005000||p +FREETMPS||| +GIMME_V||5.004000|n +GIMME|||n +GROK_NUMERIC_RADIX|5.007002||p +G_ARRAY||| +G_DISCARD||| +G_EVAL||| +G_NOARGS||| +G_SCALAR||| +G_VOID||5.004000| +GetVars||| +GvSV||| +Gv_AMupdate||| +HEf_SVKEY||5.004000| +HeHASH||5.004000| +HeKEY||5.004000| +HeKLEN||5.004000| +HePV||5.004000| +HeSVKEY_force||5.004000| +HeSVKEY_set||5.004000| +HeSVKEY||5.004000| +HeVAL||5.004000| +HvNAME||| +INT2PTR|5.006000||p +IN_LOCALE_COMPILETIME|5.007002||p +IN_LOCALE_RUNTIME|5.007002||p +IN_LOCALE|5.007002||p +IN_PERL_COMPILETIME|5.008001||p +IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p +IS_NUMBER_INFINITY|5.007002||p +IS_NUMBER_IN_UV|5.007002||p +IS_NUMBER_NAN|5.007003||p +IS_NUMBER_NEG|5.007002||p +IS_NUMBER_NOT_INT|5.007002||p +IVSIZE|5.006000||p +IVTYPE|5.006000||p +IVdf|5.006000||p +LEAVE||| +LVRET||| +MARK||| +MY_CXT_CLONE|5.009002||p +MY_CXT_INIT|5.007003||p +MY_CXT|5.007003||p +MoveD|5.009002||p +Move||| +NEWSV||| +NOOP|5.005000||p +NUM2PTR|5.006000||p +NVTYPE|5.006000||p +NVef|5.006001||p +NVff|5.006001||p +NVgf|5.006001||p +Newc||| +Newz||| +New||| +Nullav||| +Nullch||| +Nullcv||| +Nullhv||| +Nullsv||| +ORIGMARK||| +PAD_BASE_SV||| +PAD_CLONE_VARS||| +PAD_COMPNAME_FLAGS||| +PAD_COMPNAME_GEN_set||| +PAD_COMPNAME_GEN||| +PAD_COMPNAME_OURSTASH||| +PAD_COMPNAME_PV||| +PAD_COMPNAME_TYPE||| +PAD_RESTORE_LOCAL||| +PAD_SAVE_LOCAL||| +PAD_SAVE_SETNULLPAD||| +PAD_SETSV||| +PAD_SET_CUR_NOSAVE||| +PAD_SET_CUR||| +PAD_SVl||| +PAD_SV||| +PERL_BCDVERSION|5.009003||p +PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p +PERL_INT_MAX|5.004000||p +PERL_INT_MIN|5.004000||p +PERL_LONG_MAX|5.004000||p +PERL_LONG_MIN|5.004000||p +PERL_MAGIC_arylen|5.007002||p +PERL_MAGIC_backref|5.007002||p +PERL_MAGIC_bm|5.007002||p +PERL_MAGIC_collxfrm|5.007002||p +PERL_MAGIC_dbfile|5.007002||p +PERL_MAGIC_dbline|5.007002||p +PERL_MAGIC_defelem|5.007002||p +PERL_MAGIC_envelem|5.007002||p +PERL_MAGIC_env|5.007002||p +PERL_MAGIC_ext|5.007002||p +PERL_MAGIC_fm|5.007002||p +PERL_MAGIC_glob|5.007002||p +PERL_MAGIC_isaelem|5.007002||p +PERL_MAGIC_isa|5.007002||p +PERL_MAGIC_mutex|5.007002||p +PERL_MAGIC_nkeys|5.007002||p +PERL_MAGIC_overload_elem|5.007002||p +PERL_MAGIC_overload_table|5.007002||p +PERL_MAGIC_overload|5.007002||p +PERL_MAGIC_pos|5.007002||p +PERL_MAGIC_qr|5.007002||p +PERL_MAGIC_regdata|5.007002||p +PERL_MAGIC_regdatum|5.007002||p +PERL_MAGIC_regex_global|5.007002||p +PERL_MAGIC_shared_scalar|5.007003||p +PERL_MAGIC_shared|5.007003||p +PERL_MAGIC_sigelem|5.007002||p +PERL_MAGIC_sig|5.007002||p +PERL_MAGIC_substr|5.007002||p +PERL_MAGIC_sv|5.007002||p +PERL_MAGIC_taint|5.007002||p +PERL_MAGIC_tiedelem|5.007002||p +PERL_MAGIC_tiedscalar|5.007002||p +PERL_MAGIC_tied|5.007002||p +PERL_MAGIC_utf8|5.008001||p +PERL_MAGIC_uvar_elem|5.007003||p +PERL_MAGIC_uvar|5.007002||p +PERL_MAGIC_vec|5.007002||p +PERL_MAGIC_vstring|5.008001||p +PERL_QUAD_MAX|5.004000||p +PERL_QUAD_MIN|5.004000||p +PERL_REVISION|5.006000||p +PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p +PERL_SCAN_DISALLOW_PREFIX|5.007003||p +PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p +PERL_SCAN_SILENT_ILLDIGIT|5.008001||p +PERL_SHORT_MAX|5.004000||p +PERL_SHORT_MIN|5.004000||p +PERL_SUBVERSION|5.006000||p +PERL_UCHAR_MAX|5.004000||p +PERL_UCHAR_MIN|5.004000||p +PERL_UINT_MAX|5.004000||p +PERL_UINT_MIN|5.004000||p +PERL_ULONG_MAX|5.004000||p +PERL_ULONG_MIN|5.004000||p +PERL_UNUSED_DECL|5.007002||p +PERL_UQUAD_MAX|5.004000||p +PERL_UQUAD_MIN|5.004000||p +PERL_USHORT_MAX|5.004000||p +PERL_USHORT_MIN|5.004000||p +PERL_VERSION|5.006000||p +PL_DBsingle|||pn +PL_DBsub|||pn +PL_DBtrace|||n +PL_Sv|5.005000||p +PL_compiling|5.004050||p +PL_copline|5.005000||p +PL_curcop|5.004050||p +PL_curstash|5.004050||p +PL_debstash|5.004050||p +PL_defgv|5.004050||p +PL_diehook|5.004050||p +PL_dirty|5.004050||p +PL_dowarn|||pn +PL_errgv|5.004050||p +PL_hexdigit|5.005000||p +PL_hints|5.005000||p +PL_last_in_gv|||n +PL_modglobal||5.005000|n +PL_na|5.004050||pn +PL_no_modify|5.006000||p +PL_ofs_sv|||n +PL_perl_destruct_level|5.004050||p +PL_perldb|5.004050||p +PL_ppaddr|5.006000||p +PL_rsfp_filters|5.004050||p +PL_rsfp|5.004050||p +PL_rs|||n +PL_stack_base|5.004050||p +PL_stack_sp|5.004050||p +PL_stdingv|5.004050||p +PL_sv_arenaroot|5.004050||p +PL_sv_no|5.004050||pn +PL_sv_undef|5.004050||pn +PL_sv_yes|5.004050||pn +PL_tainted|5.004050||p +PL_tainting|5.004050||p +POPi|||n +POPl|||n +POPn|||n +POPpbytex||5.007001|n +POPpx||5.005030|n +POPp|||n +POPs|||n +PTR2IV|5.006000||p +PTR2NV|5.006000||p +PTR2UV|5.006000||p +PTR2ul|5.007001||p +PTRV|5.006000||p +PUSHMARK||| +PUSHi||| +PUSHmortal|5.009002||p +PUSHn||| +PUSHp||| +PUSHs||| +PUSHu|5.004000||p +PUTBACK||| +PerlIO_clearerr||5.007003| +PerlIO_close||5.007003| +PerlIO_eof||5.007003| +PerlIO_error||5.007003| +PerlIO_fileno||5.007003| +PerlIO_fill||5.007003| +PerlIO_flush||5.007003| +PerlIO_get_base||5.007003| +PerlIO_get_bufsiz||5.007003| +PerlIO_get_cnt||5.007003| +PerlIO_get_ptr||5.007003| +PerlIO_read||5.007003| +PerlIO_seek||5.007003| +PerlIO_set_cnt||5.007003| +PerlIO_set_ptrcnt||5.007003| +PerlIO_setlinebuf||5.007003| +PerlIO_stderr||5.007003| +PerlIO_stdin||5.007003| +PerlIO_stdout||5.007003| +PerlIO_tell||5.007003| +PerlIO_unread||5.007003| +PerlIO_write||5.007003| +Poison|5.008000||p +RETVAL|||n +Renewc||| +Renew||| +SAVECLEARSV||| +SAVECOMPPAD||| +SAVEPADSV||| +SAVETMPS||| +SAVE_DEFSV|5.004050||p +SPAGAIN||| +SP||| +START_EXTERN_C|5.005000||p +START_MY_CXT|5.007003||p +STMT_END|||p +STMT_START|||p +ST||| +SVt_IV||| +SVt_NV||| +SVt_PVAV||| +SVt_PVCV||| +SVt_PVHV||| +SVt_PVMG||| +SVt_PV||| +Safefree||| +Slab_Alloc||| +Slab_Free||| +StructCopy||| +SvCUR_set||| +SvCUR||| +SvEND||| +SvGETMAGIC|5.004050||p +SvGROW||| +SvIOK_UV||5.006000| +SvIOK_notUV||5.006000| +SvIOK_off||| +SvIOK_only_UV||5.006000| +SvIOK_only||| +SvIOK_on||| +SvIOKp||| +SvIOK||| +SvIVX||| +SvIV_nomg|5.009001||p +SvIV_set||| +SvIVx||| +SvIV||| +SvIsCOW_shared_hash||5.008003| +SvIsCOW||5.008003| +SvLEN_set||| +SvLEN||| +SvLOCK||5.007003| +SvMAGIC_set||5.009003| +SvNIOK_off||| +SvNIOKp||| +SvNIOK||| +SvNOK_off||| +SvNOK_only||| +SvNOK_on||| +SvNOKp||| +SvNOK||| +SvNVX||| +SvNV_set||| +SvNVx||| +SvNV||| +SvOK||| +SvOOK||| +SvPOK_off||| +SvPOK_only_UTF8||5.006000| +SvPOK_only||| +SvPOK_on||| +SvPOKp||| +SvPOK||| +SvPVX||| +SvPV_force_nomg|5.007002||p +SvPV_force||| +SvPV_nolen|5.006000||p +SvPV_nomg|5.007002||p +SvPV_set||| +SvPVbyte_force||5.009002| +SvPVbyte_nolen||5.006000| +SvPVbytex_force||5.006000| +SvPVbytex||5.006000| +SvPVbyte|5.006000||p +SvPVutf8_force||5.006000| +SvPVutf8_nolen||5.006000| +SvPVutf8x_force||5.006000| +SvPVutf8x||5.006000| +SvPVutf8||5.006000| +SvPVx||| +SvPV||| +SvREFCNT_dec||| +SvREFCNT_inc||| +SvREFCNT||| +SvROK_off||| +SvROK_on||| +SvROK||| +SvRV_set||5.009003| +SvRV||| +SvSETMAGIC||| +SvSHARE||5.007003| +SvSTASH_set||5.009003| +SvSTASH||| +SvSetMagicSV_nosteal||5.004000| +SvSetMagicSV||5.004000| +SvSetSV_nosteal||5.004000| +SvSetSV||| +SvTAINTED_off||5.004000| +SvTAINTED_on||5.004000| +SvTAINTED||5.004000| +SvTAINT||| +SvTRUE||| +SvTYPE||| +SvUNLOCK||5.007003| +SvUOK||5.007001| +SvUPGRADE||| +SvUTF8_off||5.006000| +SvUTF8_on||5.006000| +SvUTF8||5.006000| +SvUVXx|5.004000||p +SvUVX|5.004000||p +SvUV_nomg|5.009001||p +SvUV_set||5.009003| +SvUVx|5.004000||p +SvUV|5.004000||p +SvVOK||5.008001| +THIS|||n +UNDERBAR|5.009002||p +UVSIZE|5.006000||p +UVTYPE|5.006000||p +UVXf|5.007001||p +UVof|5.006000||p +UVuf|5.006000||p +UVxf|5.006000||p +XCPT_CATCH|5.009002||p +XCPT_RETHROW|5.009002||p +XCPT_TRY_END|5.009002||p +XCPT_TRY_START|5.009002||p +XPUSHi||| +XPUSHmortal|5.009002||p +XPUSHn||| +XPUSHp||| +XPUSHs||| +XPUSHu|5.004000||p +XSRETURN_EMPTY||| +XSRETURN_IV||| +XSRETURN_NO||| +XSRETURN_NV||| +XSRETURN_PV||| +XSRETURN_UNDEF||| +XSRETURN_UV|5.008001||p +XSRETURN_YES||| +XSRETURN||| +XST_mIV||| +XST_mNO||| +XST_mNV||| +XST_mPV||| +XST_mUNDEF||| +XST_mUV|5.008001||p +XST_mYES||| +XS_VERSION_BOOTCHECK||| +XS_VERSION||| +XS||| +ZeroD|5.009002||p +Zero||| +_aMY_CXT|5.007003||p +_pMY_CXT|5.007003||p +aMY_CXT_|5.007003||p +aMY_CXT|5.007003||p +aTHX_|5.006000||p +aTHX|5.006000||p +add_data||| +allocmy||| +amagic_call||| +any_dup||| +ao||| +append_elem||| +append_list||| +apply_attrs_my||| +apply_attrs_string||5.006001| +apply_attrs||| +apply||| +asIV||| +asUV||| +atfork_lock||5.007003|n +atfork_unlock||5.007003|n +av_arylen_p||5.009003| +av_clear||| +av_delete||5.006000| +av_exists||5.006000| +av_extend||| +av_fake||| +av_fetch||| +av_fill||| +av_len||| +av_make||| +av_pop||| +av_push||| +av_reify||| +av_shift||| +av_store||| +av_undef||| +av_unshift||| +ax|||n +bad_type||| +bind_match||| +block_end||| +block_gimme||5.004000| +block_start||| +boolSV|5.004000||p +boot_core_PerlIO||| +boot_core_UNIVERSAL||| +boot_core_xsutils||| +bytes_from_utf8||5.007001| +bytes_to_utf8||5.006001| +cache_re||| +call_argv|5.006000||p +call_atexit||5.006000| +call_body||| +call_list_body||| +call_list||5.004000| +call_method|5.006000||p +call_pv|5.006000||p +call_sv|5.006000||p +calloc||5.007002|n +cando||| +cast_i32||5.006000| +cast_iv||5.006000| +cast_ulong||5.006000| +cast_uv||5.006000| +check_uni||| +checkcomma||| +checkposixcc||| +ck_anoncode||| +ck_bitop||| +ck_concat||| +ck_defined||| +ck_delete||| +ck_die||| +ck_eof||| +ck_eval||| +ck_exec||| +ck_exists||| +ck_exit||| +ck_ftst||| +ck_fun||| +ck_glob||| +ck_grep||| +ck_index||| +ck_join||| +ck_lengthconst||| +ck_lfun||| +ck_listiob||| +ck_match||| +ck_method||| +ck_null||| +ck_open||| +ck_repeat||| +ck_require||| +ck_retarget||| +ck_return||| +ck_rfun||| +ck_rvconst||| +ck_sassign||| +ck_select||| +ck_shift||| +ck_sort||| +ck_spair||| +ck_split||| +ck_subr||| +ck_substr||| +ck_svconst||| +ck_trunc||| +ck_unpack||| +cl_and||| +cl_anything||| +cl_init_zero||| +cl_init||| +cl_is_anything||| +cl_or||| +closest_cop||| +convert||| +cop_free||| +cr_textfilter||| +croak_nocontext|||vn +croak|||v +csighandler||5.007001|n +custom_op_desc||5.007003| +custom_op_name||5.007003| +cv_ckproto||| +cv_clone||| +cv_const_sv||5.004000| +cv_dump||| +cv_undef||| +cx_dump||5.005000| +cx_dup||| +cxinc||| +dAXMARK||5.009003| +dAX|5.007002||p +dITEMS|5.007002||p +dMARK||| +dMY_CXT_SV|5.007003||p +dMY_CXT|5.007003||p +dNOOP|5.006000||p +dORIGMARK||| +dSP||| +dTHR|5.004050||p +dTHXa|5.006000||p +dTHXoa|5.006000||p +dTHX|5.006000||p +dUNDERBAR|5.009002||p +dXCPT|5.009002||p +dXSARGS||| +dXSI32||| +dXSTARG|5.006000||p +deb_curcv||| +deb_nocontext|||vn +deb_stack_all||| +deb_stack_n||| +debop||5.005000| +debprofdump||5.005000| +debprof||| +debstackptrs||5.007003| +debstack||5.007003| +deb||5.007003|v +del_he||| +del_sv||| +delimcpy||5.004000| +depcom||| +deprecate_old||| +deprecate||| +despatch_signals||5.007001| +die_nocontext|||vn +die_where||| +die|||v +dirp_dup||| +div128||| +djSP||| +do_aexec5||| +do_aexec||| +do_aspawn||| +do_binmode||5.004050| +do_chomp||| +do_chop||| +do_close||| +do_dump_pad||| +do_eof||| +do_exec3||| +do_execfree||| +do_exec||| +do_gv_dump||5.006000| +do_gvgv_dump||5.006000| +do_hv_dump||5.006000| +do_ipcctl||| +do_ipcget||| +do_join||| +do_kv||| +do_magic_dump||5.006000| +do_msgrcv||| +do_msgsnd||| +do_oddball||| +do_op_dump||5.006000| +do_open9||5.006000| +do_openn||5.007001| +do_open||5.004000| +do_pipe||| +do_pmop_dump||5.006000| +do_print||| +do_readline||| +do_seek||| +do_semop||| +do_shmio||| +do_spawn_nowait||| +do_spawn||| +do_sprintf||| +do_sv_dump||5.006000| +do_sysseek||| +do_tell||| +do_trans_complex_utf8||| +do_trans_complex||| +do_trans_count_utf8||| +do_trans_count||| +do_trans_simple_utf8||| +do_trans_simple||| +do_trans||| +do_vecget||| +do_vecset||| +do_vop||| +docatch_body||| +docatch||| +doeval||| +dofile||| +dofindlabel||| +doform||| +doing_taint||5.008001|n +dooneliner||| +doopen_pm||| +doparseform||| +dopoptoeval||| +dopoptolabel||| +dopoptoloop||| +dopoptosub_at||| +dopoptosub||| +dounwind||| +dowantarray||| +dump_all||5.006000| +dump_eval||5.006000| +dump_fds||| +dump_form||5.006000| +dump_indent||5.006000|v +dump_mstats||| +dump_packsubs||5.006000| +dump_sub||5.006000| +dump_vindent||5.006000| +dumpuntil||| +dup_attrlist||| +emulate_eaccess||| +eval_pv|5.006000||p +eval_sv|5.006000||p +expect_number||| +fbm_compile||5.005000| +fbm_instr||5.005000| +fd_on_nosuid_fs||| +filter_add||| +filter_del||| +filter_gets||| +filter_read||| +find_beginning||| +find_byclass||| +find_in_my_stash||| +find_runcv||| +find_rundefsvoffset||5.009002| +find_script||| +find_uninit_var||| +fold_constants||| +forbid_setid||| +force_ident||| +force_list||| +force_next||| +force_version||| +force_word||| +form_nocontext|||vn +form||5.004000|v +fp_dup||| +fprintf_nocontext|||vn +free_global_struct||| +free_tied_hv_pool||| +free_tmps||| +gen_constant_list||| +get_av|5.006000||p +get_context||5.006000|n +get_cv|5.006000||p +get_db_sub||| +get_debug_opts||| +get_hash_seed||| +get_hv|5.006000||p +get_mstats||| +get_no_modify||| +get_num||| +get_op_descs||5.005000| +get_op_names||5.005000| +get_opargs||| +get_ppaddr||5.006000| +get_sv|5.006000||p +get_vtbl||5.005030| +getcwd_sv||5.007002| +getenv_len||| +gp_dup||| +gp_free||| +gp_ref||| +grok_bin|5.007003||p +grok_hex|5.007003||p +grok_number|5.007002||p +grok_numeric_radix|5.007002||p +grok_oct|5.007003||p +group_end||| +gv_AVadd||| +gv_HVadd||| +gv_IOadd||| +gv_autoload4||5.004000| +gv_check||| +gv_dump||5.006000| +gv_efullname3||5.004000| +gv_efullname4||5.006001| +gv_efullname||| +gv_ename||| +gv_fetchfile||| +gv_fetchmeth_autoload||5.007003| +gv_fetchmethod_autoload||5.004000| +gv_fetchmethod||| +gv_fetchmeth||| +gv_fetchpvn_flags||5.009002| +gv_fetchpv||| +gv_fetchsv||5.009002| +gv_fullname3||5.004000| +gv_fullname4||5.006001| +gv_fullname||| +gv_handler||5.007001| +gv_init_sv||| +gv_init||| +gv_share||| +gv_stashpvn|5.006000||p +gv_stashpv||| +gv_stashsv||| +he_dup||| +hek_dup||| +hfreeentries||| +hsplit||| +hv_assert||5.009001| +hv_auxinit||| +hv_clear_placeholders||5.009001| +hv_clear||| +hv_delayfree_ent||5.004000| +hv_delete_common||| +hv_delete_ent||5.004000| +hv_delete||| +hv_eiter_p||5.009003| +hv_eiter_set||5.009003| +hv_exists_ent||5.004000| +hv_exists||| +hv_fetch_common||| +hv_fetch_ent||5.004000| +hv_fetch||| +hv_free_ent||5.004000| +hv_iterinit||| +hv_iterkeysv||5.004000| +hv_iterkey||| +hv_iternext_flags||5.008000| +hv_iternextsv||| +hv_iternext||| +hv_iterval||| +hv_ksplit||5.004000| +hv_magic_check||| +hv_magic||| +hv_name_set||5.009003| +hv_notallowed||| +hv_placeholders_get||5.009003| +hv_placeholders_p||5.009003| +hv_placeholders_set||5.009003| +hv_riter_p||5.009003| +hv_riter_set||5.009003| +hv_scalar||5.009001| +hv_store_ent||5.004000| +hv_store_flags||5.008000| +hv_store||| +hv_undef||| +ibcmp_locale||5.004000| +ibcmp_utf8||5.007003| +ibcmp||| +incl_perldb||| +incline||| +incpush||| +ingroup||| +init_argv_symbols||| +init_debugger||| +init_global_struct||| +init_i18nl10n||5.006000| +init_i18nl14n||5.006000| +init_ids||| +init_interp||| +init_lexer||| +init_main_stash||| +init_perllib||| +init_postdump_symbols||| +init_predump_symbols||| +init_stacks||5.005000| +init_tm||5.007002| +instr||| +intro_my||| +intuit_method||| +intuit_more||| +invert||| +io_close||| +isALNUM||| +isALPHA||| +isDIGIT||| +isLOWER||| +isSPACE||| +isUPPER||| +is_an_int||| +is_gv_magical_sv||| +is_gv_magical||| +is_handle_constructor||| +is_list_assignment||| +is_lvalue_sub||5.007001| +is_uni_alnum_lc||5.006000| +is_uni_alnumc_lc||5.006000| +is_uni_alnumc||5.006000| +is_uni_alnum||5.006000| +is_uni_alpha_lc||5.006000| +is_uni_alpha||5.006000| +is_uni_ascii_lc||5.006000| +is_uni_ascii||5.006000| +is_uni_cntrl_lc||5.006000| +is_uni_cntrl||5.006000| +is_uni_digit_lc||5.006000| +is_uni_digit||5.006000| +is_uni_graph_lc||5.006000| +is_uni_graph||5.006000| +is_uni_idfirst_lc||5.006000| +is_uni_idfirst||5.006000| +is_uni_lower_lc||5.006000| +is_uni_lower||5.006000| +is_uni_print_lc||5.006000| +is_uni_print||5.006000| +is_uni_punct_lc||5.006000| +is_uni_punct||5.006000| +is_uni_space_lc||5.006000| +is_uni_space||5.006000| +is_uni_upper_lc||5.006000| +is_uni_upper||5.006000| +is_uni_xdigit_lc||5.006000| +is_uni_xdigit||5.006000| +is_utf8_alnumc||5.006000| +is_utf8_alnum||5.006000| +is_utf8_alpha||5.006000| +is_utf8_ascii||5.006000| +is_utf8_char_slow||| +is_utf8_char||5.006000| +is_utf8_cntrl||5.006000| +is_utf8_digit||5.006000| +is_utf8_graph||5.006000| +is_utf8_idcont||5.008000| +is_utf8_idfirst||5.006000| +is_utf8_lower||5.006000| +is_utf8_mark||5.006000| +is_utf8_print||5.006000| +is_utf8_punct||5.006000| +is_utf8_space||5.006000| +is_utf8_string_loclen||5.009003| +is_utf8_string_loc||5.008001| +is_utf8_string||5.006001| +is_utf8_upper||5.006000| +is_utf8_xdigit||5.006000| +isa_lookup||| +items|||n +ix|||n +jmaybe||| +keyword||| +leave_scope||| +lex_end||| +lex_start||| +linklist||| +listkids||| +list||| +load_module_nocontext|||vn +load_module||5.006000|v +localize||| +looks_like_number||| +lop||| +mPUSHi|5.009002||p +mPUSHn|5.009002||p +mPUSHp|5.009002||p +mPUSHu|5.009002||p +mXPUSHi|5.009002||p +mXPUSHn|5.009002||p +mXPUSHp|5.009002||p +mXPUSHu|5.009002||p +magic_clear_all_env||| +magic_clearenv||| +magic_clearpack||| +magic_clearsig||| +magic_dump||5.006000| +magic_existspack||| +magic_freearylen_p||| +magic_freeovrld||| +magic_freeregexp||| +magic_getarylen||| +magic_getdefelem||| +magic_getglob||| +magic_getnkeys||| +magic_getpack||| +magic_getpos||| +magic_getsig||| +magic_getsubstr||| +magic_gettaint||| +magic_getuvar||| +magic_getvec||| +magic_get||| +magic_killbackrefs||| +magic_len||| +magic_methcall||| +magic_methpack||| +magic_nextpack||| +magic_regdata_cnt||| +magic_regdatum_get||| +magic_regdatum_set||| +magic_scalarpack||| +magic_set_all_env||| +magic_setamagic||| +magic_setarylen||| +magic_setbm||| +magic_setcollxfrm||| +magic_setdbline||| +magic_setdefelem||| +magic_setenv||| +magic_setfm||| +magic_setglob||| +magic_setisa||| +magic_setmglob||| +magic_setnkeys||| +magic_setpack||| +magic_setpos||| +magic_setregexp||| +magic_setsig||| +magic_setsubstr||| +magic_settaint||| +magic_setutf8||| +magic_setuvar||| +magic_setvec||| +magic_set||| +magic_sizepack||| +magic_wipepack||| +magicname||| +make_trie||| +malloced_size|||n +malloc||5.007002|n +markstack_grow||| +measure_struct||| +memEQ|5.004000||p +memNE|5.004000||p +mem_collxfrm||| +mess_alloc||| +mess_nocontext|||vn +mess||5.006000|v +method_common||| +mfree||5.007002|n +mg_clear||| +mg_copy||| +mg_dup||| +mg_find||| +mg_free||| +mg_get||| +mg_length||5.005000| +mg_localize||| +mg_magical||| +mg_set||| +mg_size||5.005000| +mini_mktime||5.007002| +missingterm||| +mode_from_discipline||| +modkids||| +mod||| +moreswitches||| +mul128||| +mulexp10|||n +my_atof2||5.007002| +my_atof||5.006000| +my_attrs||| +my_bcopy|||n +my_betoh16|||n +my_betoh32|||n +my_betoh64|||n +my_betohi|||n +my_betohl|||n +my_betohs|||n +my_bzero|||n +my_chsize||| +my_exit_jump||| +my_exit||| +my_failure_exit||5.004000| +my_fflush_all||5.006000| +my_fork||5.007003|n +my_htobe16|||n +my_htobe32|||n +my_htobe64|||n +my_htobei|||n +my_htobel|||n +my_htobes|||n +my_htole16|||n +my_htole32|||n +my_htole64|||n +my_htolei|||n +my_htolel|||n +my_htoles|||n +my_htonl||| +my_kid||| +my_letoh16|||n +my_letoh32|||n +my_letoh64|||n +my_letohi|||n +my_letohl|||n +my_letohs|||n +my_lstat||| +my_memcmp||5.004000|n +my_memset|||n +my_ntohl||| +my_pclose||5.004000| +my_popen_list||5.007001| +my_popen||5.004000| +my_setenv||| +my_socketpair||5.007003|n +my_stat||| +my_strftime||5.007002| +my_swabn|||n +my_swap||| +my_unexec||| +my||| +newANONATTRSUB||5.006000| +newANONHASH||| +newANONLIST||| +newANONSUB||| +newASSIGNOP||| +newATTRSUB||5.006000| +newAVREF||| +newAV||| +newBINOP||| +newCONDOP||| +newCONSTSUB|5.006000||p +newCVREF||| +newDEFSVOP||| +newFORM||| +newFOROP||| +newGVOP||| +newGVREF||| +newGVgen||| +newHVREF||| +newHVhv||5.005000| +newHV||| +newIO||| +newLISTOP||| +newLOGOP||| +newLOOPEX||| +newLOOPOP||| +newMYSUB||5.006000| +newNULLLIST||| +newOP||| +newPADOP||5.006000| +newPMOP||| +newPROG||| +newPVOP||| +newRANGE||| +newRV_inc|5.004000||p +newRV_noinc|5.006000||p +newRV||| +newSLICEOP||| +newSTATEOP||| +newSUB||| +newSVOP||| +newSVREF||| +newSVhek||5.009003| +newSViv||| +newSVnv||| +newSVpvf_nocontext|||vn +newSVpvf||5.004000|v +newSVpvn_share||5.007001| +newSVpvn|5.006000||p +newSVpv||| +newSVrv||| +newSVsv||| +newSVuv|5.006000||p +newSV||| +newUNOP||| +newWHILEOP||5.009003| +newXSproto||5.006000| +newXS||5.006000| +new_collate||5.006000| +new_constant||| +new_ctype||5.006000| +new_he||| +new_logop||| +new_numeric||5.006000| +new_stackinfo||5.005000| +new_version||5.009000| +next_symbol||| +nextargv||| +nextchar||| +ninstr||| +no_bareword_allowed||| +no_fh_allowed||| +no_op||| +not_a_number||| +nothreadhook||5.008000| +nuke_stacks||| +num_overflow|||n +oopsAV||| +oopsCV||| +oopsHV||| +op_clear||| +op_const_sv||| +op_dump||5.006000| +op_free||| +op_null||5.007002| +op_refcnt_lock||5.009002| +op_refcnt_unlock||5.009002| +open_script||| +pMY_CXT_|5.007003||p +pMY_CXT|5.007003||p +pTHX_|5.006000||p +pTHX|5.006000||p +pack_cat||5.007003| +pack_rec||| +package||| +packlist||5.008001| +pad_add_anon||| +pad_add_name||| +pad_alloc||| +pad_block_start||| +pad_check_dup||| +pad_compname_type||| +pad_findlex||| +pad_findmy||| +pad_fixup_inner_anons||| +pad_free||| +pad_leavemy||| +pad_new||| +pad_push||| +pad_reset||| +pad_setsv||| +pad_sv||| +pad_swipe||| +pad_tidy||| +pad_undef||| +parse_body||| +parse_unicode_opts||| +path_is_absolute||| +peep||| +pending_ident||| +perl_alloc_using|||n +perl_alloc|||n +perl_clone_using|||n +perl_clone|||n +perl_construct|||n +perl_destruct||5.007003|n +perl_free|||n +perl_parse||5.006000|n +perl_run|||n +pidgone||| +pmflag||| +pmop_dump||5.006000| +pmruntime||| +pmtrans||| +pop_scope||| +pregcomp||| +pregexec||| +pregfree||| +prepend_elem||| +printf_nocontext|||vn +ptr_table_clear||| +ptr_table_fetch||| +ptr_table_free||| +ptr_table_new||| +ptr_table_split||| +ptr_table_store||| +push_scope||| +put_byte||| +pv_display||5.006000| +pv_uni_display||5.007003| +qerror||| +re_croak2||| +re_dup||| +re_intuit_start||5.006000| +re_intuit_string||5.006000| +realloc||5.007002|n +reentrant_free||| +reentrant_init||| +reentrant_retry|||vn +reentrant_size||| +refkids||| +refto||| +ref||| +reg_node||| +reganode||| +regatom||| +regbranch||| +regclass_swash||5.007003| +regclass||| +regcp_set_to||| +regcppop||| +regcppush||| +regcurly||| +regdump||5.005000| +regexec_flags||5.005000| +reghop3||| +reghopmaybe3||| +reghopmaybe||| +reghop||| +reginclass||| +reginitcolors||5.006000| +reginsert||| +regmatch||| +regnext||5.005000| +regoptail||| +regpiece||| +regpposixcc||| +regprop||| +regrepeat_hard||| +regrepeat||| +regtail||| +regtry||| +reguni||| +regwhite||| +reg||| +repeatcpy||| +report_evil_fh||| +report_uninit||| +require_errno||| +require_pv||5.006000| +rninstr||| +rsignal_restore||| +rsignal_save||| +rsignal_state||5.004000| +rsignal||5.004000| +run_body||| +runops_debug||5.005000| +runops_standard||5.005000| +rvpv_dup||| +rxres_free||| +rxres_restore||| +rxres_save||| +safesyscalloc||5.006000|n +safesysfree||5.006000|n +safesysmalloc||5.006000|n +safesysrealloc||5.006000|n +same_dirent||| +save_I16||5.004000| +save_I32||| +save_I8||5.006000| +save_aelem||5.004050| +save_alloc||5.006000| +save_aptr||| +save_ary||| +save_bool||5.008001| +save_clearsv||| +save_delete||| +save_destructor_x||5.006000| +save_destructor||5.006000| +save_freeop||| +save_freepv||| +save_freesv||| +save_generic_pvref||5.006001| +save_generic_svref||5.005030| +save_gp||5.004000| +save_hash||| +save_hek_flags||| +save_helem||5.004050| +save_hints||5.005000| +save_hptr||| +save_int||| +save_item||| +save_iv||5.005000| +save_lines||| +save_list||| +save_long||| +save_magic||| +save_mortalizesv||5.007001| +save_nogv||| +save_op||| +save_padsv||5.007001| +save_pptr||| +save_re_context||5.006000| +save_scalar_at||| +save_scalar||| +save_set_svflags||5.009000| +save_shared_pvref||5.007003| +save_sptr||| +save_svref||| +save_threadsv||5.005000| +save_vptr||5.006000| +savepvn||| +savepv||| +savesharedpv||5.007003| +savestack_grow_cnt||5.008001| +savestack_grow||| +savesvpv||5.009002| +sawparens||| +scalar_mod_type||| +scalarboolean||| +scalarkids||| +scalarseq||| +scalarvoid||| +scalar||| +scan_bin||5.006000| +scan_commit||| +scan_const||| +scan_formline||| +scan_heredoc||| +scan_hex||| +scan_ident||| +scan_inputsymbol||| +scan_num||5.007001| +scan_oct||| +scan_pat||| +scan_str||| +scan_subst||| +scan_trans||| +scan_version||5.009001| +scan_vstring||5.008001| +scan_word||| +scope||| +screaminstr||5.005000| +seed||| +set_context||5.006000|n +set_csh||| +set_numeric_local||5.006000| +set_numeric_radix||5.006000| +set_numeric_standard||5.006000| +setdefout||| +setenv_getix||| +share_hek_flags||| +share_hek||| +si_dup||| +sighandler|||n +simplify_sort||| +skipspace||| +sortsv||5.007003| +ss_dup||| +stack_grow||| +start_glob||| +start_subparse||5.004000| +stashpv_hvname_match||5.009003| +stdize_locale||| +strEQ||| +strGE||| +strGT||| +strLE||| +strLT||| +strNE||| +str_to_version||5.006000| +strnEQ||| +strnNE||| +study_chunk||| +sub_crush_depth||| +sublex_done||| +sublex_push||| +sublex_start||| +sv_2bool||| +sv_2cv||| +sv_2io||| +sv_2iuv_non_preserve||| +sv_2iv_flags||5.009001| +sv_2iv||| +sv_2mortal||| +sv_2nv||| +sv_2pv_flags||5.007002| +sv_2pv_nolen|5.006000||p +sv_2pvbyte_nolen||| +sv_2pvbyte|5.006000||p +sv_2pvutf8_nolen||5.006000| +sv_2pvutf8||5.006000| +sv_2pv||| +sv_2uv_flags||5.009001| +sv_2uv|5.004000||p +sv_add_arena||| +sv_add_backref||| +sv_backoff||| +sv_bless||| +sv_cat_decode||5.008001| +sv_catpv_mg|5.006000||p +sv_catpvf_mg_nocontext|||pvn +sv_catpvf_mg|5.006000|5.004000|pv +sv_catpvf_nocontext|||vn +sv_catpvf||5.004000|v +sv_catpvn_flags||5.007002| +sv_catpvn_mg|5.006000||p +sv_catpvn_nomg|5.007002||p +sv_catpvn||| +sv_catpv||| +sv_catsv_flags||5.007002| +sv_catsv_mg|5.006000||p +sv_catsv_nomg|5.007002||p +sv_catsv||| +sv_chop||| +sv_clean_all||| +sv_clean_objs||| +sv_clear||| +sv_cmp_locale||5.004000| +sv_cmp||| +sv_collxfrm||| +sv_compile_2op||5.008001| +sv_copypv||5.007003| +sv_dec||| +sv_del_backref||| +sv_derived_from||5.004000| +sv_dump||| +sv_dup||| +sv_eq||| +sv_force_normal_flags||5.007001| +sv_force_normal||5.006000| +sv_free2||| +sv_free_arenas||| +sv_free||| +sv_gets||5.004000| +sv_grow||| +sv_inc||| +sv_insert||| +sv_isa||| +sv_isobject||| +sv_iv||5.005000| +sv_len_utf8||5.006000| +sv_len||| +sv_magicext||5.007003| +sv_magic||| +sv_mortalcopy||| +sv_newmortal||| +sv_newref||| +sv_nolocking||5.007003| +sv_nosharing||5.007003| +sv_nounlocking||5.007003| +sv_nv||5.005000| +sv_peek||5.005000| +sv_pos_b2u||5.006000| +sv_pos_u2b||5.006000| +sv_pvbyten_force||5.006000| +sv_pvbyten||5.006000| +sv_pvbyte||5.006000| +sv_pvn_force_flags||5.007002| +sv_pvn_force|||p +sv_pvn_nomg|5.007003||p +sv_pvn|5.006000||p +sv_pvutf8n_force||5.006000| +sv_pvutf8n||5.006000| +sv_pvutf8||5.006000| +sv_pv||5.006000| +sv_recode_to_utf8||5.007003| +sv_reftype||| +sv_release_COW||| +sv_release_IVX||| +sv_replace||| +sv_report_used||| +sv_reset||| +sv_rvweaken||5.006000| +sv_setiv_mg|5.006000||p +sv_setiv||| +sv_setnv_mg|5.006000||p +sv_setnv||| +sv_setpv_mg|5.006000||p +sv_setpvf_mg_nocontext|||pvn +sv_setpvf_mg|5.006000|5.004000|pv +sv_setpvf_nocontext|||vn +sv_setpvf||5.004000|v +sv_setpviv_mg||5.008001| +sv_setpviv||5.008001| +sv_setpvn_mg|5.006000||p +sv_setpvn||| +sv_setpv||| +sv_setref_iv||| +sv_setref_nv||| +sv_setref_pvn||| +sv_setref_pv||| +sv_setref_uv||5.007001| +sv_setsv_cow||| +sv_setsv_flags||5.007002| +sv_setsv_mg|5.006000||p +sv_setsv_nomg|5.007002||p +sv_setsv||| +sv_setuv_mg|5.006000||p +sv_setuv|5.006000||p +sv_tainted||5.004000| +sv_taint||5.004000| +sv_true||5.005000| +sv_unglob||| +sv_uni_display||5.007003| +sv_unmagic||| +sv_unref_flags||5.007001| +sv_unref||| +sv_untaint||5.004000| +sv_upgrade||| +sv_usepvn_mg|5.006000||p +sv_usepvn||| +sv_utf8_decode||5.006000| +sv_utf8_downgrade||5.006000| +sv_utf8_encode||5.006000| +sv_utf8_upgrade_flags||5.007002| +sv_utf8_upgrade||5.007001| +sv_uv|5.006000||p +sv_vcatpvf_mg|5.006000|5.004000|p +sv_vcatpvfn||5.004000| +sv_vcatpvf|5.006000|5.004000|p +sv_vsetpvf_mg|5.006000|5.004000|p +sv_vsetpvfn||5.004000| +sv_vsetpvf|5.006000|5.004000|p +svtype||| +swallow_bom||| +swash_fetch||5.007002| +swash_init||5.006000| +sys_intern_clear||| +sys_intern_dup||| +sys_intern_init||| +taint_env||| +taint_proper||| +tmps_grow||5.006000| +toLOWER||| +toUPPER||| +to_byte_substr||| +to_uni_fold||5.007003| +to_uni_lower_lc||5.006000| +to_uni_lower||5.007003| +to_uni_title_lc||5.006000| +to_uni_title||5.007003| +to_uni_upper_lc||5.006000| +to_uni_upper||5.007003| +to_utf8_case||5.007003| +to_utf8_fold||5.007003| +to_utf8_lower||5.007003| +to_utf8_substr||| +to_utf8_title||5.007003| +to_utf8_upper||5.007003| +tokeq||| +tokereport||| +too_few_arguments||| +too_many_arguments||| +unlnk||| +unpack_rec||| +unpack_str||5.007003| +unpackstring||5.008001| +unshare_hek_or_pvn||| +unshare_hek||| +unsharepvn||5.004000| +upg_version||5.009000| +usage||| +utf16_textfilter||| +utf16_to_utf8_reversed||5.006001| +utf16_to_utf8||5.006001| +utf16rev_textfilter||| +utf8_distance||5.006000| +utf8_hop||5.006000| +utf8_length||5.007001| +utf8_mg_pos_init||| +utf8_mg_pos||| +utf8_to_bytes||5.006001| +utf8_to_uvchr||5.007001| +utf8_to_uvuni||5.007001| +utf8n_to_uvchr||5.007001| +utf8n_to_uvuni||5.007001| +utilize||| +uvchr_to_utf8_flags||5.007003| +uvchr_to_utf8||5.007001| +uvuni_to_utf8_flags||5.007003| +uvuni_to_utf8||5.007001| +validate_suid||| +varname||| +vcmp||5.009000| +vcroak||5.006000| +vdeb||5.007003| +vdie||| +vform||5.006000| +visit||| +vivify_defelem||| +vivify_ref||| +vload_module||5.006000| +vmess||5.006000| +vnewSVpvf|5.006000|5.004000|p +vnormal||5.009002| +vnumify||5.009000| +vstringify||5.009000| +vwarner||5.006000| +vwarn||5.006000| +wait4pid||| +warn_nocontext|||vn +warner_nocontext|||vn +warner||5.006000|v +warn|||v +watch||| +whichsig||| +write_to_stderr||| +yyerror||| +yylex||| +yyparse||| +yywarn||| +); + +if (exists $opt{'list-unsupported'}) { + my $f; + for $f (sort { lc $a cmp lc $b } keys %API) { + next unless $API{$f}{todo}; + print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n"; + } + exit 0; +} + +# Scan for possible replacement candidates + +my(%replace, %need, %hints, %depends); +my $replace = 0; +my $hint = ''; + +while () { + if ($hint) { + if (m{^\s*\*\s(.*?)\s*$}) { + $hints{$hint} ||= ''; # suppress warning with older perls + $hints{$hint} .= "$1\n"; + } + else { + $hint = ''; + } + } + $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$}; + + $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$}; + $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)}; + $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce}; + $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$}; + + if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) { + push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2; + } + + $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)}; +} + +if (exists $opt{'api-info'}) { + my $f; + my $count = 0; + my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$"; + for $f (sort { lc $a cmp lc $b } keys %API) { + next unless $f =~ /$match/; + print "\n=== $f ===\n\n"; + my $info = 0; + if ($API{$f}{base} || $API{$f}{todo}) { + my $base = format_version($API{$f}{base} || $API{$f}{todo}); + print "Supported at least starting from perl-$base.\n"; + $info++; + } + if ($API{$f}{provided}) { + my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003"; + print "Support by $ppport provided back to perl-$todo.\n"; + print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f}; + print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f}; + print "$hints{$f}" if exists $hints{$f}; + $info++; + } + unless ($info) { + print "No portability information available.\n"; + } + $count++; + } + if ($count > 0) { + print "\n"; + } + else { + print "Found no API matching '$opt{'api-info'}'.\n"; + } + exit 0; +} + +if (exists $opt{'list-provided'}) { + my $f; + for $f (sort { lc $a cmp lc $b } keys %API) { + next unless $API{$f}{provided}; + my @flags; + push @flags, 'explicit' if exists $need{$f}; + push @flags, 'depend' if exists $depends{$f}; + push @flags, 'hint' if exists $hints{$f}; + my $flags = @flags ? ' ['.join(', ', @flags).']' : ''; + print "$f$flags\n"; + } + exit 0; +} + +my @files; +my @srcext = qw( xs c h cc cpp ); +my $srcext = join '|', @srcext; + +if (@ARGV) { + my %seen; + @files = grep { -f && !exists $seen{$_} } map { glob $_ } @ARGV; +} +else { + eval { + require File::Find; + File::Find::find(sub { + $File::Find::name =~ /\.($srcext)$/i + and push @files, $File::Find::name; + }, '.'); + }; + if ($@) { + @files = map { glob "*.$_" } @srcext; + } +} + +if (!@ARGV || $opt{filter}) { + my(@in, @out); + my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files; + for (@files) { + my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/\.($srcext)$/i; + push @{ $out ? \@out : \@in }, $_; + } + if (@ARGV && @out) { + warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out); + } + @files = @in; +} + +unless (@files) { + die "No input files given!\n"; +} + +my(%files, %global, %revreplace); +%revreplace = reverse %replace; +my $filename; +my $patch_opened = 0; + +for $filename (@files) { + unless (open IN, "<$filename") { + warn "Unable to read from $filename: $!\n"; + next; + } + + info("Scanning $filename ..."); + + my $c = do { local $/; }; + close IN; + + my %file = (orig => $c, changes => 0); + + # temporarily remove C comments from the code + my @ccom; + $c =~ s{ + ( + [^"'/]+ + | + (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+ + | + (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+ + ) + | + (/ (?: + \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / + | + /[^\r\n]* + )) + }{ + defined $2 and push @ccom, $2; + defined $1 ? $1 : "$ccs$#ccom$cce"; + }egsx; + + $file{ccom} = \@ccom; + $file{code} = $c; + $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/); + + my $func; + + for $func (keys %API) { + my $match = $func; + $match .= "|$revreplace{$func}" if exists $revreplace{$func}; + if ($c =~ /\b(?:Perl_)?($match)\b/) { + $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func}; + $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/; + if (exists $API{$func}{provided}) { + if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) { + $file{uses}{$func}++; + my @deps = rec_depend($func); + if (@deps) { + $file{uses_deps}{$func} = \@deps; + for (@deps) { + $file{uses}{$_} = 0 unless exists $file{uses}{$_}; + } + } + for ($func, @deps) { + if (exists $need{$_}) { + $file{needs}{$_} = 'static'; + } + } + } + } + if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) { + if ($c =~ /\b$func\b/) { + $file{uses_todo}{$func}++; + } + } + } + } + + while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) { + if (exists $need{$2}) { + $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++; + } + else { + warning("Possibly wrong #define $1 in $filename"); + } + } + + for (qw(uses needs uses_todo needed_global needed_static)) { + for $func (keys %{$file{$_}}) { + push @{$global{$_}{$func}}, $filename; + } + } + + $files{$filename} = \%file; +} + +# Globally resolve NEED_'s +my $need; +for $need (keys %{$global{needs}}) { + if (@{$global{needs}{$need}} > 1) { + my @targets = @{$global{needs}{$need}}; + my @t = grep $files{$_}{needed_global}{$need}, @targets; + @targets = @t if @t; + @t = grep /\.xs$/i, @targets; + @targets = @t if @t; + my $target = shift @targets; + $files{$target}{needs}{$need} = 'global'; + for (@{$global{needs}{$need}}) { + $files{$_}{needs}{$need} = 'extern' if $_ ne $target; + } + } +} + +for $filename (@files) { + exists $files{$filename} or next; + + info("=== Analyzing $filename ==="); + + my %file = %{$files{$filename}}; + my $func; + my $c = $file{code}; + + for $func (sort keys %{$file{uses_Perl}}) { + if ($API{$func}{varargs}) { + my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))} + { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge); + if ($changes) { + warning("Doesn't pass interpreter argument aTHX to Perl_$func"); + $file{changes} += $changes; + } + } + else { + warning("Uses Perl_$func instead of $func"); + $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*} + {$func$1(}g); + } + } + + for $func (sort keys %{$file{uses_replace}}) { + warning("Uses $func instead of $replace{$func}"); + $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); + } + + for $func (sort keys %{$file{uses}}) { + next unless $file{uses}{$func}; # if it's only a dependency + if (exists $file{uses_deps}{$func}) { + diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}})); + } + elsif (exists $replace{$func}) { + warning("Uses $func instead of $replace{$func}"); + $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); + } + else { + diag("Uses $func"); + } + hint($func); + } + + for $func (sort keys %{$file{uses_todo}}) { + warning("Uses $func, which may not be portable below perl ", + format_version($API{$func}{todo})); + } + + for $func (sort keys %{$file{needed_static}}) { + my $message = ''; + if (not exists $file{uses}{$func}) { + $message = "No need to define NEED_$func if $func is never used"; + } + elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') { + $message = "No need to define NEED_$func when already needed globally"; + } + if ($message) { + diag($message); + $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg); + } + } + + for $func (sort keys %{$file{needed_global}}) { + my $message = ''; + if (not exists $global{uses}{$func}) { + $message = "No need to define NEED_${func}_GLOBAL if $func is never used"; + } + elsif (exists $file{needs}{$func}) { + if ($file{needs}{$func} eq 'extern') { + $message = "No need to define NEED_${func}_GLOBAL when already needed globally"; + } + elsif ($file{needs}{$func} eq 'static') { + $message = "No need to define NEED_${func}_GLOBAL when only used in this file"; + } + } + if ($message) { + diag($message); + $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg); + } + } + + $file{needs_inc_ppport} = keys %{$file{uses}}; + + if ($file{needs_inc_ppport}) { + my $pp = ''; + + for $func (sort keys %{$file{needs}}) { + my $type = $file{needs}{$func}; + next if $type eq 'extern'; + my $suffix = $type eq 'global' ? '_GLOBAL' : ''; + unless (exists $file{"needed_$type"}{$func}) { + if ($type eq 'global') { + diag("Files [@{$global{needs}{$func}}] need $func, adding global request"); + } + else { + diag("File needs $func, adding static request"); + } + $pp .= "#define NEED_$func$suffix\n"; + } + } + + if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) { + $pp = ''; + $file{changes}++; + } + + unless ($file{has_inc_ppport}) { + diag("Needs to include '$ppport'"); + $pp .= qq(#include "$ppport"\n) + } + + if ($pp) { + $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms) + || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m) + || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m) + || ($c =~ s/^/$pp/); + } + } + else { + if ($file{has_inc_ppport}) { + diag("No need to include '$ppport'"); + $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m); + } + } + + # put back in our C comments + my $ix; + my $cppc = 0; + my @ccom = @{$file{ccom}}; + for $ix (0 .. $#ccom) { + if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) { + $cppc++; + $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/; + } + else { + $c =~ s/$rccs$ix$rcce/$ccom[$ix]/; + } + } + + if ($cppc) { + my $s = $cppc != 1 ? 's' : ''; + warning("Uses $cppc C++ style comment$s, which is not portable"); + } + + if ($file{changes}) { + if (exists $opt{copy}) { + my $newfile = "$filename$opt{copy}"; + if (-e $newfile) { + error("'$newfile' already exists, refusing to write copy of '$filename'"); + } + else { + local *F; + if (open F, ">$newfile") { + info("Writing copy of '$filename' with changes to '$newfile'"); + print F $c; + close F; + } + else { + error("Cannot open '$newfile' for writing: $!"); + } + } + } + elsif (exists $opt{patch} || $opt{changes}) { + if (exists $opt{patch}) { + unless ($patch_opened) { + if (open PATCH, ">$opt{patch}") { + $patch_opened = 1; + } + else { + error("Cannot open '$opt{patch}' for writing: $!"); + delete $opt{patch}; + $opt{changes} = 1; + goto fallback; + } + } + mydiff(\*PATCH, $filename, $c); + } + else { +fallback: + info("Suggested changes:"); + mydiff(\*STDOUT, $filename, $c); + } + } + else { + my $s = $file{changes} == 1 ? '' : 's'; + info("$file{changes} potentially required change$s detected"); + } + } + else { + info("Looks good"); + } +} + +close PATCH if $patch_opened; + +exit 0; + + +sub mydiff +{ + local *F = shift; + my($file, $str) = @_; + my $diff; + + if (exists $opt{diff}) { + $diff = run_diff($opt{diff}, $file, $str); + } + + if (!defined $diff and can_use('Text::Diff')) { + $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' }); + $diff = <
$tmp") { + print F $str; + close F; + + if (open F, "$prog $file $tmp |") { + while () { + s/\Q$tmp\E/$file.patched/; + $diff .= $_; + } + close F; + unlink $tmp; + return $diff; + } + + unlink $tmp; + } + else { + error("Cannot open '$tmp' for writing: $!"); + } + + return undef; +} + +sub can_use +{ + eval "use @_;"; + return $@ eq ''; +} + +sub rec_depend +{ + my $func = shift; + my %seen; + return () unless exists $depends{$func}; + grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}}; +} + +sub parse_version +{ + my $ver = shift; + + if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { + return ($1, $2, $3); + } + elsif ($ver !~ /^\d+\.[\d_]+$/) { + die "cannot parse version '$ver'\n"; + } + + $ver =~ s/_//g; + $ver =~ s/$/000000/; + + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; + + $v = int $v; + $s = int $s; + + if ($r < 5 || ($r == 5 && $v < 6)) { + if ($s % 10) { + die "cannot parse version '$ver'\n"; + } + } + + return ($r, $v, $s); +} + +sub format_version +{ + my $ver = shift; + + $ver =~ s/$/000000/; + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; + + $v = int $v; + $s = int $s; + + if ($r < 5 || ($r == 5 && $v < 6)) { + if ($s % 10) { + die "invalid version '$ver'\n"; + } + $s /= 10; + + $ver = sprintf "%d.%03d", $r, $v; + $s > 0 and $ver .= sprintf "_%02d", $s; + + return $ver; + } + + return sprintf "%d.%d.%d", $r, $v, $s; +} + +sub info +{ + $opt{quiet} and return; + print @_, "\n"; +} + +sub diag +{ + $opt{quiet} and return; + $opt{diag} and print @_, "\n"; +} + +sub warning +{ + $opt{quiet} and return; + print "*** ", @_, "\n"; +} + +sub error +{ + print "*** ERROR: ", @_, "\n"; +} + +my %given_hints; +sub hint +{ + $opt{quiet} and return; + $opt{hints} or return; + my $func = shift; + exists $hints{$func} or return; + $given_hints{$func}++ and return; + my $hint = $hints{$func}; + $hint =~ s/^/ /mg; + print " --- hint for $func ---\n", $hint; +} + +sub usage +{ + my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms; + my %M = ( 'I' => '*' ); + $usage =~ s/^\s*perl\s+\S+/$^X $0/; + $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g; + + print < +#endif +#if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) +#include +#endif +#ifndef PERL_REVISION +#define PERL_REVISION (5) +/* Replace: 1 */ +#define PERL_VERSION PATCHLEVEL +#define PERL_SUBVERSION SUBVERSION +/* Replace PERL_PATCHLEVEL with PERL_VERSION */ +/* Replace: 0 */ +#endif +#endif + +#define PERL_BCDVERSION \ + ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) + +/* It is very unlikely that anyone will try to use this with Perl 6 + (or greater), but who knows. + */ +#if PERL_REVISION != 5 +#error ppport.h only works with Perl version 5 +#endif /* PERL_REVISION != 5 */ + +#ifdef I_LIMITS +#include +#endif + +#ifndef PERL_UCHAR_MIN +#define PERL_UCHAR_MIN ((unsigned char)0) +#endif + +#ifndef PERL_UCHAR_MAX +#ifdef UCHAR_MAX +#define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) +#else +#ifdef MAXUCHAR +#define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) +#else +#define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) +#endif +#endif +#endif + +#ifndef PERL_USHORT_MIN +#define PERL_USHORT_MIN ((unsigned short)0) +#endif + +#ifndef PERL_USHORT_MAX +#ifdef USHORT_MAX +#define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) +#else +#ifdef MAXUSHORT +#define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) +#else +#ifdef USHRT_MAX +#define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) +#else +#define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) +#endif +#endif +#endif +#endif + +#ifndef PERL_SHORT_MAX +#ifdef SHORT_MAX +#define PERL_SHORT_MAX ((short)SHORT_MAX) +#else +#ifdef MAXSHORT /* Often used in */ +#define PERL_SHORT_MAX ((short)MAXSHORT) +#else +#ifdef SHRT_MAX +#define PERL_SHORT_MAX ((short)SHRT_MAX) +#else +#define PERL_SHORT_MAX ((short)(PERL_USHORT_MAX >> 1)) +#endif +#endif +#endif +#endif + +#ifndef PERL_SHORT_MIN +#ifdef SHORT_MIN +#define PERL_SHORT_MIN ((short)SHORT_MIN) +#else +#ifdef MINSHORT +#define PERL_SHORT_MIN ((short)MINSHORT) +#else +#ifdef SHRT_MIN +#define PERL_SHORT_MIN ((short)SHRT_MIN) +#else +#define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) +#endif +#endif +#endif +#endif + +#ifndef PERL_UINT_MAX +#ifdef UINT_MAX +#define PERL_UINT_MAX ((unsigned int)UINT_MAX) +#else +#ifdef MAXUINT +#define PERL_UINT_MAX ((unsigned int)MAXUINT) +#else +#define PERL_UINT_MAX (~(unsigned int)0) +#endif +#endif +#endif + +#ifndef PERL_UINT_MIN +#define PERL_UINT_MIN ((unsigned int)0) +#endif + +#ifndef PERL_INT_MAX +#ifdef INT_MAX +#define PERL_INT_MAX ((int)INT_MAX) +#else +#ifdef MAXINT /* Often used in */ +#define PERL_INT_MAX ((int)MAXINT) +#else +#define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) +#endif +#endif +#endif + +#ifndef PERL_INT_MIN +#ifdef INT_MIN +#define PERL_INT_MIN ((int)INT_MIN) +#else +#ifdef MININT +#define PERL_INT_MIN ((int)MININT) +#else +#define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) +#endif +#endif +#endif + +#ifndef PERL_ULONG_MAX +#ifdef ULONG_MAX +#define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) +#else +#ifdef MAXULONG +#define PERL_ULONG_MAX ((unsigned long)MAXULONG) +#else +#define PERL_ULONG_MAX (~(unsigned long)0) +#endif +#endif +#endif + +#ifndef PERL_ULONG_MIN +#define PERL_ULONG_MIN ((unsigned long)0L) +#endif + +#ifndef PERL_LONG_MAX +#ifdef LONG_MAX +#define PERL_LONG_MAX ((long)LONG_MAX) +#else +#ifdef MAXLONG +#define PERL_LONG_MAX ((long)MAXLONG) +#else +#define PERL_LONG_MAX ((long)(PERL_ULONG_MAX >> 1)) +#endif +#endif +#endif + +#ifndef PERL_LONG_MIN +#ifdef LONG_MIN +#define PERL_LONG_MIN ((long)LONG_MIN) +#else +#ifdef MINLONG +#define PERL_LONG_MIN ((long)MINLONG) +#else +#define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) +#endif +#endif +#endif + +#if defined(HAS_QUAD) && (defined(convex) || defined(uts)) +#ifndef PERL_UQUAD_MAX +#ifdef ULONGLONG_MAX +#define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX) +#else +#ifdef MAXULONGLONG +#define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG) +#else +#define PERL_UQUAD_MAX (~(unsigned long long)0) +#endif +#endif +#endif + +#ifndef PERL_UQUAD_MIN +#define PERL_UQUAD_MIN ((unsigned long long)0L) +#endif + +#ifndef PERL_QUAD_MAX +#ifdef LONGLONG_MAX +#define PERL_QUAD_MAX ((long long)LONGLONG_MAX) +#else +#ifdef MAXLONGLONG +#define PERL_QUAD_MAX ((long long)MAXLONGLONG) +#else +#define PERL_QUAD_MAX ((long long)(PERL_UQUAD_MAX >> 1)) +#endif +#endif +#endif + +#ifndef PERL_QUAD_MIN +#ifdef LONGLONG_MIN +#define PERL_QUAD_MIN ((long long)LONGLONG_MIN) +#else +#ifdef MINLONGLONG +#define PERL_QUAD_MIN ((long long)MINLONGLONG) +#else +#define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) +#endif +#endif +#endif +#endif + +/* This is based on code from 5.003 perl.h */ +#ifdef HAS_QUAD +#ifdef cray +#ifndef IVTYPE +#define IVTYPE int +#endif + +#ifndef IV_MIN +#define IV_MIN PERL_INT_MIN +#endif + +#ifndef IV_MAX +#define IV_MAX PERL_INT_MAX +#endif + +#ifndef UV_MIN +#define UV_MIN PERL_UINT_MIN +#endif + +#ifndef UV_MAX +#define UV_MAX PERL_UINT_MAX +#endif + +#ifdef INTSIZE +#ifndef IVSIZE +#define IVSIZE INTSIZE +#endif + +#endif +#else +#if defined(convex) || defined(uts) +#ifndef IVTYPE +#define IVTYPE long long +#endif + +#ifndef IV_MIN +#define IV_MIN PERL_QUAD_MIN +#endif + +#ifndef IV_MAX +#define IV_MAX PERL_QUAD_MAX +#endif + +#ifndef UV_MIN +#define UV_MIN PERL_UQUAD_MIN +#endif + +#ifndef UV_MAX +#define UV_MAX PERL_UQUAD_MAX +#endif + +#ifdef LONGLONGSIZE +#ifndef IVSIZE +#define IVSIZE LONGLONGSIZE +#endif + +#endif +#else +#ifndef IVTYPE +#define IVTYPE long +#endif + +#ifndef IV_MIN +#define IV_MIN PERL_LONG_MIN +#endif + +#ifndef IV_MAX +#define IV_MAX PERL_LONG_MAX +#endif + +#ifndef UV_MIN +#define UV_MIN PERL_ULONG_MIN +#endif + +#ifndef UV_MAX +#define UV_MAX PERL_ULONG_MAX +#endif + +#ifdef LONGSIZE +#ifndef IVSIZE +#define IVSIZE LONGSIZE +#endif + +#endif +#endif +#endif +#ifndef IVSIZE +#define IVSIZE 8 +#endif + +#ifndef PERL_QUAD_MIN +#define PERL_QUAD_MIN IV_MIN +#endif + +#ifndef PERL_QUAD_MAX +#define PERL_QUAD_MAX IV_MAX +#endif + +#ifndef PERL_UQUAD_MIN +#define PERL_UQUAD_MIN UV_MIN +#endif + +#ifndef PERL_UQUAD_MAX +#define PERL_UQUAD_MAX UV_MAX +#endif + +#else +#ifndef IVTYPE +#define IVTYPE long +#endif + +#ifndef IV_MIN +#define IV_MIN PERL_LONG_MIN +#endif + +#ifndef IV_MAX +#define IV_MAX PERL_LONG_MAX +#endif + +#ifndef UV_MIN +#define UV_MIN PERL_ULONG_MIN +#endif + +#ifndef UV_MAX +#define UV_MAX PERL_ULONG_MAX +#endif + +#endif + +#ifndef IVSIZE +#ifdef LONGSIZE +#define IVSIZE LONGSIZE +#else +#define IVSIZE 4 /* A bold guess, but the best we can make. */ +#endif +#endif +#ifndef UVTYPE +#define UVTYPE unsigned IVTYPE +#endif + +#ifndef UVSIZE +#define UVSIZE IVSIZE +#endif + +#ifndef sv_setuv +#define sv_setuv(sv, uv) \ + STMT_START \ + { \ + UV TeMpUv = uv; \ + if (TeMpUv <= IV_MAX) \ + sv_setiv(sv, TeMpUv); \ + else \ + sv_setnv(sv, (double)TeMpUv); \ + } \ + STMT_END +#endif + +#ifndef newSVuv +#define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) +#endif +#ifndef sv_2uv +#define sv_2uv(sv) \ + ((PL_Sv = (sv)), (UV)(SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) +#endif + +#ifndef SvUVX +#define SvUVX(sv) ((UV)SvIVX(sv)) +#endif + +#ifndef SvUVXx +#define SvUVXx(sv) SvUVX(sv) +#endif + +#ifndef SvUV +#define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) +#endif + +#ifndef SvUVx +#define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) +#endif + +/* Hint: sv_uv + * Always use the SvUVx() macro instead of sv_uv(). + */ +#ifndef sv_uv +#define sv_uv(sv) SvUVx(sv) +#endif +#ifndef XST_mUV +#define XST_mUV(i, v) (ST(i) = sv_2mortal(newSVuv(v))) +#endif + +#ifndef XSRETURN_UV +#define XSRETURN_UV(v) \ + STMT_START \ + { \ + XST_mUV(0, v); \ + XSRETURN(1); \ + } \ + STMT_END +#endif +#ifndef PUSHu +#define PUSHu(u) \ + STMT_START \ + { \ + sv_setuv(TARG, (UV)(u)); \ + PUSHTARG; \ + } \ + STMT_END +#endif + +#ifndef XPUSHu +#define XPUSHu(u) \ + STMT_START \ + { \ + sv_setuv(TARG, (UV)(u)); \ + XPUSHTARG; \ + } \ + STMT_END +#endif + +#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) +/* Replace: 1 */ +#define PL_DBsingle DBsingle +#define PL_DBsub DBsub +#define PL_Sv Sv +#define PL_compiling compiling +#define PL_copline copline +#define PL_curcop curcop +#define PL_curstash curstash +#define PL_debstash debstash +#define PL_defgv defgv +#define PL_diehook diehook +#define PL_dirty dirty +#define PL_dowarn dowarn +#define PL_errgv errgv +#define PL_hexdigit hexdigit +#define PL_hints hints +#define PL_na na +#define PL_no_modify no_modify +#define PL_perl_destruct_level perl_destruct_level +#define PL_perldb perldb +#define PL_ppaddr ppaddr +#define PL_rsfp_filters rsfp_filters +#define PL_rsfp rsfp +#define PL_stack_base stack_base +#define PL_stack_sp stack_sp +#define PL_stdingv stdingv +#define PL_sv_arenaroot sv_arenaroot +#define PL_sv_no sv_no +#define PL_sv_undef sv_undef +#define PL_sv_yes sv_yes +#define PL_tainted tainted +#define PL_tainting tainting +/* Replace: 0 */ +#endif + +#ifndef PERL_UNUSED_DECL +#ifdef HASATTRIBUTE +#if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) +#define PERL_UNUSED_DECL +#else +#define PERL_UNUSED_DECL __attribute__((unused)) +#endif +#else +#define PERL_UNUSED_DECL +#endif +#endif +#ifndef NOOP +#define NOOP (void)0 +#endif + +#ifndef dNOOP +#define dNOOP extern int Perl___notused PERL_UNUSED_DECL +#endif + +#ifndef NVTYPE +#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) +#define NVTYPE long double +#else +#define NVTYPE double +#endif +typedef NVTYPE NV; +#endif + +#ifndef INT2PTR + +#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) +#define PTRV UV +#define INT2PTR(any, d) (any)(d) +#else +#if PTRSIZE == LONGSIZE +#define PTRV unsigned long +#else +#define PTRV unsigned +#endif +#define INT2PTR(any, d) (any)(PTRV)(d) +#endif + +#define NUM2PTR(any, d) (any)(PTRV)(d) +#define PTR2IV(p) INT2PTR(IV, p) +#define PTR2UV(p) INT2PTR(UV, p) +#define PTR2NV(p) NUM2PTR(NV, p) + +#if PTRSIZE == LONGSIZE +#define PTR2ul(p) (unsigned long)(p) +#else +#define PTR2ul(p) INT2PTR(unsigned long, p) +#endif + +#endif /* !INT2PTR */ + +#undef START_EXTERN_C +#undef END_EXTERN_C +#undef EXTERN_C +#ifdef __cplusplus +#define START_EXTERN_C extern "C" { +#define END_EXTERN_C } +#define EXTERN_C extern "C" +#else +#define START_EXTERN_C +#define END_EXTERN_C +#define EXTERN_C extern +#endif + +#ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN +#if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC) +#define PERL_GCC_BRACE_GROUPS_FORBIDDEN +#endif +#endif + +#undef STMT_START +#undef STMT_END +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && \ + !defined(__cplusplus) +#define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ +#define STMT_END ) +#else +#if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && \ + !defined(__GNUC__) +#define STMT_START if (1) +#define STMT_END else(void) 0 +#else +#define STMT_START do +#define STMT_END while (0) +#endif +#endif +#ifndef boolSV +#define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) +#endif + +/* DEFSV appears first in 5.004_56 */ +#ifndef DEFSV +#define DEFSV GvSV(PL_defgv) +#endif + +#ifndef SAVE_DEFSV +#define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) +#endif + +/* Older perls (<=5.003) lack AvFILLp */ +#ifndef AvFILLp +#define AvFILLp AvFILL +#endif +#ifndef ERRSV +#define ERRSV get_sv("@", FALSE) +#endif +#ifndef newSVpvn +#define newSVpvn(data, len) \ + ((data) ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) : newSV(0)) +#endif + +/* Hint: gv_stashpvn + * This function's backport doesn't support the length parameter, but + * rather ignores it. Portability can only be ensured if the length + * parameter is used for speed reasons, but the length can always be + * correctly computed from the string argument. + */ +#ifndef gv_stashpvn +#define gv_stashpvn(str, len, create) gv_stashpv(str, create) +#endif + +/* Replace: 1 */ +#ifndef get_cv +#define get_cv perl_get_cv +#endif + +#ifndef get_sv +#define get_sv perl_get_sv +#endif + +#ifndef get_av +#define get_av perl_get_av +#endif + +#ifndef get_hv +#define get_hv perl_get_hv +#endif + +/* Replace: 0 */ + +#ifdef HAS_MEMCMP +#ifndef memNE +#define memNE(s1, s2, l) (memcmp(s1, s2, l)) +#endif + +#ifndef memEQ +#define memEQ(s1, s2, l) (!memcmp(s1, s2, l)) +#endif + +#else +#ifndef memNE +#define memNE(s1, s2, l) (bcmp(s1, s2, l)) +#endif + +#ifndef memEQ +#define memEQ(s1, s2, l) (!bcmp(s1, s2, l)) +#endif + +#endif +#ifndef MoveD +#define MoveD(s, d, n, t) memmove((char *)(d), (char *)(s), (n) * sizeof(t)) +#endif + +#ifndef CopyD +#define CopyD(s, d, n, t) memcpy((char *)(d), (char *)(s), (n) * sizeof(t)) +#endif + +#ifdef HAS_MEMSET +#ifndef ZeroD +#define ZeroD(d, n, t) memzero((char *)(d), (n) * sizeof(t)) +#endif + +#else +#ifndef ZeroD +#define ZeroD(d, n, t) ((void)memzero((char *)(d), (n) * sizeof(t)), d) +#endif + +#endif +#ifndef Poison +#define Poison(d, n, t) (void)memset((char *)(d), 0xAB, (n) * sizeof(t)) +#endif +#ifndef dUNDERBAR +#define dUNDERBAR dNOOP +#endif + +#ifndef UNDERBAR +#define UNDERBAR DEFSV +#endif +#ifndef dAX +#define dAX I32 ax = MARK - PL_stack_base + 1 +#endif + +#ifndef dITEMS +#define dITEMS I32 items = SP - MARK +#endif +#ifndef dXSTARG +#define dXSTARG SV *targ = sv_newmortal() +#endif +#ifndef dTHR +#define dTHR dNOOP +#endif +#ifndef dTHX +#define dTHX dNOOP +#endif + +#ifndef dTHXa +#define dTHXa(x) dNOOP +#endif +#ifndef pTHX +#define pTHX void +#endif + +#ifndef pTHX_ +#define pTHX_ +#endif + +#ifndef aTHX +#define aTHX +#endif + +#ifndef aTHX_ +#define aTHX_ +#endif +#ifndef dTHXoa +#define dTHXoa(x) dTHXa(x) +#endif +#ifndef PUSHmortal +#define PUSHmortal PUSHs(sv_newmortal()) +#endif + +#ifndef mPUSHp +#define mPUSHp(p, l) sv_setpvn_mg(PUSHmortal, (p), (l)) +#endif + +#ifndef mPUSHn +#define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n)) +#endif + +#ifndef mPUSHi +#define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i)) +#endif + +#ifndef mPUSHu +#define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u)) +#endif +#ifndef XPUSHmortal +#define XPUSHmortal XPUSHs(sv_newmortal()) +#endif + +#ifndef mXPUSHp +#define mXPUSHp(p, l) \ + STMT_START \ + { \ + EXTEND(sp, 1); \ + sv_setpvn_mg(PUSHmortal, (p), (l)); \ + } \ + STMT_END +#endif + +#ifndef mXPUSHn +#define mXPUSHn(n) \ + STMT_START \ + { \ + EXTEND(sp, 1); \ + sv_setnv_mg(PUSHmortal, (NV)(n)); \ + } \ + STMT_END +#endif + +#ifndef mXPUSHi +#define mXPUSHi(i) \ + STMT_START \ + { \ + EXTEND(sp, 1); \ + sv_setiv_mg(PUSHmortal, (IV)(i)); \ + } \ + STMT_END +#endif + +#ifndef mXPUSHu +#define mXPUSHu(u) \ + STMT_START \ + { \ + EXTEND(sp, 1); \ + sv_setuv_mg(PUSHmortal, (UV)(u)); \ + } \ + STMT_END +#endif + +/* Replace: 1 */ +#ifndef call_sv +#define call_sv perl_call_sv +#endif + +#ifndef call_pv +#define call_pv perl_call_pv +#endif + +#ifndef call_argv +#define call_argv perl_call_argv +#endif + +#ifndef call_method +#define call_method perl_call_method +#endif +#ifndef eval_sv +#define eval_sv perl_eval_sv +#endif + +/* Replace: 0 */ + +/* Replace perl_eval_pv with eval_pv */ +/* eval_pv depends on eval_sv */ + +#ifndef eval_pv +#if defined(NEED_eval_pv) +static SV *DPPP_(my_eval_pv)(char *p, I32 croak_on_error); +static +#else +extern SV *DPPP_(my_eval_pv)(char *p, I32 croak_on_error); +#endif + +#ifdef eval_pv +#undef eval_pv +#endif +#define eval_pv(a, b) DPPP_(my_eval_pv)(aTHX_ a, b) +#define Perl_eval_pv DPPP_(my_eval_pv) + +#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL) + + SV *DPPP_(my_eval_pv)(char *p, I32 croak_on_error) +{ + dSP; + SV *sv = newSVpv(p, 0); + + PUSHMARK(sp); + eval_sv(sv, G_SCALAR); + SvREFCNT_dec(sv); + + SPAGAIN; + sv = POPs; + PUTBACK; + + if (croak_on_error && SvTRUE(GvSV(errgv))) + croak(SvPVx(GvSV(errgv), na)); + + return sv; +} + +#endif +#endif +#ifndef newRV_inc +#define newRV_inc(sv) newRV(sv) /* Replace */ +#endif + +#ifndef newRV_noinc +#if defined(NEED_newRV_noinc) +static SV *DPPP_(my_newRV_noinc)(SV *sv); +static +#else +extern SV *DPPP_(my_newRV_noinc)(SV *sv); +#endif + +#ifdef newRV_noinc +#undef newRV_noinc +#endif +#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a) +#define Perl_newRV_noinc DPPP_(my_newRV_noinc) + +#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL) + SV *DPPP_(my_newRV_noinc)(SV *sv) +{ + SV *rv = (SV *)newRV(sv); + SvREFCNT_dec(sv); + return rv; +} +#endif +#endif + +/* Hint: newCONSTSUB + * Returns a CV* as of perl-5.7.1. This return value is not supported + * by Devel::PPPort. + */ + +/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ +#if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && \ + ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5)) +#if defined(NEED_newCONSTSUB) +static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv); +static +#else +extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv); +#endif + +#ifdef newCONSTSUB +#undef newCONSTSUB +#endif +#define newCONSTSUB(a, b, c) DPPP_(my_newCONSTSUB)(aTHX_ a, b, c) +#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB) + +#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) + + void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv) +{ + U32 oldhints = PL_hints; + HV *old_cop_stash = PL_curcop->cop_stash; + HV *old_curstash = PL_curstash; + line_t oldline = PL_curcop->cop_line; + PL_curcop->cop_line = PL_copline; + + PL_hints &= ~HINT_BLOCK_SCOPE; + if (stash) + PL_curstash = PL_curcop->cop_stash = stash; + + newSUB( + +#if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))) + start_subparse(), +#elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22)) + start_subparse(0), +#else /* 5.003_23 onwards */ + start_subparse(FALSE, 0), +#endif + + newSVOP(OP_CONST, 0, newSVpv(name, 0)), + newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ + newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))); + + PL_hints = oldhints; + PL_curcop->cop_stash = old_cop_stash; + PL_curstash = old_curstash; + PL_curcop->cop_line = oldline; +} +#endif +#endif + +/* + * Boilerplate macros for initializing and accessing interpreter-local + * data from C. All statics in extensions should be reworked to use + * this, if you want to make the extension thread-safe. See ext/re/re.xs + * for an example of the use of these macros. + * + * Code that uses these macros is responsible for the following: + * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" + * 2. Declare a typedef named my_cxt_t that is a structure that contains + * all the data that needs to be interpreter-local. + * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. + * 4. Use the MY_CXT_INIT macro such that it is called exactly once + * (typically put in the BOOT: section). + * 5. Use the members of the my_cxt_t structure everywhere as + * MY_CXT.member. + * 6. Use the dMY_CXT macro (a declaration) in all the functions that + * access MY_CXT. + */ + +#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI) || \ + defined(PERL_IMPLICIT_CONTEXT) + +#ifndef START_MY_CXT + +/* This must appear in all extensions that define a my_cxt_t structure, + * right after the definition (i.e. at file scope). The non-threads + * case below uses it to declare the data as static. */ +#define START_MY_CXT + +#if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68)) +/* Fetches the SV that keeps the per-interpreter data. */ +#define dMY_CXT_SV SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE) +#else /* >= perl5.004_68 */ +#define dMY_CXT_SV \ + SV *my_cxt_sv = \ + *hv_fetch(PL_modglobal, MY_CXT_KEY, sizeof(MY_CXT_KEY) - 1, TRUE) +#endif /* < perl5.004_68 */ + +/* This declaration should be used within all functions that use the + * interpreter-local data. */ +#define dMY_CXT \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = INT2PTR(my_cxt_t *, SvUV(my_cxt_sv)) + +/* Creates and zeroes the per-interpreter data. + * (We allocate my_cxtp in a Perl SV so that it will be released when + * the interpreter goes away.) */ +#define MY_CXT_INIT \ + dMY_CXT_SV; \ + /* newSV() allocates one more than needed */ \ + my_cxt_t *my_cxtp = (my_cxt_t *)SvPVX(newSV(sizeof(my_cxt_t) - 1)); \ + Zero(my_cxtp, 1, my_cxt_t); \ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) + +/* This macro must be used to access members of the my_cxt_t structure. + * e.g. MYCXT.some_data */ +#define MY_CXT (*my_cxtp) + +/* Judicious use of these macros can reduce the number of times dMY_CXT + * is used. Use is similar to pTHX, aTHX etc. */ +#define pMY_CXT my_cxt_t *my_cxtp +#define pMY_CXT_ pMY_CXT, +#define _pMY_CXT , pMY_CXT +#define aMY_CXT my_cxtp +#define aMY_CXT_ aMY_CXT, +#define _aMY_CXT , aMY_CXT + +#endif /* START_MY_CXT */ + +#ifndef MY_CXT_CLONE +/* Clones the per-interpreter data. */ +#define MY_CXT_CLONE \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = (my_cxt_t *)SvPVX(newSV(sizeof(my_cxt_t) - 1)); \ + Copy(INT2PTR(my_cxt_t *, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t); \ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) +#endif + +#else /* single interpreter */ + +#ifndef START_MY_CXT + +#define START_MY_CXT static my_cxt_t my_cxt; +#define dMY_CXT_SV dNOOP +#define dMY_CXT dNOOP +#define MY_CXT_INIT NOOP +#define MY_CXT my_cxt + +#define pMY_CXT void +#define pMY_CXT_ +#define _pMY_CXT +#define aMY_CXT +#define aMY_CXT_ +#define _aMY_CXT + +#endif /* START_MY_CXT */ + +#ifndef MY_CXT_CLONE +#define MY_CXT_CLONE NOOP +#endif + +#endif + +#ifndef IVdf +#if IVSIZE == LONGSIZE +#define IVdf "ld" +#define UVuf "lu" +#define UVof "lo" +#define UVxf "lx" +#define UVXf "lX" +#else +#if IVSIZE == INTSIZE +#define IVdf "d" +#define UVuf "u" +#define UVof "o" +#define UVxf "x" +#define UVXf "X" +#endif +#endif +#endif + +#ifndef NVef +#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ + defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ +#define NVef PERL_PRIeldbl +#define NVff PERL_PRIfldbl +#define NVgf PERL_PRIgldbl +#else +#define NVef "e" +#define NVff "f" +#define NVgf "g" +#endif +#endif + +#ifndef SvPV_nolen + +#if defined(NEED_sv_2pv_nolen) +static char *DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv); +static +#else +extern char *DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv); +#endif + +#ifdef sv_2pv_nolen +#undef sv_2pv_nolen +#endif +#define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a) +#define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen) + +#if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL) + + char *DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv) +{ + STRLEN n_a; + return sv_2pv(sv, &n_a); +} + +#endif + +/* Hint: sv_2pv_nolen + * Use the SvPV_nolen() macro instead of sv_2pv_nolen(). + */ + +/* SvPV_nolen depends on sv_2pv_nolen */ +#define SvPV_nolen(sv) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK ? SvPVX(sv) : sv_2pv_nolen(sv)) + +#endif + +#ifdef SvPVbyte + +/* Hint: SvPVbyte + * Does not work in perl-5.6.1, ppport.h implements a version + * borrowed from perl-5.7.3. + */ + +#if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0))) + +#if defined(NEED_sv_2pvbyte) +static char *DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp); +static +#else +extern char *DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp); +#endif + +#ifdef sv_2pvbyte +#undef sv_2pvbyte +#endif +#define sv_2pvbyte(a, b) DPPP_(my_sv_2pvbyte)(aTHX_ a, b) +#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte) + +#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL) + + char *DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp) +{ + sv_utf8_downgrade(sv, 0); + return SvPV(sv, *lp); +} + +#endif + +/* Hint: sv_2pvbyte + * Use the SvPVbyte() macro instead of sv_2pvbyte(). + */ + +#undef SvPVbyte + +/* SvPVbyte depends on sv_2pvbyte */ +#define SvPVbyte(sv, lp) \ + ((SvFLAGS(sv) & (SVf_POK | SVf_UTF8)) == (SVf_POK) ? \ + ((lp = SvCUR(sv)), SvPVX(sv)) : \ + sv_2pvbyte(sv, &lp)) + +#endif + +#else + +#define SvPVbyte SvPV +#define sv_2pvbyte sv_2pv + +#endif + +/* sv_2pvbyte_nolen depends on sv_2pv_nolen */ +#ifndef sv_2pvbyte_nolen +#define sv_2pvbyte_nolen sv_2pv_nolen +#endif + +/* Hint: sv_pvn + * Always use the SvPV() macro instead of sv_pvn(). + */ +#ifndef sv_pvn +#define sv_pvn(sv, len) SvPV(sv, len) +#endif + +/* Hint: sv_pvn_force + * Always use the SvPV_force() macro instead of sv_pvn_force(). + */ +#ifndef sv_pvn_force +#define sv_pvn_force(sv, len) SvPV_force(sv, len) +#endif + +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && \ + !defined(vnewSVpvf) +#if defined(NEED_vnewSVpvf) +static SV *DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args); +static +#else +extern SV *DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args); +#endif + +#ifdef vnewSVpvf +#undef vnewSVpvf +#endif +#define vnewSVpvf(a, b) DPPP_(my_vnewSVpvf)(aTHX_ a, b) +#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf) + +#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL) + + SV *DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args) +{ + register SV *sv = newSV(0); + sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)); + return sv; +} + +#endif +#endif + +/* sv_vcatpvf depends on sv_vcatpvfn */ +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && \ + !defined(sv_vcatpvf) +#define sv_vcatpvf(sv, pat, args) \ + sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)) +#endif + +/* sv_vsetpvf depends on sv_vsetpvfn */ +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && \ + !defined(sv_vsetpvf) +#define sv_vsetpvf(sv, pat, args) \ + sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)) +#endif + +/* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */ +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && \ + !defined(sv_catpvf_mg) +#if defined(NEED_sv_catpvf_mg) +static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...); +static +#else +extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...); +#endif + +#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg) + +#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL) + + void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...) +{ + va_list args; + va_start(args, pat); + sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *)); + SvSETMAGIC(sv); + va_end(args); +} + +#endif +#endif + +/* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */ +#ifdef PERL_IMPLICIT_CONTEXT +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && \ + !defined(sv_catpvf_mg_nocontext) +#if defined(NEED_sv_catpvf_mg_nocontext) +static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...); +static +#else +extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...); +#endif + +#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) +#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) + +#if defined(NEED_sv_catpvf_mg_nocontext) || \ + defined(NEED_sv_catpvf_mg_nocontext_GLOBAL) + + void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...) +{ + dTHX; + va_list args; + va_start(args, pat); + sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *)); + SvSETMAGIC(sv); + va_end(args); +} + +#endif +#endif +#endif + +#ifndef sv_catpvf_mg +#ifdef PERL_IMPLICIT_CONTEXT +#define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext +#else +#define sv_catpvf_mg Perl_sv_catpvf_mg +#endif +#endif + +/* sv_vcatpvf_mg depends on sv_vcatpvfn */ +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && \ + !defined(sv_vcatpvf_mg) +#define sv_vcatpvf_mg(sv, pat, args) \ + STMT_START \ + { \ + sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)); \ + SvSETMAGIC(sv); \ + } \ + STMT_END +#endif + +/* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */ +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && \ + !defined(sv_setpvf_mg) +#if defined(NEED_sv_setpvf_mg) +static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...); +static +#else +extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...); +#endif + +#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg) + +#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL) + + void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...) +{ + va_list args; + va_start(args, pat); + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *)); + SvSETMAGIC(sv); + va_end(args); +} + +#endif +#endif + +/* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */ +#ifdef PERL_IMPLICIT_CONTEXT +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && \ + !defined(sv_setpvf_mg_nocontext) +#if defined(NEED_sv_setpvf_mg_nocontext) +static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...); +static +#else +extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...); +#endif + +#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) +#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) + +#if defined(NEED_sv_setpvf_mg_nocontext) || \ + defined(NEED_sv_setpvf_mg_nocontext_GLOBAL) + + void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...) +{ + dTHX; + va_list args; + va_start(args, pat); + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *)); + SvSETMAGIC(sv); + va_end(args); +} + +#endif +#endif +#endif + +#ifndef sv_setpvf_mg +#ifdef PERL_IMPLICIT_CONTEXT +#define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext +#else +#define sv_setpvf_mg Perl_sv_setpvf_mg +#endif +#endif + +/* sv_vsetpvf_mg depends on sv_vsetpvfn */ +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && \ + !defined(sv_vsetpvf_mg) +#define sv_vsetpvf_mg(sv, pat, args) \ + STMT_START \ + { \ + sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)); \ + SvSETMAGIC(sv); \ + } \ + STMT_END +#endif +#ifndef SvGETMAGIC +#define SvGETMAGIC(x) \ + STMT_START \ + { \ + if (SvGMAGICAL(x)) \ + mg_get(x); \ + } \ + STMT_END +#endif +#ifndef PERL_MAGIC_sv +#define PERL_MAGIC_sv '\0' +#endif + +#ifndef PERL_MAGIC_overload +#define PERL_MAGIC_overload 'A' +#endif + +#ifndef PERL_MAGIC_overload_elem +#define PERL_MAGIC_overload_elem 'a' +#endif + +#ifndef PERL_MAGIC_overload_table +#define PERL_MAGIC_overload_table 'c' +#endif + +#ifndef PERL_MAGIC_bm +#define PERL_MAGIC_bm 'B' +#endif + +#ifndef PERL_MAGIC_regdata +#define PERL_MAGIC_regdata 'D' +#endif + +#ifndef PERL_MAGIC_regdatum +#define PERL_MAGIC_regdatum 'd' +#endif + +#ifndef PERL_MAGIC_env +#define PERL_MAGIC_env 'E' +#endif + +#ifndef PERL_MAGIC_envelem +#define PERL_MAGIC_envelem 'e' +#endif + +#ifndef PERL_MAGIC_fm +#define PERL_MAGIC_fm 'f' +#endif + +#ifndef PERL_MAGIC_regex_global +#define PERL_MAGIC_regex_global 'g' +#endif + +#ifndef PERL_MAGIC_isa +#define PERL_MAGIC_isa 'I' +#endif + +#ifndef PERL_MAGIC_isaelem +#define PERL_MAGIC_isaelem 'i' +#endif + +#ifndef PERL_MAGIC_nkeys +#define PERL_MAGIC_nkeys 'k' +#endif + +#ifndef PERL_MAGIC_dbfile +#define PERL_MAGIC_dbfile 'L' +#endif + +#ifndef PERL_MAGIC_dbline +#define PERL_MAGIC_dbline 'l' +#endif + +#ifndef PERL_MAGIC_mutex +#define PERL_MAGIC_mutex 'm' +#endif + +#ifndef PERL_MAGIC_shared +#define PERL_MAGIC_shared 'N' +#endif + +#ifndef PERL_MAGIC_shared_scalar +#define PERL_MAGIC_shared_scalar 'n' +#endif + +#ifndef PERL_MAGIC_collxfrm +#define PERL_MAGIC_collxfrm 'o' +#endif + +#ifndef PERL_MAGIC_tied +#define PERL_MAGIC_tied 'P' +#endif + +#ifndef PERL_MAGIC_tiedelem +#define PERL_MAGIC_tiedelem 'p' +#endif + +#ifndef PERL_MAGIC_tiedscalar +#define PERL_MAGIC_tiedscalar 'q' +#endif + +#ifndef PERL_MAGIC_qr +#define PERL_MAGIC_qr 'r' +#endif + +#ifndef PERL_MAGIC_sig +#define PERL_MAGIC_sig 'S' +#endif + +#ifndef PERL_MAGIC_sigelem +#define PERL_MAGIC_sigelem 's' +#endif + +#ifndef PERL_MAGIC_taint +#define PERL_MAGIC_taint 't' +#endif + +#ifndef PERL_MAGIC_uvar +#define PERL_MAGIC_uvar 'U' +#endif + +#ifndef PERL_MAGIC_uvar_elem +#define PERL_MAGIC_uvar_elem 'u' +#endif + +#ifndef PERL_MAGIC_vstring +#define PERL_MAGIC_vstring 'V' +#endif + +#ifndef PERL_MAGIC_vec +#define PERL_MAGIC_vec 'v' +#endif + +#ifndef PERL_MAGIC_utf8 +#define PERL_MAGIC_utf8 'w' +#endif + +#ifndef PERL_MAGIC_substr +#define PERL_MAGIC_substr 'x' +#endif + +#ifndef PERL_MAGIC_defelem +#define PERL_MAGIC_defelem 'y' +#endif + +#ifndef PERL_MAGIC_glob +#define PERL_MAGIC_glob '*' +#endif + +#ifndef PERL_MAGIC_arylen +#define PERL_MAGIC_arylen '#' +#endif + +#ifndef PERL_MAGIC_pos +#define PERL_MAGIC_pos '.' +#endif + +#ifndef PERL_MAGIC_backref +#define PERL_MAGIC_backref '<' +#endif + +#ifndef PERL_MAGIC_ext +#define PERL_MAGIC_ext '~' +#endif + +/* That's the best we can do... */ +#ifndef SvPV_force_nomg +#define SvPV_force_nomg SvPV_force +#endif + +#ifndef SvPV_nomg +#define SvPV_nomg SvPV +#endif + +#ifndef sv_catpvn_nomg +#define sv_catpvn_nomg sv_catpvn +#endif + +#ifndef sv_catsv_nomg +#define sv_catsv_nomg sv_catsv +#endif + +#ifndef sv_setsv_nomg +#define sv_setsv_nomg sv_setsv +#endif + +#ifndef sv_pvn_nomg +#define sv_pvn_nomg sv_pvn +#endif + +#ifndef SvIV_nomg +#define SvIV_nomg SvIV +#endif + +#ifndef SvUV_nomg +#define SvUV_nomg SvUV +#endif + +#ifndef sv_catpv_mg +#define sv_catpv_mg(sv, ptr) \ + STMT_START \ + { \ + SV *TeMpSv = sv; \ + sv_catpv(TeMpSv, ptr); \ + SvSETMAGIC(TeMpSv); \ + } \ + STMT_END +#endif + +#ifndef sv_catpvn_mg +#define sv_catpvn_mg(sv, ptr, len) \ + STMT_START \ + { \ + SV *TeMpSv = sv; \ + sv_catpvn(TeMpSv, ptr, len); \ + SvSETMAGIC(TeMpSv); \ + } \ + STMT_END +#endif + +#ifndef sv_catsv_mg +#define sv_catsv_mg(dsv, ssv) \ + STMT_START \ + { \ + SV *TeMpSv = dsv; \ + sv_catsv(TeMpSv, ssv); \ + SvSETMAGIC(TeMpSv); \ + } \ + STMT_END +#endif + +#ifndef sv_setiv_mg +#define sv_setiv_mg(sv, i) \ + STMT_START \ + { \ + SV *TeMpSv = sv; \ + sv_setiv(TeMpSv, i); \ + SvSETMAGIC(TeMpSv); \ + } \ + STMT_END +#endif + +#ifndef sv_setnv_mg +#define sv_setnv_mg(sv, num) \ + STMT_START \ + { \ + SV *TeMpSv = sv; \ + sv_setnv(TeMpSv, num); \ + SvSETMAGIC(TeMpSv); \ + } \ + STMT_END +#endif + +#ifndef sv_setpv_mg +#define sv_setpv_mg(sv, ptr) \ + STMT_START \ + { \ + SV *TeMpSv = sv; \ + sv_setpv(TeMpSv, ptr); \ + SvSETMAGIC(TeMpSv); \ + } \ + STMT_END +#endif + +#ifndef sv_setpvn_mg +#define sv_setpvn_mg(sv, ptr, len) \ + STMT_START \ + { \ + SV *TeMpSv = sv; \ + sv_setpvn(TeMpSv, ptr, len); \ + SvSETMAGIC(TeMpSv); \ + } \ + STMT_END +#endif + +#ifndef sv_setsv_mg +#define sv_setsv_mg(dsv, ssv) \ + STMT_START \ + { \ + SV *TeMpSv = dsv; \ + sv_setsv(TeMpSv, ssv); \ + SvSETMAGIC(TeMpSv); \ + } \ + STMT_END +#endif + +#ifndef sv_setuv_mg +#define sv_setuv_mg(sv, i) \ + STMT_START \ + { \ + SV *TeMpSv = sv; \ + sv_setuv(TeMpSv, i); \ + SvSETMAGIC(TeMpSv); \ + } \ + STMT_END +#endif + +#ifndef sv_usepvn_mg +#define sv_usepvn_mg(sv, ptr, len) \ + STMT_START \ + { \ + SV *TeMpSv = sv; \ + sv_usepvn(TeMpSv, ptr, len); \ + SvSETMAGIC(TeMpSv); \ + } \ + STMT_END +#endif + +#ifdef USE_ITHREADS +#ifndef CopFILE +#define CopFILE(c) ((c)->cop_file) +#endif + +#ifndef CopFILEGV +#define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv) +#endif + +#ifndef CopFILE_set +#define CopFILE_set(c, pv) ((c)->cop_file = savepv(pv)) +#endif + +#ifndef CopFILESV +#define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) +#endif + +#ifndef CopFILEAV +#define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) +#endif + +#ifndef CopSTASHPV +#define CopSTASHPV(c) ((c)->cop_stashpv) +#endif + +#ifndef CopSTASHPV_set +#define CopSTASHPV_set(c, pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch)) +#endif + +#ifndef CopSTASH +#define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c), GV_ADD) : Nullhv) +#endif + +#ifndef CopSTASH_set +#define CopSTASH_set(c, hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch) +#endif + +#ifndef CopSTASH_eq +#define CopSTASH_eq(c, hv) \ + ((hv) && \ + (CopSTASHPV(c) == HvNAME(hv) || \ + (CopSTASHPV(c) && HvNAME(hv) && strEQ(CopSTASHPV(c), HvNAME(hv))))) +#endif + +#else +#ifndef CopFILEGV +#define CopFILEGV(c) ((c)->cop_filegv) +#endif + +#ifndef CopFILEGV_set +#define CopFILEGV_set(c, gv) ((c)->cop_filegv = (GV *)SvREFCNT_inc(gv)) +#endif + +#ifndef CopFILE_set +#define CopFILE_set(c, pv) CopFILEGV_set((c), gv_fetchfile(pv)) +#endif + +#ifndef CopFILESV +#define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) +#endif + +#ifndef CopFILEAV +#define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) +#endif + +#ifndef CopFILE +#define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) +#endif + +#ifndef CopSTASH +#define CopSTASH(c) ((c)->cop_stash) +#endif + +#ifndef CopSTASH_set +#define CopSTASH_set(c, hv) ((c)->cop_stash = (hv)) +#endif + +#ifndef CopSTASHPV +#define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) +#endif + +#ifndef CopSTASHPV_set +#define CopSTASHPV_set(c, pv) CopSTASH_set((c), gv_stashpv(pv, GV_ADD)) +#endif + +#ifndef CopSTASH_eq +#define CopSTASH_eq(c, hv) (CopSTASH(c) == (hv)) +#endif + +#endif /* USE_ITHREADS */ +#ifndef IN_PERL_COMPILETIME +#define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) +#endif + +#ifndef IN_LOCALE_RUNTIME +#define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) +#endif + +#ifndef IN_LOCALE_COMPILETIME +#define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) +#endif + +#ifndef IN_LOCALE +#define IN_LOCALE \ + (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) +#endif +#ifndef IS_NUMBER_IN_UV +#define IS_NUMBER_IN_UV 0x01 +#endif + +#ifndef IS_NUMBER_GREATER_THAN_UV_MAX +#define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 +#endif + +#ifndef IS_NUMBER_NOT_INT +#define IS_NUMBER_NOT_INT 0x04 +#endif + +#ifndef IS_NUMBER_NEG +#define IS_NUMBER_NEG 0x08 +#endif + +#ifndef IS_NUMBER_INFINITY +#define IS_NUMBER_INFINITY 0x10 +#endif + +#ifndef IS_NUMBER_NAN +#define IS_NUMBER_NAN 0x20 +#endif + +/* GROK_NUMERIC_RADIX depends on grok_numeric_radix */ +#ifndef GROK_NUMERIC_RADIX +#define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) +#endif +#ifndef PERL_SCAN_GREATER_THAN_UV_MAX +#define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 +#endif + +#ifndef PERL_SCAN_SILENT_ILLDIGIT +#define PERL_SCAN_SILENT_ILLDIGIT 0x04 +#endif + +#ifndef PERL_SCAN_ALLOW_UNDERSCORES +#define PERL_SCAN_ALLOW_UNDERSCORES 0x01 +#endif + +#ifndef PERL_SCAN_DISALLOW_PREFIX +#define PERL_SCAN_DISALLOW_PREFIX 0x02 +#endif + +#ifndef grok_numeric_radix +#if defined(NEED_grok_numeric_radix) +static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, + const char *send); +static +#else +extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, + const char *send); +#endif + +#ifdef grok_numeric_radix +#undef grok_numeric_radix +#endif +#define grok_numeric_radix(a, b) DPPP_(my_grok_numeric_radix)(aTHX_ a, b) +#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix) + +#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL) + bool DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send) +{ +#ifdef USE_LOCALE_NUMERIC +#ifdef PL_numeric_radix_sv + if (PL_numeric_radix_sv && IN_LOCALE) { + STRLEN len; + char *radix = SvPV(PL_numeric_radix_sv, len); + if (*sp + len <= send && memEQ(*sp, radix, len)) { + *sp += len; + return TRUE; + } + } +#else + /* older perls don't have PL_numeric_radix_sv so the radix + * must manually be requested from locale.h + */ +#include + dTHR; /* needed for older threaded perls */ + struct lconv *lc = localeconv(); + char *radix = lc->decimal_point; + if (radix && IN_LOCALE) { + STRLEN len = strlen(radix); + if (*sp + len <= send && memEQ(*sp, radix, len)) { + *sp += len; + return TRUE; + } + } +#endif /* PERL_VERSION */ +#endif /* USE_LOCALE_NUMERIC */ + /* always try "." if numeric radix didn't match because + * we may have data from different locales mixed */ + if (*sp < send && **sp == '.') { + ++*sp; + return TRUE; + } + return FALSE; +} +#endif +#endif + +/* grok_number depends on grok_numeric_radix */ + +#ifndef grok_number +#if defined(NEED_grok_number) +static int DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep); +static +#else +extern int DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep); +#endif + +#ifdef grok_number +#undef grok_number +#endif +#define grok_number(a, b, c) DPPP_(my_grok_number)(aTHX_ a, b, c) +#define Perl_grok_number DPPP_(my_grok_number) + +#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL) + int DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep) +{ + const char *s = pv; + const char *send = pv + len; + const UV max_div_10 = UV_MAX / 10; + const char max_mod_10 = UV_MAX % 10; + int numtype = 0; + int sawinf = 0; + int sawnan = 0; + + while (s < send && isSPACE(*s)) + s++; + if (s == send) { + return 0; + } else if (*s == '-') { + s++; + numtype = IS_NUMBER_NEG; + } else if (*s == '+') + s++; + + if (s == send) + return 0; + + /* next must be digit or the radix separator or beginning of infinity */ + if (isDIGIT(*s)) { + /* UVs are at least 32 bits, so the first 9 decimal digits cannot + overflow. */ + UV value = *s - '0'; + /* This construction seems to be more optimiser friendly. + (without it gcc does the isDIGIT test and the *s - '0' separately) + With it gcc on arm is managing 6 instructions (6 cycles) per digit. + In theory the optimiser could deduce how far to unroll the loop + before checking for overflow. */ + if (++s < send) { + int digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && + digit <= 9) { + value = + value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && + digit <= 9) { + value = + value * 10 + + digit; + if (++s < + send) { + digit = *s - + '0'; + if (digit >= + 0 && + digit <= + 9) { + value = + value * + 10 + + digit; + if (++s < + send) { + /* Now got 9 digits, so need to check + each time for overflow. */ + digit = + *s - + '0'; + while ( + digit >= + 0 && + digit <= + 9 && + (value < + max_div_10 || + (value == + max_div_10 && + digit <= + max_mod_10))) { + value = + value * + 10 + + digit; + if (++s < + send) + digit = + *s - + '0'; + else + break; + } + if (digit >= + 0 && + digit <= + 9 && + (s < + send)) { + /* value overflowed. + skip the remaining digits, don't + worry about setting *valuep. */ + do { + s++; + } while ( + s < send && + isDIGIT( + *s)); + numtype |= + IS_NUMBER_GREATER_THAN_UV_MAX; + goto skip_value; + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + numtype |= IS_NUMBER_IN_UV; + if (valuep) + *valuep = value; + + skip_value: + if (GROK_NUMERIC_RADIX(&s, send)) { + numtype |= IS_NUMBER_NOT_INT; + while (s < send && + isDIGIT(*s)) /* optional digits after the radix */ + s++; + } + } else if (GROK_NUMERIC_RADIX(&s, send)) { + numtype |= IS_NUMBER_NOT_INT | + IS_NUMBER_IN_UV; /* valuep assigned below */ + /* no digits before the radix means we need digits after it */ + if (s < send && isDIGIT(*s)) { + do { + s++; + } while (s < send && isDIGIT(*s)); + if (valuep) { + /* integer approximation is valid - it's 0. */ + *valuep = 0; + } + } else + return 0; + } else if (*s == 'I' || *s == 'i') { + s++; + if (s == send || (*s != 'N' && *s != 'n')) + return 0; + s++; + if (s == send || (*s != 'F' && *s != 'f')) + return 0; + s++; + if (s < send && (*s == 'I' || *s == 'i')) { + s++; + if (s == send || (*s != 'N' && *s != 'n')) + return 0; + s++; + if (s == send || (*s != 'I' && *s != 'i')) + return 0; + s++; + if (s == send || (*s != 'T' && *s != 't')) + return 0; + s++; + if (s == send || (*s != 'Y' && *s != 'y')) + return 0; + s++; + } + sawinf = 1; + } else if (*s == 'N' || *s == 'n') { + /* XXX TODO: There are signaling NaNs and quiet NaNs. */ + s++; + if (s == send || (*s != 'A' && *s != 'a')) + return 0; + s++; + if (s == send || (*s != 'N' && *s != 'n')) + return 0; + s++; + sawnan = 1; + } else + return 0; + + if (sawinf) { + numtype &= IS_NUMBER_NEG; /* Keep track of sign */ + numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; + } else if (sawnan) { + numtype &= IS_NUMBER_NEG; /* Keep track of sign */ + numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; + } else if (s < send) { + /* we can have an optional exponent part */ + if (*s == 'e' || *s == 'E') { + /* The only flag we keep is sign. Blow away any "it's UV" */ + numtype &= IS_NUMBER_NEG; + numtype |= IS_NUMBER_NOT_INT; + s++; + if (s < send && (*s == '-' || *s == '+')) + s++; + if (s < send && isDIGIT(*s)) { + do { + s++; + } while (s < send && isDIGIT(*s)); + } else + return 0; + } + } + while (s < send && isSPACE(*s)) + s++; + if (s >= send) + return numtype; + if (len == 10 && memEQ(pv, "0 but true", 10)) { + if (valuep) + *valuep = 0; + return IS_NUMBER_IN_UV; + } + return 0; +} +#endif +#endif + +/* + * The grok_* routines have been modified to use warn() instead of + * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit, + * which is why the stack variable has been renamed to 'xdigit'. + */ + +#ifndef grok_bin +#if defined(NEED_grok_bin) +static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, + NV *result); +static +#else +extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, + NV *result); +#endif + +#ifdef grok_bin +#undef grok_bin +#endif +#define grok_bin(a, b, c, d) DPPP_(my_grok_bin)(aTHX_ a, b, c, d) +#define Perl_grok_bin DPPP_(my_grok_bin) + +#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL) + UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, + NV *result) +{ + const char *s = start; + STRLEN len = *len_p; + UV value = 0; + NV value_nv = 0; + + const UV max_div_2 = UV_MAX / 2; + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; + bool overflowed = FALSE; + + if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { + /* strip off leading b or 0b. + for compatibility silently suffer "b" and "0b" as valid binary + numbers. */ + if (len >= 1) { + if (s[0] == 'b') { + s++; + len--; + } else if (len >= 2 && s[0] == '0' && s[1] == 'b') { + s += 2; + len -= 2; + } + } + } + + for (; len-- && *s; s++) { + char bit = *s; + if (bit == '0' || bit == '1') { + /* Write it in this wonky order with a goto to attempt to get the + compiler to make the common case integer-only loop pretty tight. + With gcc seems to be much straighter code than old scan_bin. */ + redo: + if (!overflowed) { + if (value <= max_div_2) { + value = (value << 1) | (bit - '0'); + continue; + } + /* Bah. We're just overflowed. */ + warn("Integer overflow in binary number"); + overflowed = TRUE; + value_nv = (NV)value; + } + value_nv *= 2.0; + /* If an NV has not enough bits in its mantissa to + * represent a UV this summing of small low-order numbers + * is a waste of time (because the NV cannot preserve + * the low-order bits anyway): we could just remember when + * did we overflow and in the end just multiply value_nv by the + * right amount. */ + value_nv += (NV)(bit - '0'); + continue; + } + if (bit == '_' && len && allow_underscores && (bit = s[1]) && + (bit == '0' || bit == '1')) { + --len; + ++s; + goto redo; + } + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + warn("Illegal binary digit '%c' ignored", *s); + break; + } + + if ((overflowed && value_nv > 4294967295.0) +#if UVSIZE > 4 + || (!overflowed && value > 0xffffffff) +#endif + ) { + warn("Binary number > 0b11111111111111111111111111111111 non-portable"); + } + *len_p = s - start; + if (!overflowed) { + *flags = 0; + return value; + } + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; + if (result) + *result = value_nv; + return UV_MAX; +} +#endif +#endif + +#ifndef grok_hex +#if defined(NEED_grok_hex) +static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, + NV *result); +static +#else +extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, + NV *result); +#endif + +#ifdef grok_hex +#undef grok_hex +#endif +#define grok_hex(a, b, c, d) DPPP_(my_grok_hex)(aTHX_ a, b, c, d) +#define Perl_grok_hex DPPP_(my_grok_hex) + +#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL) + UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, + NV *result) +{ + const char *s = start; + STRLEN len = *len_p; + UV value = 0; + NV value_nv = 0; + + const UV max_div_16 = UV_MAX / 16; + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; + bool overflowed = FALSE; + const char *xdigit; + + if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { + /* strip off leading x or 0x. + for compatibility silently suffer "x" and "0x" as valid hex numbers. + */ + if (len >= 1) { + if (s[0] == 'x') { + s++; + len--; + } else if (len >= 2 && s[0] == '0' && s[1] == 'x') { + s += 2; + len -= 2; + } + } + } + + for (; len-- && *s; s++) { + xdigit = strchr((char *)PL_hexdigit, *s); + if (xdigit) { + /* Write it in this wonky order with a goto to attempt to get the + compiler to make the common case integer-only loop pretty tight. + With gcc seems to be much straighter code than old scan_hex. */ + redo: + if (!overflowed) { + if (value <= max_div_16) { + value = (value << 4) | ((xdigit - PL_hexdigit) & 15); + continue; + } + warn("Integer overflow in hexadecimal number"); + overflowed = TRUE; + value_nv = (NV)value; + } + value_nv *= 16.0; + /* If an NV has not enough bits in its mantissa to + * represent a UV this summing of small low-order numbers + * is a waste of time (because the NV cannot preserve + * the low-order bits anyway): we could just remember when + * did we overflow and in the end just multiply value_nv by the + * right amount of 16-tuples. */ + value_nv += (NV)((xdigit - PL_hexdigit) & 15); + continue; + } + if (*s == '_' && len && allow_underscores && s[1] && + (xdigit = strchr((char *)PL_hexdigit, s[1]))) { + --len; + ++s; + goto redo; + } + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + warn("Illegal hexadecimal digit '%c' ignored", *s); + break; + } + + if ((overflowed && value_nv > 4294967295.0) +#if UVSIZE > 4 + || (!overflowed && value > 0xffffffff) +#endif + ) { + warn("Hexadecimal number > 0xffffffff non-portable"); + } + *len_p = s - start; + if (!overflowed) { + *flags = 0; + return value; + } + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; + if (result) + *result = value_nv; + return UV_MAX; +} +#endif +#endif + +#ifndef grok_oct +#if defined(NEED_grok_oct) +static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, + NV *result); +static +#else +extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, + NV *result); +#endif + +#ifdef grok_oct +#undef grok_oct +#endif +#define grok_oct(a, b, c, d) DPPP_(my_grok_oct)(aTHX_ a, b, c, d) +#define Perl_grok_oct DPPP_(my_grok_oct) + +#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL) + UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, + NV *result) +{ + const char *s = start; + STRLEN len = *len_p; + UV value = 0; + NV value_nv = 0; + + const UV max_div_8 = UV_MAX / 8; + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; + bool overflowed = FALSE; + + for (; len-- && *s; s++) { + /* gcc 2.95 optimiser not smart enough to figure that this subtraction + out front allows slicker code. */ + int digit = *s - '0'; + if (digit >= 0 && digit <= 7) { + /* Write it in this wonky order with a goto to attempt to get the + compiler to make the common case integer-only loop pretty tight. + */ + redo: + if (!overflowed) { + if (value <= max_div_8) { + value = (value << 3) | digit; + continue; + } + /* Bah. We're just overflowed. */ + warn("Integer overflow in octal number"); + overflowed = TRUE; + value_nv = (NV)value; + } + value_nv *= 8.0; + /* If an NV has not enough bits in its mantissa to + * represent a UV this summing of small low-order numbers + * is a waste of time (because the NV cannot preserve + * the low-order bits anyway): we could just remember when + * did we overflow and in the end just multiply value_nv by the + * right amount of 8-tuples. */ + value_nv += (NV)digit; + continue; + } + if (digit == ('_' - '0') && len && allow_underscores && + (digit = s[1] - '0') && (digit >= 0 && digit <= 7)) { + --len; + ++s; + goto redo; + } + /* Allow \octal to work the DWIM way (that is, stop scanning + * as soon as non-octal characters are seen, complain only iff + * someone seems to want to use the digits eight and nine). */ + if (digit == 8 || digit == 9) { + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + warn("Illegal octal digit '%c' ignored", *s); + } + break; + } + + if ((overflowed && value_nv > 4294967295.0) +#if UVSIZE > 4 + || (!overflowed && value > 0xffffffff) +#endif + ) { + warn("Octal number > 037777777777 non-portable"); + } + *len_p = s - start; + if (!overflowed) { + *flags = 0; + return value; + } + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; + if (result) + *result = value_nv; + return UV_MAX; +} +#endif +#endif + +#ifdef NO_XSLOCKS +#ifdef dJMPENV +#define dXCPT \ + dJMPENV; \ + int rEtV = 0 +#define XCPT_TRY_START \ + JMPENV_PUSH(rEtV); \ + if (rEtV == 0) +#define XCPT_TRY_END JMPENV_POP; +#define XCPT_CATCH if (rEtV != 0) +#define XCPT_RETHROW JMPENV_JUMP(rEtV) +#else +#define dXCPT \ + Sigjmp_buf oldTOP; \ + int rEtV = 0 +#define XCPT_TRY_START \ + Copy(top_env, oldTOP, 1, Sigjmp_buf); \ + rEtV = Sigsetjmp(top_env, 1); \ + if (rEtV == 0) +#define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf); +#define XCPT_CATCH if (rEtV != 0) +#define XCPT_RETHROW Siglongjmp(top_env, rEtV) +#endif +#endif + +#endif /* _P_P_PORTABILITY_H_ */ + +/* End of File ppport.h */ diff --git a/perl/t/Decoder.t b/perl/t/Decoder.t new file mode 100755 index 0000000..12ba86f --- /dev/null +++ b/perl/t/Decoder.t @@ -0,0 +1,111 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl Decoder.t' + +use warnings; +use strict; +use Test::More tests => 17; + +######################### + +BEGIN { use_ok('Barcode::ZBar') } + +######################### + +my $decoder = Barcode::ZBar::Decoder->new(); +isa_ok($decoder, 'Barcode::ZBar::Decoder', 'decoder'); + +$decoder->parse_config('enable'); + +######################### + +can_ok($decoder, qw(set_config parse_config reset new_scan decode_width + get_color get_configs get_direction get_data get_modifiers + get_type set_handler)); + +######################### + +my $sym = $decoder->decode_width(5); +is($sym, Barcode::ZBar::Symbol::NONE, 'enum/enum compare'); + +######################### + +ok($sym == 0, 'enum/numeric compare'); + +######################### + +is($sym, 'None', 'enum/string compare'); + +######################### + +my $handler_type = 0; +my $explicit_closure = 0; + +$decoder->set_handler(sub { + if(!$handler_type) { + is($_[0], $decoder, 'handler decoder'); + } + + my $type = $_[0]->get_type(); + $handler_type = $type + if(!$handler_type or $type > Barcode::ZBar::Symbol::PARTIAL); + + ${$_[1]} += 1 +}, \$explicit_closure); + +######################### + +$decoder->reset(); +is($decoder->get_color(), Barcode::ZBar::SPACE, 'reset color'); + +######################### + +is($decoder->get_direction(), 0, 'reset direction'); + +######################### + +$decoder->set_config(Barcode::ZBar::Symbol::QRCODE, + Barcode::ZBar::Config::ENABLE, 0); + +my $encoded = + '9 111 212241113121211311141132 11111 311213121312121332111132 111 9'; + +foreach my $width (split(/ */, $encoded)) { + my $tmp = $decoder->decode_width($width); + if($tmp > Barcode::ZBar::Symbol::PARTIAL) { + $sym = ($sym == Barcode::ZBar::Symbol::NONE) ? $tmp : -1; + } +} +is($sym, Barcode::ZBar::Symbol::EAN13, 'EAN-13 type'); + +######################### + +is_deeply([$decoder->get_configs($sym)], + [Barcode::ZBar::Config::ENABLE, + Barcode::ZBar::Config::EMIT_CHECK], + 'read configs'); + +######################### + +is_deeply([$decoder->get_modifiers()], [], 'read modifiers'); + +######################### + +is($decoder->get_data(), '6268964977804', 'EAN-13 data'); + +######################### + +is($decoder->get_color(), Barcode::ZBar::BAR, 'post-scan color'); + +######################### + +is($decoder->get_direction(), 1, 'decode direction'); + +######################### + +is($handler_type, Barcode::ZBar::Symbol::EAN13, 'handler type'); + +######################### + +is($explicit_closure, 2, 'handler explicit closure'); + +######################### diff --git a/perl/t/Image.t b/perl/t/Image.t new file mode 100755 index 0000000..a63b985 --- /dev/null +++ b/perl/t/Image.t @@ -0,0 +1,186 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl Image.t' + +use warnings; +use strict; +use Test::More tests => 29; + +######################### + +BEGIN { use_ok('Barcode::ZBar') } + +Barcode::ZBar::set_verbosity(16); + +######################### + +my $image = Barcode::ZBar::Image->new(); +isa_ok($image, 'Barcode::ZBar::Image', 'image'); + +######################### + +my $scanner = Barcode::ZBar::ImageScanner->new(); +isa_ok($scanner, 'Barcode::ZBar::ImageScanner', 'image scanner'); + +######################### + +can_ok($image, qw(convert convert_resize + get_format get_size get_data + set_format set_size set_data)); + +######################### + +can_ok($scanner, qw(set_config parse_config enable_cache scan_image)); + +######################### + +$image->set_format('422P'); +my $fmt = $image->get_format(); +is($fmt, '422P', 'string format accessors'); + +######################### + +ok($fmt == 0x50323234, 'numeric format accessors'); + +######################### + +$image->set_size(114, 80); +is_deeply([$image->get_size()], [114, 80], 'size accessors'); + +######################### + +$image->set_crop(20, 20, 74, 40); +is_deeply([$image->get_crop()], [20, 20, 74, 40], 'crop accessors'); + +######################### + +$image->set_crop(-57, -40, 228, 160); +is_deeply([$image->get_crop()], [0, 0, 114, 80], 'crop clipping'); + +######################### + +$image->set_crop(10, 10, 94, 60); +is_deeply([$image->get_crop()], [10, 10, 94, 60], 'crop accessors'); + +######################### + +$image->set_size(114, 80); +is_deeply([$image->get_crop()], [0, 0, 114, 80], 'crop reset'); + +######################### + +# FIXME avoid skipping these (eg embed image vs ImageMagick) +SKIP: { + eval { require Image::Magick }; + skip "Image::Magick not installed", 16 if $@; + + my $im = Image::Magick->new(); + my $err = $im->Read('t/barcode.png'); + die($err) if($err); + + $image->set_size($im->Get(qw(columns rows))); + + { + my $data = $im->ImageToBlob( + magick => 'YUV', + 'sampling-factor' => '4:2:2', + interlace => 'Plane'); + $image->set_data($data); + } + + $image = $image->convert('Y800'); + isa_ok($image, 'Barcode::ZBar::Image', 'image'); + + ######################### + + is($image->get_format(), 'Y800', 'converted image format'); + + ######################### + + is_deeply([$image->get_size()], [114, 80], 'converted image size'); + + ######################### + + is($scanner->scan_image($image), 1, 'scan result'); + + ######################### + + my @symbols = $image->get_symbols(); + is(scalar(@symbols), 1, 'result size'); + + ######################### + + my $sym = $symbols[0]; + isa_ok($sym, 'Barcode::ZBar::Symbol', 'symbol'); + + ######################### + + can_ok($sym, qw(get_type get_configs get_modifiers get_data get_quality + get_count get_loc get_orientation)); + + ######################### + + is($sym->get_type(), Barcode::ZBar::Symbol::EAN13, 'result type'); + + ######################### + + is_deeply([$sym->get_configs()], + [Barcode::ZBar::Config::ENABLE, + Barcode::ZBar::Config::EMIT_CHECK], + 'result configs'); + + ######################### + + is_deeply([$sym->get_modifiers()], [], 'result modifiers'); + + ######################### + + is($sym->get_data(), '9876543210128', 'result data'); + + ######################### + + ok($sym->get_quality() > 0, 'quality'); + + ######################### + + my @loc = $sym->get_loc(); + ok(scalar(@loc) >= 4, 'location size'); + + ######################### + + my $failure = undef; + foreach my $pt (@loc) { + if(ref($pt) ne 'ARRAY') { + $failure = ("location entry is wrong type:" . + " expecting ARRAY ref, got " . ref($pt)); + last; + } + if(scalar(@{$pt}) != 2) { + $failure = ("location coordinate has too many entries:" . + " expecting 2, got " . scalar(@{$pt})); + last; + } + } + ok(!defined($failure), 'location structure') or + diag($failure); + + ######################### + + is($sym->get_orientation(), Barcode::ZBar::Orient::UP, 'orientation'); + + ######################### + + my @comps = $sym->get_components(); + is(scalar(@comps), 0, 'components size'); + + ######################### +} + +$scanner->recycle_image($image); + +my @symbols = $image->get_symbols(); +is(scalar(@symbols), 0, 'recycled result size'); + +######################### + + +# FIXME more image tests diff --git a/perl/t/Processor.t b/perl/t/Processor.t new file mode 100755 index 0000000..92bf6fe --- /dev/null +++ b/perl/t/Processor.t @@ -0,0 +1,140 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl Processor.t' + +use warnings; +use strict; +use Test::More tests => 20; + +######################### + +BEGIN { use_ok('Barcode::ZBar') } + +Barcode::ZBar::set_verbosity(32); + +######################### + +my $proc = Barcode::ZBar::Processor->new(); +isa_ok($proc, 'Barcode::ZBar::Processor', 'processor'); + +######################### + +can_ok($proc, qw(init set_config parse_config)); + +######################### + +ok(!$proc->parse_config('enable'), 'configuration'); + +######################### + +my $cnt = 0; +my $explicit_closure = 0; + +$proc->set_data_handler(sub { + + ok(!$cnt, 'handler invocations'); + $cnt += 1; + + ######################### + + is($_[0], $proc, 'handler processor'); + + ######################### + + my $image = $_[1]; + isa_ok($image, 'Barcode::ZBar::Image', 'image'); + + ######################### + + my @symbols = $image->get_symbols(); + is(scalar(@symbols), 1, 'result size'); + + ######################### + + my $sym = $symbols[0]; + isa_ok($sym, 'Barcode::ZBar::Symbol', 'symbol'); + + ######################### + + is($sym->get_type(), Barcode::ZBar::Symbol::EAN13, 'result type'); + + ######################### + + is($sym->get_data(), '9876543210128', 'result data'); + + ######################### + + ok($sym->get_quality() > 0, 'quality'); + + ######################### + + my @loc = $sym->get_loc(); + ok(scalar(@loc) >= 4, 'location size'); + + # structure checked by Image.t + + ${$_[2]} += 1 +}, \$explicit_closure); + +######################### + +SKIP: { + skip "no display", 3 unless defined $ENV{'DISPLAY'}; + + $proc->init($ENV{VIDEO_DEVICE}); + ok(!$proc->is_visible(), 'initial visibility'); + + ######################### + + $proc->set_visible(); + ok($proc->is_visible(), 'enabled visiblity'); + + ######################### + + ok($proc->user_wait(1.1) >= 0, 'wait w/timeout'); + + ######################### +} + +SKIP: { + # FIXME factor out image read utility + eval { require Image::Magick }; + skip "Image::Magick not installed", 11 if $@; + my $im = Image::Magick->new(); + my $err = $im->Read('t/barcode.png'); + die($err) if($err); + my $image = Barcode::ZBar::Image->new(); + $image->set_format('422P'); + $image->set_size($im->Get(qw(columns rows))); + $image->set_data($im->ImageToBlob( + magick => 'YUV', + 'sampling-factor' => '4:2:2', + interlace => 'Plane') + ); + +SKIP: { + skip "no display", 11 unless defined $ENV{'DISPLAY'}; + + my $rc = $proc->process_image($image); + ok(!$rc, 'process result'); + + $proc->user_wait(.9); + + ######################### + + is($explicit_closure, 1, 'handler explicit closure'); + } +} + +######################### + +$proc->set_data_handler(); +pass('unset handler'); + +######################### + +# FIXME more processor tests + +$proc = undef; +pass('cleanup'); + +######################### diff --git a/perl/t/Scanner.t b/perl/t/Scanner.t new file mode 100755 index 0000000..99b8942 --- /dev/null +++ b/perl/t/Scanner.t @@ -0,0 +1,23 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl Scanner.t' + +use warnings; +use strict; +use Test::More tests => 3; + +######################### + +BEGIN { use_ok('Barcode::ZBar') } + +######################### + +my $scanner = Barcode::ZBar::Scanner->new(); +isa_ok($scanner, 'Barcode::ZBar::Scanner', 'scanner'); + +######################### + +can_ok($scanner, qw(reset new_scan scan_y get_width get_color)); + +######################### + +# FIXME more scanner tests diff --git a/perl/t/ZBar.t b/perl/t/ZBar.t new file mode 100755 index 0000000..0e3a867 --- /dev/null +++ b/perl/t/ZBar.t @@ -0,0 +1,68 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl ZBar.t' + +use warnings; +use strict; +use Test::More tests => 37; + +######################### + +BEGIN { use_ok('Barcode::ZBar') } + +######################### + +like(Barcode::ZBar::version(), qr<\d.\d>, 'version'); + +######################### + +Barcode::ZBar::set_verbosity(16); +Barcode::ZBar::increase_verbosity(); +pass('verbosity'); + +######################### + +# performs (2 * n) tests +sub test_enum { + my $name = shift; + foreach my $test (@_) { + my $enum = $test->[0]; + + is($enum, $test->[1], "$name enum/string compare"); + + ######################### + + ok($enum == $test->[2], "$name enum/numeric compare"); + } +} + +test_enum('config', + [Barcode::ZBar::Config::ENABLE, 'enable', 0], + [Barcode::ZBar::Config::ADD_CHECK, 'add-check', 1], + [Barcode::ZBar::Config::EMIT_CHECK, 'emit-check', 2], + [Barcode::ZBar::Config::ASCII, 'ascii', 3], + [Barcode::ZBar::Config::MIN_LEN, 'min-length', 32], + [Barcode::ZBar::Config::MAX_LEN, 'max-length', 33], + [Barcode::ZBar::Config::UNCERTAINTY, 'uncertainty', 64], + [Barcode::ZBar::Config::POSITION, 'position', 128], + [Barcode::ZBar::Config::X_DENSITY, 'x-density', 256], + [Barcode::ZBar::Config::Y_DENSITY, 'y-density', 257], +); + +######################### + +test_enum('modifier', + [Barcode::ZBar::Modifier::GS1, 'GS1', 0], + [Barcode::ZBar::Modifier::AIM, 'AIM', 1], +); + +######################### + +test_enum('orientation', + [Barcode::ZBar::Orient::UNKNOWN, 'UNKNOWN', -1], + [Barcode::ZBar::Orient::UP, 'UP', 0], + [Barcode::ZBar::Orient::RIGHT, 'RIGHT', 1], + [Barcode::ZBar::Orient::DOWN, 'DOWN', 2], + [Barcode::ZBar::Orient::LEFT, 'LEFT', 3], +); + +######################### diff --git a/perl/t/barcode.png b/perl/t/barcode.png new file mode 100644 index 0000000..72846ce Binary files /dev/null and b/perl/t/barcode.png differ diff --git a/perl/t/pod-coverage.t b/perl/t/pod-coverage.t new file mode 100644 index 0000000..97c2df8 --- /dev/null +++ b/perl/t/pod-coverage.t @@ -0,0 +1,12 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl pod.t' + +use warnings; +use strict; +use Test::More; + +eval "use Test::Pod::Coverage"; +plan skip_all => "Test::Pod::Coverage required for testing pod coverage" + if $@; + +all_pod_coverage_ok(); diff --git a/perl/t/pod.t b/perl/t/pod.t new file mode 100644 index 0000000..bc0af34 --- /dev/null +++ b/perl/t/pod.t @@ -0,0 +1,12 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl pod.t' + +use warnings; +use strict; +use Test::More; + +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" + if $@; + +all_pod_files_ok(); diff --git a/perl/typemap b/perl/typemap new file mode 100644 index 0000000..dda1979 --- /dev/null +++ b/perl/typemap @@ -0,0 +1,66 @@ +# objects +Barcode::ZBar::Error T_PTROBJ +Barcode::ZBar::Symbol T_PTROBJ +Barcode::ZBar::Image T_PTROBJ +Barcode::ZBar::Processor T_PTROBJ +Barcode::ZBar::Video T_PTROBJ +Barcode::ZBar::Window T_PTROBJ +Barcode::ZBar::ImageScanner T_PTROBJ +Barcode::ZBar::Decoder T_PTROBJ +Barcode::ZBar::Scanner T_PTROBJ + +# enums +zbar_color_t T_ENUM +zbar_error_t T_ENUM +zbar_symbol_type_t T_ENUM +zbar_config_t T_ENUM +zbar_modifier_t T_ENUM +zbar_orientation_t T_ENUM + +# special scalars +fourcc_t T_FOURCC +timeout_t T_TIMEOUT + +# error handling +config_error T_CONFIG_ERROR + + +INPUT + +T_ENUM + $var = ($type)SvIV($arg) +T_FOURCC + { + if(SvPOK($arg)) { + char *str = SvPV_nolen($arg); + $var = zbar_fourcc_parse(str); + } + else + $var = SvUV($arg); + } +T_TIMEOUT + if(($var = ($type)(SvNV($arg) * 1000.)) < 0) + $var = -1; +T_PV + $var = SvOK($arg) ? SvPV_nolen($arg) : NULL; + +OUTPUT + +T_ENUM + $arg = SvREFCNT_inc(lookup_enum(LOOKUP_$ntype, (int)$var)); +T_FOURCC + { + char str[4] = { + $var & 0xff, + ($var >> 8) & 0xff, + ($var >> 16) & 0xff, + ($var >> 24) & 0xff, + }; + sv_setuv($arg, $var); + sv_setpvn($arg, str, 4); + SvIOK_on($arg); + } + +T_CONFIG_ERROR + if($var) + croak("invalid configuration setting: %s", config_string); -- cgit v1.2.3