Data-CompactReadonly-0.1.1/000755 000765 000024 00000000000 14517560622 015706 5ustar00davidstaff000000 000000 Data-CompactReadonly-0.1.1/GPL2.txt000644 000765 000024 00000043103 13761512610 017146 0ustar00davidstaff000000 000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 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. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, 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 or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. 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 Program or any portion of it, thus forming a work based on the Program, 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) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, 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 Program, 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 Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, 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 executable. However, as a special exception, the source code 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. If distribution of executable or 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 counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program 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. 5. 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 Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. 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 Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program 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 Program. 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. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program 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. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of 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 Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. Data-CompactReadonly-0.1.1/ARTISTIC.txt000644 000765 000024 00000013737 13761512610 017676 0ustar00davidstaff000000 000000 The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Data-CompactReadonly-0.1.1/MANIFEST.SKIP000644 000765 000024 00000000115 13761512610 017573 0ustar00davidstaff000000 000000 .DS_Store ^\.git .envrc .travis.yml .appveyor.yml .cirrus.yml cover_db/ TODO Data-CompactReadonly-0.1.1/MANIFEST000644 000765 000024 00000004236 14517560622 017044 0ustar00davidstaff000000 000000 ARTISTIC.txt CHANGELOG GPL2.txt MANIFEST MANIFEST.SKIP Makefile.PL t/file-open.t t/pod-coverage.t t/pod.t t/root-node-array.t t/root-node-dictionary.t t/root-node-scalar.t t/root-node-text.t t/coverage.sh t/create-scalar.t t/create-collection.t lib/Data/CompactReadonly/Array.pm lib/Data/CompactReadonly/Dictionary.pm lib/Data/CompactReadonly/V0/Array/Byte.pm lib/Data/CompactReadonly/V0/Array/Long.pm lib/Data/CompactReadonly/V0/Array/Medium.pm lib/Data/CompactReadonly/V0/Array/Short.pm lib/Data/CompactReadonly/V0/Array.pm lib/Data/CompactReadonly/V0/Collection.pm lib/Data/CompactReadonly/V0/Dictionary/Byte.pm lib/Data/CompactReadonly/V0/Dictionary/Long.pm lib/Data/CompactReadonly/V0/Dictionary/Medium.pm lib/Data/CompactReadonly/V0/Dictionary/Short.pm lib/Data/CompactReadonly/V0/Dictionary.pm lib/Data/CompactReadonly/V0/Format.pod lib/Data/CompactReadonly/V0/NegativeScalar.pm lib/Data/CompactReadonly/V0/Node.pm lib/Data/CompactReadonly/V0/Scalar/Byte.pm lib/Data/CompactReadonly/V0/Scalar/Float64.pm lib/Data/CompactReadonly/V0/Scalar/Huge.pm lib/Data/CompactReadonly/V0/Scalar/Long.pm lib/Data/CompactReadonly/V0/Scalar/Medium.pm lib/Data/CompactReadonly/V0/Scalar/NegativeByte.pm lib/Data/CompactReadonly/V0/Scalar/NegativeHuge.pm lib/Data/CompactReadonly/V0/Scalar/NegativeLong.pm lib/Data/CompactReadonly/V0/Scalar/NegativeMedium.pm lib/Data/CompactReadonly/V0/Scalar/NegativeShort.pm lib/Data/CompactReadonly/V0/Scalar/Null.pm lib/Data/CompactReadonly/V0/Scalar/Short.pm lib/Data/CompactReadonly/V0/Scalar.pm lib/Data/CompactReadonly/V0/Text/Byte.pm lib/Data/CompactReadonly/V0/Text/Long.pm lib/Data/CompactReadonly/V0/Text/Medium.pm lib/Data/CompactReadonly/V0/Text/Short.pm lib/Data/CompactReadonly/V0/Text.pm lib/Data/CompactReadonly.pm t/tie.t lib/Data/CompactReadonly/V0/TiedArray.pm lib/Data/CompactReadonly/V0/TiedDictionary.pm t/lib/TestFloat.pm t/bug-Number-Phone-1546702248.t lib/Data/CompactReadonly/V0/Scalar/False.pm lib/Data/CompactReadonly/V0/Scalar/True.pm lib/Data/CompactReadonly/V0/Scalar/HeaderOnly.pm META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Data-CompactReadonly-0.1.1/t/000755 000765 000024 00000000000 14517560621 016150 5ustar00davidstaff000000 000000 Data-CompactReadonly-0.1.1/META.yml000644 000765 000024 00000001556 14517560621 017165 0ustar00davidstaff000000 000000 --- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.66, CPAN::Meta::Converter version 2.150010' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Data-CompactReadonly no_index: directory: - t - inc requires: Data::IEEE754: '0' Devel::StackTrace: '0' File::Temp: '0' Scalar::Type: v0.3.1 Scalar::Util: '0' String::Binary::Interpolation: '0' Test::Differences: '0' Test::Exception: '0' Test::More: '0.96' resources: bugtracker: https://github.com/DrHyde/perl-modules-Data-CompactReadonly/issues repository: https://github.com/DrHyde/perl-modules-Data-CompactReadonly version: v0.1.1 x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Data-CompactReadonly-0.1.1/META.json000644 000765 000024 00000002706 14517560622 017334 0ustar00davidstaff000000 000000 { "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.66, CPAN::Meta::Converter version 2.150010", "license" : [ "unknown", "open_source" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Data-CompactReadonly", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Data::IEEE754" : "0", "Devel::StackTrace" : "0", "File::Temp" : "0", "Scalar::Type" : "v0.3.1", "Scalar::Util" : "0", "String::Binary::Interpolation" : "0", "Test::Differences" : "0", "Test::Exception" : "0", "Test::More" : "0.96" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/DrHyde/perl-modules-Data-CompactReadonly/issues" }, "repository" : { "url" : "https://github.com/DrHyde/perl-modules-Data-CompactReadonly" } }, "version" : "v0.1.1", "x_serialization_backend" : "JSON::PP version 4.02" } Data-CompactReadonly-0.1.1/lib/000755 000765 000024 00000000000 14517560621 016453 5ustar00davidstaff000000 000000 Data-CompactReadonly-0.1.1/Makefile.PL000644 000765 000024 00000002056 14166354123 017660 0ustar00davidstaff000000 000000 #!perl use strict; use warnings; use ExtUtils::MakeMaker; # 32 bit ints aren't supported (that's 0xffffffffffffffff) die("OS unsupported\n") if(~0 < 18446744073709551615); use 5.8.9; WriteMakefile( NAME => 'Data::CompactReadonly', META_MERGE => { license => 'open_source', resources => { repository => 'https://github.com/DrHyde/perl-modules-Data-CompactReadonly', bugtracker => 'https://github.com/DrHyde/perl-modules-Data-CompactReadonly/issues' } }, VERSION_FROM => 'lib/Data/CompactReadonly.pm', PREREQ_PM => { 'Data::IEEE754' => 0, # cant use pack's d> because that uses *native* format 'Devel::StackTrace' => 0, 'File::Temp' => 0, 'Scalar::Type' => '0.3.1', 'Scalar::Util' => 0, 'String::Binary::Interpolation' => 0, 'Test::Differences' => 0, 'Test::Exception' => 0, 'Test::More' => '0.96', # done_testing and subtests }, ); Data-CompactReadonly-0.1.1/CHANGELOG000644 000765 000024 00000002206 14517547073 017125 0ustar00davidstaff000000 000000 0.1.1 2023-10-29 - Minor doco update so that generated manpages are better 0.1.0 2022-01-08 - Float type renamed to Float64 in preparation for support for different length floats (no functional or format changes from previous floating point behaviour) - Add support for Boolean types (in perl 5.35.7 and later) 0.0.6 2021-06-04 - More accurate detection of int/float/string types when creating a database 2021-04-08 0.0.5 Introduce optional caching for Dictionaries, to make reads faster at the expense of eating more memory; Other speed improvements 2020-12-18 0.0.4 Bugfixes for writing nested data structures and reading empty tied hashes; Bugfix for calling exists() on an empty Dictionary; De-dup entire hashes/arrays on file creation if their contents are the same 2020-12-09 0.0.3 More floating point fixes, for perls using gcc's libquadmath 2020-12-05 0.0.2 Fix floating point issues in tests; Stop writing numeric hash keys because of FP imprecision 2020-12-03 0.0.1 First release Data-CompactReadonly-0.1.1/lib/Data/000755 000765 000024 00000000000 14517560621 017324 5ustar00davidstaff000000 000000 Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/000755 000765 000024 00000000000 14517560621 022410 5ustar00davidstaff000000 000000 Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly.pm000644 000765 000024 00000022145 14517552444 022756 0ustar00davidstaff000000 000000 package Data::CompactReadonly; use warnings; use strict; use Data::CompactReadonly::V0::Node; # Yuck, semver. I give in, the stupid cult that doesn't understand # what the *number* bit of *version number* means has won. our $VERSION = '0.1.1'; =head1 NAME Data::CompactReadonly - create and read Compact Read Only Databases =head1 DESCRIPTION A Compact Read Only Database that consumes very little memory. Once created a database can not be practically updated except by re-writing the whole thing. The aim is for random-access read performance to be on a par with L and for files to be much smaller. =head1 VERSION 'NUMBERS' This module uses semantic versioning. That means that the version 'number' isn't really a number but has three parts: C. The C number will increase when the API changes incompatibly; The C number will increase when backward-compatible additions are made to the API; The C number will increase when bugs are fixed backward-compatibly. =head1 FILE FORMAT VERSIONS All versions so far support file format version 0 only. See L for details of what that means. =head1 METHODS =head2 create Takes two arguments, the name of file into which to write a database, and some data. The data can be undef, a number, some text, or a reference to an array or hash that in turn consists of undefs, numbers, text, references to arrays or hashes, and so on ad infinitum. This method may be very slow. It constructs a file by making lots of little writes and seek()ing all over the place. It doesn't do anything clever to figure out what pointer size to use, it just tries the shortest first, and then if that's not enough tries again, and again, bigger each time. See L for more on pointer sizes. It may also eat B of memory. It keeps a cache of everything it has seen while building your database, so that it can re-use data by just pointing at it instead of writing multiple copies of the same data into the file. It tries really hard to preserve data types. So for example, C<60000> is stored and read back as an integer, but C<"60000"> is stored and read back as a string. This means that you can correctly store and retrieve C<"007"> but that C<007> will have the leading zeroes removed before Data::CompactReadonly ever sees it and so will be treated as exactly equivalent to C<7>. The same applies to floating point values too. C<"7.10"> is stored as a four byte string, but C<7.10> is stored the same as C<7.1>, as an eight byte IEEE754 double precision float. Note that perl parses values like C<7.0> as floating point, and thus so does this module. Finally, while the file format permits numeric keys and Booleans in hashes, this method always coerces them to text. It does that to numbers because if you allow numeric keys, numbers that can't be represented in an C, such as 1e100 or 3.14 will be subject to floating point imprecision, and so it is unlikely that you will ever be able to retrieve them as no exact match is possible. And it does it to Booleans because when you un-serialise them on an older perl they may be confused with strings, leading to loss of data if those strings are also present as keys in the dictionary. =head2 read Takes a single compulsory argument, which is a filename or an already open file handle, and some options. If the first argument is a filehandle, the current file pointer should be at the start of the database (not necessarily at the start of the file; the database could be in a C<__DATA__> segment) and B have been opened in "just the bytes ma'am" mode. It is a fatal error to pass in a filehandle which was not opened correctly or the name of a file that can't be opened or which doesn't contain a valid database. The options are name/value pairs. Valid options are: =over =item tie If true return tied objects instead of normal objects. This means that you will be able to access data by de-referencing and pretending to access elements directly. Under the bonnet this wraps around the objects as documented below, so is just a layer of indirection. On modern hardware you probably won't notice the concomittant slow down but may appreciate the convenience. =item fast_collections If true Dictionary keys and values will be permanently cached in memory the first time they are seen, instead of being fetched from the file when needed. Yes, this means that objects will grow in memory, potentially very large. Only use this if if it an acceptable pay-off for much faster access. This is not yet implemented for Arrays. =back Returns the "root node" of the database. If that root node is a number, some piece of text, True, False, or Null, then it is decoded and the value returned. Otherwise an object (possibly a tied object) representing an Array or a Dictionary is returned. =head1 OBJECTS If you asked for normal objects to be returned instead of tied objects, then these are sub-classes of either C or C. Both implement the following three methods: =head2 id Returns a unique id for this object within the database. Note that circular data structures are supported, and looking at the C is the only way to detect them. This is not accessible when using tied objects. =head2 count Returns the number of elements in the structure. =head2 indices Returns a list of all the available indices in the structure. =head2 element Takes a single argument, which must match one of the values that would be returned by C, and returns the associated data. If the data is a number, Null, or text, the value will be returned directly. If the data is in turn another array or dictionary, an object will be returned. =head2 exists Takes a single argument and tell you whether an index exists for it. It will still die if you ask it fomr something stupid such as a floating point array index or a Null dictionary entry. =head1 UNSUPPORTED PERL TYPES Globs, Regexes, References (except to Arrays and Dictionaries). Booleans are only supported on perl version 5.35.7 or later. On earlier perls, a Boolean in the database will be decoded as a true or false I, but its type will be numeric or string. And a older perls will never write a True or False node to the database, they'll always write numbers or strings with true/false values, which other implementations will decode as numbers or strings. =head1 BUGS/FEEDBACK Please report bugs by at L, including, if possible, a test case. =head1 SEE ALSO L if you need updateable databases. =head1 SOURCE CODE REPOSITORY L =head1 AUTHOR, COPYRIGHT and LICENCE Copyright 2023 David Cantrell EFE This software is free-as-in-speech software, and may be used, distributed, and modified under the terms of either the GNU General Public Licence version 2 or the Artistic Licence. It's up to you which one you use. The full text of the licences can be found in the files GPL2.txt and ARTISTIC.txt, respectively. =head1 CONSPIRACY This module is also free-as-in-mason software. =cut sub create { my($class, $file, $data) = @_; my $version = 0; PTR_SIZE: foreach my $ptr_size (1 .. 8) { my $byte5 = chr(($version << 3) + $ptr_size - 1); open(my $fh, '>:unix', $file) || die("Can't write $file: $! \n"); print $fh "CROD$byte5"; eval { "Data::CompactReadonly::V${version}::Node"->_create( filename => $file, fh => $fh, ptr_size => $ptr_size, data => $data, globals => { next_free_ptr => tell($fh), already_seen => {} } ); }; if($@ && index($@, "Data::CompactReadonly::V${version}::Node"->_ptr_blown()) != -1) { next PTR_SIZE; } elsif($@) { die($@); } last PTR_SIZE; } } sub read { my($class, $file, %args) = @_; my $fh; if(ref($file)) { $fh = $file; my @layers = PerlIO::get_layers($fh); if(grep { $_ !~ /^(unix|perlio|scalar)$/ } @layers) { die( "$class: file handle has invalid encoding [". join(', ', @layers). "]\n" ); } } else { open($fh, '<', $file) || die("$class couldn't open file $file: $!\n"); binmode($fh); } my $original_file_pointer = tell($fh); read($fh, my $header, 5); (my $byte5) = ($header =~ /^CROD(.)/); die("$class: $file header invalid: doesn't match /CROD./\n") unless(defined($byte5)); my $version = (ord($byte5) & 0b11111000) >> 3; my $ptr_size = (ord($byte5) & 0b00000111) + 1; die("$class: $file header invalid: bad version\n") if($version == 0b11111); return "Data::CompactReadonly::V${version}::Node"->_init( ptr_size => $ptr_size, fh => $fh, db_base => $original_file_pointer, map { exists($args{$_}) ? ($_ => 1 ) : () } qw(fast_collections tie) ); } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/000755 000765 000024 00000000000 14517560621 022675 5ustar00davidstaff000000 000000 Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/Dictionary.pm000644 000765 000024 00000000452 14166354123 025052 0ustar00davidstaff000000 000000 package Data::CompactReadonly::Dictionary; our $VERSION = '0.1.0'; sub use_base_is_buggy_and_insists_that_there_be_something_here {} 1; # empty package that exists only so that D::C::V*::Dictionary can inherit # from it and you can check that something ->isa('Data::CompactReadonly::Dictionary'); Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/Array.pm000644 000765 000024 00000000434 14166354123 024023 0ustar00davidstaff000000 000000 package Data::CompactReadonly::Array; our $VERSION = '0.1.0'; sub use_base_is_buggy_and_insists_that_there_be_something_here {} 1; # empty package that exists only so that D::C::V*::Array can inherit # from it and you can check that something ->isa('Data::CompactReadonly::Array'); Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/TiedArray.pm000644 000765 000024 00000001262 14166354123 025116 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::TiedArray; our $VERSION = '0.1.0'; use strict; use warnings; sub TIEARRAY { my($class, $object) = @_; return bless([ $object ], $class); } sub EXISTS { shift()->[0]->exists(shift()); } sub FETCH { shift()->[0]->element(shift()); } sub FETCHSIZE { shift()->[0]->count(); } sub STORE { die("Illegal access: store: this is a read-only database\n"); } sub STORESIZE { shift()->STORE() } sub DELETE { shift()->STORE() } sub CLEAR { shift()->STORE() } sub PUSH { shift()->STORE() } sub POP { shift()->STORE() } sub SHIFT { shift()->STORE() } sub UNSHIFT { shift()->STORE() } sub SPLICE { shift()->STORE() } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/000755 000765 000024 00000000000 14517560621 024102 5ustar00davidstaff000000 000000 Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Collection.pm000644 000765 000024 00000002365 14166354123 025332 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Collection; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Node'; use Scalar::Util qw(blessed); use Data::CompactReadonly::V0::Scalar; sub _numeric_type_for_length { my $invocant = shift(); (my $class = blessed($invocant) ? blessed($invocant) : $invocant) =~ s/(Text|Array|Dictionary)/Scalar/; return $class; } sub count { my $self = shift; if($self->{cache} && exists($self->{cache}->{count})) { return $self->{cache}->{count}; } elsif($self->{cache}) { return $self->{cache}->{count} = $self->_count(); } else { return $self->_count(); } } sub _count { my $self = shift; $self->_seek($self->_offset()); return $self->_numeric_type_for_length()->_init(root => $self->_root()); } sub id { my $self = shift; return $self->_offset(); } sub _scalar_type_bytes { my $self = shift; return $self->_numeric_type_for_length()->_num_bytes(); } sub _encode_ptr { my($class, %args) = @_; return Data::CompactReadonly::V0::Scalar->_encode_word_as_number_of_bytes( $args{pointer}, $args{ptr_size} ); } sub _decode_ptr { goto &Data::CompactReadonly::V0::Scalar::_decode_word; } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/TiedDictionary.pm000644 000765 000024 00000001402 14166354123 026141 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::TiedDictionary; our $VERSION = '0.1.0'; use strict; use warnings; sub TIEHASH{ my($class, $object) = @_; return bless({ object => $object }, $class); } sub EXISTS { shift()->{object}->exists(shift()); } sub FETCH { shift()->{object}->element(shift()); } sub SCALAR { shift()->{object}->count(); } sub FIRSTKEY { my $tiedhash = shift(); $tiedhash->{nextkey} = 0; $tiedhash->NEXTKEY(); } sub NEXTKEY { my $tiedhash = shift(); return undef if($tiedhash->{nextkey} == $tiedhash->{object}->count()); $tiedhash->{object}->_nth_key($tiedhash->{nextkey}++); } sub STORE { die("Illegal access: store: this is a read-only database\n"); } sub DELETE { shift()->STORE() } sub CLEAR { shift()->STORE() } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Array/000755 000765 000024 00000000000 14517560621 023753 5ustar00davidstaff000000 000000 Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Dictionary.pm000644 000765 000024 00000014473 14166354123 025347 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Dictionary; our $VERSION = '0.1.0'; use warnings; use strict; use base qw(Data::CompactReadonly::V0::Collection Data::CompactReadonly::Dictionary); use Data::CompactReadonly::V0::TiedDictionary; use Scalar::Util qw(blessed); use Devel::StackTrace; sub _init { my($class, %args) = @_; my($root, $offset) = @args{qw(root offset)}; my $object = bless({ root => $root, offset => $offset, cache => ($root->_fast_collections() ? {} : undef), }, $class); if($root->_tied()) { tie my %dict, 'Data::CompactReadonly::V0::TiedDictionary', $object; return \%dict; } else { return $object; } } # write a Dictionary to the file at the current offset sub _create { my($class, %args) = @_; my $fh = $args{fh}; $class->_stash_already_seen(%args); (my $scalar_type = $class) =~ s/Dictionary/Scalar/; # node header print $fh $class->_type_byte_from_class(). $scalar_type->_get_bytes_from_word(scalar(keys %{$args{data}})); # empty pointer table my $table_start_ptr = tell($fh); print $fh "\x00" x $args{ptr_size} x 2 x scalar(keys %{$args{data}}); $class->_set_next_free_ptr(%args); my @sorted_keys = sort keys %{$args{data}}; foreach my $index (0 .. $#sorted_keys) { my $this_key = $sorted_keys[$index]; my $this_value = $args{data}->{$this_key}; # write the pointer to the key, and the key if needed. Then write the # pointer to the value, and the value if needed. The value can be any # type. Keys are coerced Text to avoid floating point problems. foreach my $item ( { data => $this_key, ptr_offset => 0, coerce_to_text => 1 }, { data => $this_value, ptr_offset => $args{ptr_size} } ) { $class->_seek(%args, pointer => $item->{ptr_offset} + $table_start_ptr + 2 * $index * $args{ptr_size}); if(my $ptr = $class->_get_already_seen(%args, data => $item->{data})) { print $fh $class->_encode_ptr(%args, pointer => $ptr); } else { print $fh $class->_encode_ptr(%args, pointer => $class->_get_next_free_ptr(%args)); $class->_seek(%args, pointer => $class->_get_next_free_ptr(%args)); my $node_class = 'Data::CompactReadonly::V0::Node'; if($item->{coerce_to_text}) { $node_class = 'Data::CompactReadonly::V0::'.$class->_text_type_for_data($item->{data}); unless($node_class->VERSION()) { eval "use $node_class"; die($@) if($@); } } $node_class->_create(%args, data => $item->{data}); } } } } # Efficient binary search. Relies on elements' being ASCIIbetically sorted by key. # 1 <= iterations to find key (or find that there is no key) <= ceil(log2(N)) # so no more than 4 iterations for a ten element list, no more than 20 for # a million element list. Each iteration takes two seeks and two reads there # are then two more seeks and reads to get the value sub element { my($self, $element) = @_; die( "$self: Invalid element: ". (!defined($element) ? '[undef]' : $element). " isn't Text or numeric\n" ) unless(defined($element) && !ref($element)); # first we need to find that key my $max_candidate = $self->count() - 1; my $min_candidate = 0; my $cur_candidate = int($max_candidate / 2); my $prev_candidate = -1; while(1) { my $key = $self->_nth_key($cur_candidate); $prev_candidate = $cur_candidate; if($key eq $element) { return $self->_nth_value($cur_candidate); } elsif($key lt $element) { # our target is futher down the list ($min_candidate, $cur_candidate, $max_candidate) = ( $cur_candidate + 1, int(($cur_candidate + $max_candidate + 1) / 2), $max_candidate ); } else { # our target is further up the list ($min_candidate, $cur_candidate, $max_candidate) = ( $min_candidate, int(($min_candidate + $cur_candidate) / 2), $cur_candidate - 1 ); } last if($prev_candidate == $cur_candidate); } die("$self: Invalid element: $element: doesn't exist\n"); } sub exists { my($self, $element) = @_; return 0 if($self->count() == 0); eval { $self->element($element) }; if($@ =~ /doesn't exist/) { return 0; } elsif($@) { die($@); } else { return 1; } } sub _nth_key { my($self, $n) = @_; if($self->{cache} && exists($self->{cache}->{keys}->{$n})) { return $self->{cache}->{keys}->{$n} } $self->_seek($self->_nth_key_ptr_location($n)); $self->_seek($self->_ptr_at_current_offset()); # for performance, cache the filehandle in this object $self->{_fh} ||= $self->_fh(); my $offset = tell($self->{_fh}); my $key = $self->_node_at_current_offset(); if(!defined($key) || ref($key)) { die("$self: Invalid type: ". (!defined($key) ? 'Null' : $key). ": Dictionary keys must be Text at ". sprintf("0x%08x", $offset). "\n". Devel::StackTrace->new()->as_string() ); } if($self->{cache}) { return $self->{cache}->{keys}->{$n} = $key; } return $key; } sub _nth_value { my($self, $n) = @_; if($self->{cache} && exists($self->{cache}->{values}->{$n})) { return $self->{cache}->{values}->{$n} } $self->_seek($self->_nth_key_ptr_location($n) + $self->_ptr_size()); $self->_seek($self->_ptr_at_current_offset()); my $val = $self->_node_at_current_offset(); if($self->{cache}) { return $self->{cache}->{values}->{$n} = $val; } return $val; } sub _nth_key_ptr_location { my($self, $n) = @_; return $self->_offset() + $self->_scalar_type_bytes() + 2 * $n * $self->_ptr_size(); } sub _ptr_at_current_offset { my $self = shift; return $self->_decode_ptr( $self->_bytes_at_current_offset($self->_ptr_size()) ); } sub indices { my $self = shift; return [] if($self->count() == 0); return [ map { $self->_nth_key($_) } (0 .. $self->count() - 1) ]; } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Text.pm000644 000765 000024 00000002010 14166354123 024146 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Text; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Collection'; use Encode qw(encode decode); sub _init { my($class, %args) = @_; my($root, $offset) = @args{qw(root offset)}; my $length = $class->_numeric_type_for_length()->_init(root => $root, offset => $offset); my $value = $class->_bytes_to_text($root->_bytes_at_current_offset($length)); return $value; } sub _create { my($class, %args) = @_; my $fh = $args{fh}; $class->_stash_already_seen(%args); (my $scalar_type = $class) =~ s/Text/Scalar/; my $text = $class->_text_to_bytes($args{data}); print $fh $class->_type_byte_from_class(). $scalar_type->_get_bytes_from_word(length($text)). $text; $class->_set_next_free_ptr(%args); } sub _bytes_to_text { my($invocant, $bytes) = @_; return decode('utf-8', $bytes); } sub _text_to_bytes { my($invocant,$text) = @_; return encode('utf-8', $text); } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar.pm000644 000765 000024 00000002577 14166354123 024451 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Node'; sub _init { my($class, %args) = @_; my $root = $args{root}; my $word = $root->_bytes_at_current_offset($class->_num_bytes()); return $class->_decode_word($word); } # turn a sequence of bytes into an integer sub _decode_word { my($class, $word) = @_; my $value = 0; foreach my $byte (split(//, $word)) { $value *= 256; $value += ord($byte); } return $value; } sub _create { my($class, %args) = @_; my $fh = $args{fh}; $class->_stash_already_seen(%args); print $fh $class->_type_byte_from_class(). $class->_get_bytes_from_word(abs($args{data})); $class->_set_next_free_ptr(%args); } sub _get_bytes_from_word { my($class, $word) = @_; return $class->_encode_word_as_number_of_bytes($word, $class->_num_bytes()); } # given an integer and a number of bytes, encode that int # as a sequence of bytes, zero-padding if necessary sub _encode_word_as_number_of_bytes { my($class, $word, $num_bytes) = @_; my $bytes = ''; while($word) { $bytes = chr($word & 0xff).$bytes; $word >>= 8; } # zero-pad if needed $bytes = (chr(0) x ($num_bytes - length($bytes))).$bytes if(length($bytes) < $num_bytes); return $bytes; } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Array.pm000644 000765 000024 00000005306 14166354123 024313 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Array; our $VERSION = '0.1.0'; use warnings; use strict; use base qw(Data::CompactReadonly::V0::Collection Data::CompactReadonly::Array); use Data::CompactReadonly::V0::TiedArray; sub _init { my($class, %args) = @_; my($root, $offset) = @args{qw(root offset)}; my $object = bless({ root => $root, offset => $offset }, $class); if($root->_tied()) { tie my @array, 'Data::CompactReadonly::V0::TiedArray', $object; return \@array; } else { return $object; } } # write an Array to the file at the current offset sub _create { my($class, %args) = @_; my $fh = $args{fh}; $class->_stash_already_seen(%args); (my $scalar_type = $class) =~ s/Array/Scalar/; # node header print $fh $class->_type_byte_from_class(). $scalar_type->_get_bytes_from_word(1 + $#{$args{data}}); # empty pointer table my $table_start_ptr = tell($fh); print $fh "\x00" x $args{ptr_size} x (1 + $#{$args{data}}); $class->_set_next_free_ptr(%args); # write a pointer to each item in turn, and if necessary also write # item, which can be of any type foreach my $index (0 .. $#{$args{data}}) { my $this_data = $args{data}->[$index]; $class->_seek(%args, pointer => $table_start_ptr + $index * $args{ptr_size}); if(my $ptr = $class->_get_already_seen(%args, data => $this_data)) { print $fh $class->_encode_ptr(%args, pointer => $ptr); } else { print $fh $class->_encode_ptr(%args, pointer => $class->_get_next_free_ptr(%args)); $class->_seek(%args, pointer => $class->_get_next_free_ptr(%args)); Data::CompactReadonly::V0::Node->_create(%args, data => $this_data); } } } sub exists { my($self, $element) = @_; eval { $self->element($element) }; if($@ =~ /out of range/) { return 0; } elsif($@) { die($@); } else { return 1; } } sub element { my($self, $element) = @_; no warnings 'numeric'; die("$self: Invalid element: $element: negative\n") if($element < 0); die("$self: Invalid element: $element: non-integer\n") if($element =~ /[^0-9]/); die("$self: Invalid element: $element: out of range\n") if($element > $self->count() - 1); $self->_seek($self->_offset() + $self->_scalar_type_bytes() + $element * $self->_ptr_size()); my $ptr = $self->_decode_ptr( $self->_bytes_at_current_offset($self->_ptr_size()) ); $self->_seek($ptr); return $self->_node_at_current_offset(); } sub indices { my $self = shift; return [] if($self->count() == 0); return [(0 .. $self->count() - 1)]; } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Format.pod000644 000765 000024 00000012055 14166354123 024632 0ustar00davidstaff000000 000000 =encoding UTF-8 =head1 NAME Data::CompactReadonly::V0::Format - a description of CompactReadonly data format, version 0. =head1 NOTATION Bytes with values that are printable ASCII will be shown as a single ASCII character. Otherwise bytes will be shown either in hexadecimal - C<0xAB> - or binary - C<0b01010101>. When appropriate bit-fields will be shown in binary C<0b100>. Bytes will be separated by spaces, bit-fields within a byte by hyphens - C<0b11-0000-00>. =head1 ENDIANNESS All internal structures are big-endian. =head1 FILE HEADER The file header is five bytes long. The first four serve to identify the file type: C R O D The fifth is a bit-field that encodes in the most significant five bits the file format version number, and in the least significant three bits encodes the pointer length that is used in the file. Values from 0 to 7 correspond to pointer lengths from 1 to 8 bytes. The five byte header is immediately followed by the root node. Version number 31 (0b11111-XXX) is reserved for future use. =head1 NODES Data is encoded in B, which can be of several types. The types fall into two categories: =over =item Scalar types Scalars encode a simple value. That can be a number or the NULL value. The five integer numeric types are also available as NegativeByte, NegativeMedium and so on. =over =item Byte - 8 bit integer =item Short - 16 bit integer =item Medium - 24 bit integer =item Long - 32 bit integer =item Huge - 64 bit integer =item Float64 - 64 bit IEEE754 double-precision =item Null =item True =item False =back =item Collection types Collections encode multiple values. =over =item Text Encodes a list of characters - that is, a string. =item Array Encodes a list of nodes, which can themselves be of any type. =item Dictionary Encodes a list of key-value pairs, the keys being strings or numbers and the values being nodes of any type. The keys B be stored in ASCIIbetical order. Note that while the use of numeric types is *permitted* for keys it is not recommended, as you may run into problems finding floating point keys because of the usual floating point imprecision issues. =back =back Each node is encoded as a I occupying from 1 to 9 bytes, followed by data if necessary =head2 NODE TYPE HEADERS The type header consists of a I followed by up to 8 bytes telling us how much data is in the node. The type specifier is a bit field. The first two bits will tell us whether the node is a collection or not. 0b00 - Text node 0b01 - Array node 0b10 - Dictionary node 0b11 - it's not a collection, it's a scalar node The next four bits tell us, for scalar nodes, the type, or for collection nodes some of them tell us what type is used to encode the collection's length. Only Byte, Short, Medium, and Long are valid for lengths. 0b0000 - Byte (valid as a length) 0b0001 - NegativeByte 0b0010 - Short (valid as a length) 0b0011 - NegativeShort 0b0100 - Medium (valid as a length) 0b0101 - NegativeMedium 0b0110 - Long (valid as a length) 0b0111 - NegativeLong 0b1000 - Huge 0b1001 - NegativeHuge 0b1010 - Null 0b1011 - Float64 0b1100 - True 0b1101 - False Any unspecified bits or combinations of bits are reserved for future use. Unspecified bits should be set to zero if you want your data to be compatible with future versions. =head2 NODE DATA =head3 NUMERIC NODES The header is followed by the appropriate number of bytes of data. =head3 NULL, TRUE and FALSE NODES These are just a header. =head3 TEXT NODES The header is followed by the appropriate number of bytes to encode the text's length, followed by that many bytes of text. Note that text lengths are stored in B but text is actually encoded in UTF-8. So the 3 character string "北京市" is stored as the 9 bytes: 北: 0xE5 0x8C 0x97 京: 0xE4 0xBA 0xAC 市: 0xE5 0xB8 0x82 and the entire node would be the 11 bytes: 0b00-0000-00: this is a Text node, with the length stored in a Byte 0x09: the length of the text 0xE5 ... 0x82: nine bytes of text =head3 ARRAY NODES The header is followed by the appropriate number of bytes to encode the number of elements in the array, C. Zero obviously means an empty array. That is immediately followed by C pointers of the size specified in the database header. Each pointer is the location in the file of another node, which can be of any type. =head3 DICTIIONARY NODES The hader is followed by the appropriate number of bytes to encode the number of elements in thedictionary, C. Zero means an empty dictionary. That is immediately followed by C pairs of pointers of the size specifed in the database header. The first pointer in each pair must point to a Text or numeric node which will be used as a key for looking up values. The second pointer in each pair points to the value, which can be any type of node. The pointers to keys must list them in ASCIIbetical order. If they are out of order some elements may not be able to be found. Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Node.pm000644 000765 000024 00000023617 14166354123 024127 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Node; our $VERSION = '0.1.0'; use warnings; use strict; use Fcntl qw(:seek); use Scalar::Type qw(is_* bool_supported); use Devel::StackTrace; use Data::CompactReadonly::V0::Text; use Data::Dumper; # return the root node. assumes the $fh is pointing at the start of the node header sub _init { my($class, %args) = @_; my $self = bless(\%args, $class); $self->{root} = $self; return $self->_node_at_current_offset(); } # write the root node to the file and, recursively, its children sub _create { my($class, %args) = @_; die("fell through to Data::CompactReadonly::V0::Node::_create when creating a $class\n") if($class ne __PACKAGE__); $class->_type_class( from_data => $args{data} )->_create(%args); } # stash (in memory) of everything that we've seen while writing the database, # with a pointer to their location in the file so that it can be re-used. We # even stash stringified Dicts/Arrays, which can eat a TON of memory. Yes, we # seem to need to local()ise the config vars in each sub. sub _stash_already_seen { my($class, %args) = @_; local $Data::Dumper::Indent = 0; local $Data::Dumper::Sortkeys = 1; if(bool_supported && is_bool($args{data})) { $args{globals}->{already_seen}->{ $args{data} ? 'bt' : 'bf' } = tell($args{fh}); } elsif(defined($args{data})) { $args{globals}->{already_seen}->{d}->{ ref($args{data}) ? Dumper($args{data}) : $args{data} } = tell($args{fh}); } else { $args{globals}->{already_seen}->{u} = tell($args{fh}); } } # look in the stash for data that we've seen before and get a pointer to it sub _get_already_seen { my($class, %args) = @_; local $Data::Dumper::Indent = 0; local $Data::Dumper::Sortkeys = 1; if(bool_supported && is_bool($args{data})) { return $args{data} ? $args{globals}->{already_seen}->{bt} : $args{globals}->{already_seen}->{bf} } elsif(defined($args{data})) { return $args{globals}->{already_seen}->{d}->{ ref($args{data}) ? Dumper($args{data}) : $args{data} } } else { return $args{globals}->{already_seen}->{u}; } } sub _get_next_free_ptr { my($class, %args) = @_; return $args{globals}->{next_free_ptr}; } sub _set_next_free_ptr { my($class, %args) = @_; $args{globals}->{next_free_ptr} = tell($args{fh}); } # in case the database isn't at the beginning of a file, eg in __DATA__ sub _db_base { my $self = shift; return $self->_root()->{db_base}; } sub _fast_collections { my $self = shift; return $self->_root()->{'fast_collections'}; } sub _tied { my $self = shift; return $self->_root()->{'tie'}; } # figure out what type the node is from the node specifier byte, then call # the class's _init to get it to read itself from the db sub _node_at_current_offset { my $self = shift; # for performance, cache the filehandle in this object $self->{_fh} ||= $self->_fh(); my $type_class = $self->_type_class(from_byte => $self->_bytes_at_current_offset(1)); return $type_class->_init(root => $self->_root(), offset => tell($self->{_fh}) - $self->_db_base()); } # what's the minimum number of bytes required to store this int? sub _bytes_required_for_int { no warnings 'portable'; # perl worries about 32 bit machines. I don't. my($class, $int) = @_; return $int <= 0xff ? 1 : # Byte $int <= 0xffff ? 2 : # Short $int <= 0xffffff ? 3 : # Medium $int <= 0xffffffff ? 4 : # Long $int <= 0xffffffffffffffff ? 8 : # Huge 9; # 9 or greater signals too big for 64 bits } # given the number of elements in a Collection, figure out what the appropriate # class is to represent it. NB that only Byte/Short/Medium/Long are allowed, we # don't allow Huge numbers of elements in a Collection sub _sub_type_for_collection_of_length { my($class, $length) = @_; my $bytes = $class->_bytes_required_for_int($length); return $bytes == 1 ? 'Byte' : $bytes == 2 ? 'Short' : $bytes == 3 ? 'Medium' : $bytes == 4 ? 'Long' : undef; } # given a blob of text, figure out its type sub _text_type_for_data { my($class, $data) = @_; return 'Text::'.do { $class->_sub_type_for_collection_of_length( length(Data::CompactReadonly::V0::Text->_text_to_bytes($data)) ) || die("$class: Invalid: Text too long"); }; } # work out what node type is required to represent a piece of data sub _type_map_from_data { my($class, $data) = @_; return !defined($data) ? 'Scalar::Null' : (bool_supported && is_bool($data)) ? 'Scalar::'.($data ? 'True' : 'False') : ref($data) eq 'ARRAY' ? 'Array::'.do { $class->_sub_type_for_collection_of_length(1 + $#{$data}) || die("$class: Invalid: Array too long"); } : ref($data) eq 'HASH' ? 'Dictionary::'.do { $class->_sub_type_for_collection_of_length(scalar(keys %{$data})) || die("$class: Invalid: Dictionary too long"); } : is_integer($data) ? do { my $neg = $data < 0 ? 'Negative' : ''; my $bytes = $class->_bytes_required_for_int(abs($data)); $bytes == 1 ? "Scalar::${neg}Byte" : $bytes == 2 ? "Scalar::${neg}Short" : $bytes == 3 ? "Scalar::${neg}Medium" : $bytes == 4 ? "Scalar::${neg}Long" : $bytes < 9 ? "Scalar::${neg}Huge" : "Scalar::Float64" } : is_number($data) ? 'Scalar::Float64' : !ref($data) ? $class->_text_type_for_data($data) : die("Can't yet create from '$data'\n"); } my $type_by_bits = { 0b00 => 'Text', 0b01 => 'Array', 0b10 => 'Dictionary', 0b11 => 'Scalar' }; my $subtype_by_bits = { 0b0000 => 'Byte', 0b0001 => 'NegativeByte', 0b0010 => 'Short', 0b0011 => 'NegativeShort', 0b0100 => 'Medium', 0b0101 => 'NegativeMedium', 0b0110 => 'Long', 0b0111 => 'NegativeLong', 0b1000 => 'Huge', 0b1001 => 'NegativeHuge', 0b1010 => 'Null', 0b1011 => 'Float64', 0b1100 => 'True', 0b1101 => 'False', (map { $_ => 'Reserved' } (0b1110 .. 0b1111)) }; my $bits_by_type = { reverse %{$type_by_bits} }; my $bits_by_subtype = { reverse %{$subtype_by_bits} }; # used by classes when serialising themselves to figure out what their # type specifier byte should be sub _type_byte_from_class { my $class = shift; $class =~ /.*::([^:]+)::([^:]+)/; my($type, $subtype) = ($1, $2); return chr( ($bits_by_type->{$type} << 6) + ($bits_by_subtype->{$subtype} << 2) ); } # work out what node type is represented by a given node specifier byte sub _type_map_from_byte { my $class = shift; my $in_type = ord(shift()); my $type = $type_by_bits->{$in_type >> 6}; my $scalar_type = $subtype_by_bits->{($in_type & 0b111100) >> 2}; die(sprintf("$class: Invalid type: 0b%08b: Reserved\n", $in_type)) if($scalar_type eq 'Reserved'); die(sprintf("$class: Invalid type: 0b%08b: length $scalar_type\n", $in_type)) if($type ne 'Scalar' && $scalar_type =~ /^(Null|Float64|Negative|Huge|True|False)/); return join('::', $type, $scalar_type); } # get a class name (having loaded the relevant class) either from_data # (when writing a file) or from_byte (when reading a file) sub _type_class { my($class, $from, $in_type) = @_; my $map_method = "_type_map_$from"; my $type_name = "Data::CompactReadonly::V0::".$class->$map_method($in_type); unless($type_name->VERSION()) { eval "use $type_name"; die($@) if($@); } return $type_name; } # read N bytes from the current offset sub _bytes_at_current_offset { my($self, $bytes) = @_; # for performance, cache the filehandle in this object $self->{_fh} ||= $self->_fh(); my $tell = tell($self->{_fh}); my $chars_read = read($self->{_fh}, my $data, $bytes); if(!defined($chars_read)) { die( "$self: read() failed to read $bytes bytes at offset $tell: $!\n". Devel::StackTrace->new()->as_string() ); } elsif($chars_read != $bytes) { die( "$self: read() tried to read $bytes bytes at offset $tell, got $chars_read: $!\n". Devel::StackTrace->new()->as_string() ); } return $data; } # this is a monstrous evil - TODO instantiate classes when writing! # seek to a particular point in the *database* (not in the file). If the # pointer has gone too far for the current pointer size, die. This will be # caught in Data::CompactReadonly::V0->create(), the pointer size incremented, and it will # try again from the start sub _seek { my $self = shift; if($#_ == 0) { # for when reading my $to = shift; # for performance, cache the filehandle in this object $self->{_fh} ||= $self->_fh(); seek($self->{_fh}, $self->_db_base() + $to, SEEK_SET); } else { # for when writing my %args = @_; die($self->_ptr_blown()) if($args{pointer} >= 256 ** $args{ptr_size}); seek($args{fh}, $args{pointer}, SEEK_SET); } } sub _ptr_blown { "pointer out of range" } # the offset of the current node sub _offset { my $self = shift; return $self->{offset}; } sub _root { my $self = shift; return $self->{root}; } # the filehandle, currently only used when reading, see the TODO above # for _seek sub _fh { my $self = shift; return $self->_root()->{fh}; } sub _ptr_size { my $self = shift; return $self->_root()->{ptr_size}; } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/NegativeScalar.pm000644 000765 000024 00000000360 14166354123 026120 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::NegativeScalar; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Scalar'; sub _init { my($class, %args) = @_; return -1 * $class->SUPER::_init(%args); } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Dictionary/000755 000765 000024 00000000000 14517560621 025002 5ustar00davidstaff000000 000000 Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Text/000755 000765 000024 00000000000 14517560621 023621 5ustar00davidstaff000000 000000 Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Text/Short.pm000644 000765 000024 00000000441 14166354123 025253 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Text::Short; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Text'; use Data::CompactReadonly::V0::Scalar::Short; # this class only exists so it can encode the length's # type in its name, and load that type 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Text/Medium.pm000644 000765 000024 00000000443 14166354123 025376 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Text::Medium; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Text'; use Data::CompactReadonly::V0::Scalar::Medium; # this class only exists so it can encode the length's # type in its name, and load that type 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Text/Long.pm000644 000765 000024 00000000437 14166354123 025060 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Text::Long; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Text'; use Data::CompactReadonly::V0::Scalar::Long; # this class only exists so it can encode the length's # type in its name, and load that type 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Text/Byte.pm000644 000765 000024 00000000437 14166354123 025064 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Text::Byte; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Text'; use Data::CompactReadonly::V0::Scalar::Byte; # this class only exists so it can encode the length's # type in its name, and load that type 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Dictionary/Short.pm000644 000765 000024 00000000455 14166354123 026441 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Dictionary::Short; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Dictionary'; use Data::CompactReadonly::V0::Scalar::Short; # this class only exists so it can encode the length's # type in its name, and load that type 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Dictionary/Medium.pm000644 000765 000024 00000000457 14166354123 026564 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Dictionary::Medium; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Dictionary'; use Data::CompactReadonly::V0::Scalar::Medium; # this class only exists so it can encode the length's # type in its name, and load that type 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Dictionary/Long.pm000644 000765 000024 00000000453 14166354123 026237 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Dictionary::Long; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Dictionary'; use Data::CompactReadonly::V0::Scalar::Long; # this class only exists so it can encode the length's # type in its name, and load that type 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Dictionary/Byte.pm000644 000765 000024 00000000453 14166354123 026243 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Dictionary::Byte; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Dictionary'; use Data::CompactReadonly::V0::Scalar::Byte; # this class only exists so it can encode the length's # type in its name, and load that type 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Array/Short.pm000644 000765 000024 00000000443 14166354123 025407 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Array::Short; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Array'; use Data::CompactReadonly::V0::Scalar::Short; # this class only exists so it can encode the length's # type in its name, and load that type 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Array/Medium.pm000644 000765 000024 00000000445 14166354123 025532 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Array::Medium; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Array'; use Data::CompactReadonly::V0::Scalar::Medium; # this class only exists so it can encode the length's # type in its name, and load that type 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Array/Long.pm000644 000765 000024 00000000441 14166354123 025205 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Array::Long; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Array'; use Data::CompactReadonly::V0::Scalar::Long; # this class only exists so it can encode the length's # type in its name, and load that type 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Array/Byte.pm000644 000765 000024 00000000441 14166354123 025211 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Array::Byte; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Array'; use Data::CompactReadonly::V0::Scalar::Byte; # this class only exists so it can encode the length's # type in its name, and load that type 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/Huge.pm000644 000765 000024 00000000254 14166354123 025327 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::Huge; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Scalar'; sub _num_bytes { 8 } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/Float64.pm000644 000765 000024 00000001426 14166354123 025660 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::Float64; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Scalar::Huge'; # FIXME this uses pack()'s d format underneath, which exposes the # native machine floating point format. This is not guaranteed to # actually be IEEE754. Yuck. Need to find a comprehensible spec and # a comprehensive text suite and implement my own. use Data::IEEE754 qw(unpack_double_be pack_double_be); sub _create { my($class, %args) = @_; my $fh = $args{fh}; $class->_stash_already_seen(%args); print $fh $class->_type_byte_from_class(). pack_double_be($args{data}); $class->_set_next_free_ptr(%args); } sub _decode_word { my($class, $word) = @_; return unpack_double_be($word); } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/True.pm000644 000765 000024 00000000300 14166354123 025346 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::True; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Scalar::HeaderOnly'; sub _init { return 1 == 1; } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/Null.pm000644 000765 000024 00000000277 14166354123 025356 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::Null; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Scalar::HeaderOnly'; sub _init { return undef; } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/NegativeByte.pm000644 000765 000024 00000000332 14166354123 027022 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::NegativeByte; our $VERSION = '0.1.0'; use warnings; use strict; use base qw( Data::CompactReadonly::V0::NegativeScalar Data::CompactReadonly::V0::Scalar::Byte ); 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/NegativeLong.pm000644 000765 000024 00000000332 14166354123 027016 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::NegativeLong; our $VERSION = '0.1.0'; use warnings; use strict; use base qw( Data::CompactReadonly::V0::NegativeScalar Data::CompactReadonly::V0::Scalar::Long ); 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/Short.pm000644 000765 000024 00000000255 14166354123 025537 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::Short; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Scalar'; sub _num_bytes { 2 } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/NegativeHuge.pm000644 000765 000024 00000000332 14166354123 027007 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::NegativeHuge; our $VERSION = '0.1.0'; use warnings; use strict; use base qw( Data::CompactReadonly::V0::NegativeScalar Data::CompactReadonly::V0::Scalar::Huge ); 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/Medium.pm000644 000765 000024 00000000256 14166354123 025661 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::Medium; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Scalar'; sub _num_bytes { 3 } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/Long.pm000644 000765 000024 00000000254 14166354123 025336 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::Long; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Scalar'; sub _num_bytes { 4 } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/NegativeMedium.pm000644 000765 000024 00000000336 14166354123 027343 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::NegativeMedium; our $VERSION = '0.1.0'; use warnings; use strict; use base qw( Data::CompactReadonly::V0::NegativeScalar Data::CompactReadonly::V0::Scalar::Medium ); 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/Byte.pm000644 000765 000024 00000000254 14166354123 025342 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::Byte; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Scalar'; sub _num_bytes { 1 } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/False.pm000644 000765 000024 00000000301 14166354123 025462 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::False; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Scalar::HeaderOnly'; sub _init { return 1 == 0; } 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/NegativeShort.pm000644 000765 000024 00000000334 14166354123 027220 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::NegativeShort; our $VERSION = '0.1.0'; use warnings; use strict; use base qw( Data::CompactReadonly::V0::NegativeScalar Data::CompactReadonly::V0::Scalar::Short ); 1; Data-CompactReadonly-0.1.1/lib/Data/CompactReadonly/V0/Scalar/HeaderOnly.pm000644 000765 000024 00000000537 14166354123 026475 0ustar00davidstaff000000 000000 package Data::CompactReadonly::V0::Scalar::HeaderOnly; our $VERSION = '0.1.0'; use warnings; use strict; use base 'Data::CompactReadonly::V0::Scalar'; sub _create { my($class, %args) = @_; my $fh = $args{fh}; $class->_stash_already_seen(%args); print $fh $class->_type_byte_from_class(); $class->_set_next_free_ptr(%args); } 1; Data-CompactReadonly-0.1.1/t/pod.t000644 000765 000024 00000000254 13761512610 017113 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; eval "use Test::Pod 1.18"; plan skip_all => "Test::Pod 1.18 required for testing POD" if $@; all_pod_files_ok(); done_testing(); Data-CompactReadonly-0.1.1/t/root-node-dictionary.t000644 000765 000024 00000027740 14033654112 022410 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; use Test::Differences; use Test::Exception; use File::Temp qw(tempfile); use String::Binary::Interpolation; use Data::CompactReadonly; my $header_bytes = "CROD\x00"; # version 0, byte pointers my $DICTBYTE = $b10000000; my $TEXTBYTE = $b00000000; my $NULL = $b11101000; my $SHORT = $b11001000; subtest "empty dict", sub { open(my $fh, '<', \"$header_bytes$DICTBYTE\x00"); isa_ok( my $dict = Data::CompactReadonly->read($fh), "Data::CompactReadonly::V0::Dictionary::Byte" ); is($dict->count(), 0, "0 element dict"); is($dict->_ptr_size(), 1, "1 byte pointers"); eq_or_diff($dict->indices(), [], "can list collection indices"); }; subtest "1 element dict", sub { open(my $fh, '<', \( "\x00\x00". # these don't count, we'll seek past them before we start "$header_bytes". # 0x00 "$DICTBYTE\x01". # 0x05 "\x09". "\x0e". # 0x07 and 0x08 "$TEXTBYTE\x03cow". # 0x09 "$TEXTBYTE\x04calf" # 0x0e )); read($fh, my $blah, 2); my $dict = Data::CompactReadonly->read($fh); is($dict->_db_base(), 2, "the fh was opened after having already been partially read"); is($dict->count(), 1, "1 element dict"); eq_or_diff($dict->indices(), ['cow'], "can list collection indices"); is($dict->element('cow'), 'calf', "can fetch from a 1 element dict"); }; subtest "dict with Null key", sub { open(my $fh, '<', \( "$header_bytes". # 0x00 "$DICTBYTE\x01". # 0x05 "\x09". "\x0a". # 0x07 and 0x08 "$NULL". # 0x09 "$TEXTBYTE\x04calf" # 0x0a )); my $dict = Data::CompactReadonly->read($fh); is($dict->count(), 1, "1 element dict"); throws_ok { $dict->indices() } qr/Invalid type: Null: Dictionary keys must be Text/, "finding a bad key in the index is fatal"; throws_ok { $dict->element(undef) } qr/Invalid element: \[undef\] isn't Text/, "asking for a Null key is fatal"; throws_ok { $dict->element(\"cow") } qr/Invalid element: SCALAR.* isn't Text/, "asking for a Reference key is fatal"; }; subtest "dict with Collection key", sub { open(my $fh, '<', \( "$header_bytes". # 0x00 "$DICTBYTE\x01". # 0x05 "\x09". "\x0b". # 0x07 and 0x08 "$DICTBYTE\x00". # 0x09 "$TEXTBYTE\x04calf" # 0x0b )); my $dict = Data::CompactReadonly->read($fh); throws_ok { $dict->indices() } qr/Invalid type: .*Dictionary::Byte.*: Dictionary keys must be Text/, "finding a bad key in the index is fatal"; }; subtest "missing data", sub { open(my $fh, '<', \( "$header_bytes". # 0x00 "$DICTBYTE\x01". # 0x05 "\x09". "\x0b" # 0x07 and 0x08 )); my $dict = Data::CompactReadonly->read($fh); throws_ok { $dict->indices() } qr/read.. tried to read/, "fatal read errors bomb out fast"; }; subtest "2 element dict", sub { open(my $fh, '<', \( "$header_bytes". # 0x00 "$DICTBYTE\x02". # 0x05 "\x0b". "\x10". # 0x07 and 0x08 "\x16". "\x05". # 0x09 and 0x0a "$TEXTBYTE\x03cow". # 0x0b "$TEXTBYTE\x04calf". # 0x10 "$TEXTBYTE\x04dict" # 0x16 )); my $dict = Data::CompactReadonly->read($fh); is($dict->count(), 2, "2 element dict"); eq_or_diff($dict->indices(), ['cow', 'dict'], "can list collection indices"); is($dict->element('cow'), 'calf', "can fetch element 0 from a 2 element dict"); isa_ok($dict->element('dict'), 'Data::CompactReadonly::V0::Dictionary', "can fetch a Dictionary from element 1 of the Dictionary"); isa_ok($dict->element('dict')->element('dict')->element('dict'), 'Data::CompactReadonly::V0::Dictionary', "it's Dictionaries all the way down"); is($dict->id(), $dict->element('dict')->element('dict')->id(), "circular references to dicts all have the same id"); }; subtest "large odd number of elements in a dict", sub { open(my $fh, '<', \( "$header_bytes". # 0x00 "$DICTBYTE\x0b". # 0x05 "\x1d". "\x26". # 0x07 and 0x08 "\x31". "\x34". # 0x09 and 0x0a "\x37". "\x3a". # 0x0b and 0x0c "\x3d". "\x40". # 0x0d and 0x0e "\x43". "\x46". # 0x0f and 0x10 "\x49". "\x4c". # 0x11 and 0x12 "\x4f". "\x52". # 0x13 and 0x14 "\x55". "\x58". # 0x15 and 0x16 "\x5b". "\x5e". # 0x17 and 0x18 "\x61". "\x64". # 0x19 and 0x1a "\x26". "\x1d". # 0x1b and 0x1c "$TEXTBYTE\x07Beijing". # 0x1d "$TEXTBYTE\x09\xe5\x8c\x97\xe4\xba\xac\xe5\xb8\x82". # 0x26 "$TEXTBYTE\x01a". # 0x31 "$TEXTBYTE\x01A". # 0x34 "$TEXTBYTE\x01b". # 0x37 "$TEXTBYTE\x01B". # 0x3a "$TEXTBYTE\x01c". # 0x3d "$TEXTBYTE\x01C". # 0x40 "$TEXTBYTE\x01d". # 0x43 "$TEXTBYTE\x01D". # 0x46 "$TEXTBYTE\x01e". # 0x49 "$TEXTBYTE\x01E". # 0x4c "$TEXTBYTE\x01f". # 0x49 "$TEXTBYTE\x01F". # 0x52 "$TEXTBYTE\x01g". # 0x55 "$TEXTBYTE\x01G". # 0x58 "$TEXTBYTE\x01h". # 0x5b "$SHORT\x01\x02". # 0x5e "$TEXTBYTE\x01i". # 0x61 "$NULL" # 0x64 )); my $dict = Data::CompactReadonly->read($fh); is($dict->count(), 11, "11 element dict"); eq_or_diff(my $indices = $dict->indices(), [ qw(Beijing a b c d e f g h i), "\x{5317}\x{4eac}\x{5e02}" ], "can list collection indices"); foreach my $index (0 .. $#{$indices}) { my $wanted = { Beijing => "\x{5317}\x{4eac}\x{5e02}", "\x{5317}\x{4eac}\x{5e02}" => 'Beijing', h => 0x0102, i => undef, map { $_ => uc($_) } ('a' .. 'g') }->{$indices->[$index]}; is($dict->element($indices->[$index]), $wanted, "can fetch element $index from dictionary"); } throws_ok { $dict->element('horse') } qr/Invalid element: horse: doesn't exist/, "cry like a baby when trying to fetch non-existent elements"; is($dict->exists('horse'), 0, "exists() works on a non-existent index"); is($dict->exists('Beijing'), 1, "exists() works on an existent index"); throws_ok { $dict->exists(undef) } qr/Invalid element: \[undef\] isn't Text/, "exists() dies when asked for something hopelessly invalid" }; foreach my $use_cache (0, 1) { subtest ''.($use_cache ? 'using' : 'not using').' fast collections cache' => sub { subtest "large even number of elements dict", sub { open(my $fh, '<', \( "$header_bytes". # 0x00 "$DICTBYTE\x06". # 0x05 "\x13". "\x16". # 0x07 and 0x08 "\x19". "\x1c". # 0x09 and 0x0a "\x1f". "\x22". # 0x0b and 0x0c "\x25". "\x28". # 0x0d and 0x0e "\x2b". "\x2e". # 0x0f and 0x10 "\x31". "\x34". # 0x11 and 0x12 "$TEXTBYTE\x01a". # 0x13 "$TEXTBYTE\x01A". # 0x16 "$TEXTBYTE\x01b". # 0x19 "$TEXTBYTE\x01B". # 0x1c "$TEXTBYTE\x01c". # 0x1f "$TEXTBYTE\x01C". # 0x22 "$TEXTBYTE\x01d". # 0x25 "$TEXTBYTE\x01D". # 0x28 "$TEXTBYTE\x01e". # 0x2b "$TEXTBYTE\x01E". # 0x2e "$TEXTBYTE\x01f". # 0x31 "$TEXTBYTE\x01F" # 0x34 )); my $dict = Data::CompactReadonly->read($fh, fast_collections => $use_cache); if($use_cache) { eq_or_diff( $dict->{cache}, {}, "start with empty cache" ); } is($dict->count(), 6, "6 element dict"); if($use_cache) { eq_or_diff( $dict->{cache}, { count => 6 }, "count cached" ); } is($dict->element('a'), 'A', 'can fetch element 0 from dictionary'); if($use_cache) { eq_or_diff( $dict->{cache}, { count => 6, keys => { 0 => 'a', 1 => 'b', 2 => 'c' }, values => { 0 => 'A' }, }, "cache partially populated" ); } is($dict->element('b'), 'B', 'can fetch element 1 from dictionary'); is($dict->element('c'), 'C', 'can fetch element 2 from dictionary'); is($dict->element('d'), 'D', 'can fetch element 3 from dictionary'); is($dict->element('e'), 'E', 'can fetch element 4 from dictionary'); is($dict->element('f'), 'F', 'can fetch element 5 from dictionary'); if($use_cache) { eq_or_diff( $dict->{cache}, { count => 6, keys => { 0 => 'a', 1 => 'b', 2 => 'c', 3 => 'd', 4 => 'e', 5 => 'f' }, values => { 0 => 'A', 1 => 'B', 2 => 'C', 3 => 'D', 4 => 'E', 5 => 'F' }, }, "cache fully populated" ); close($fh); is($dict->element('f'), 'F', 'and yep, we definitely use the cache'); } }; }; } done_testing; Data-CompactReadonly-0.1.1/t/bug-Number-Phone-1546702248.t000644 000765 000024 00000001542 13766762077 022513 0ustar00davidstaff000000 000000 use strict; use warnings; # Tests for bugs found in https://github.com/DrHyde/perl-modules-Number-Phone/runs/1546702248 use Test::More; use File::Temp qw(tempfile); use Data::CompactReadonly; (undef, my $filename) = tempfile(); # UNLINK => 1); my $data = { a => { anteater => 1, batplague => 1, cat => 1, doge => 1 }, a2 => {}, bee => { wasp => 1, hornet => 1, honeybadger => 1 } }; Data::CompactReadonly->create($filename, $data); my $db = Data::CompactReadonly->read($filename, tie => 1); is_deeply($db, $data, "hash structures match"); $data = [ [ qw(fish cakes are delicious ), [ qw( no really )] ], [ qw(and numbers are fun 1 2 3 4 5) ], ]; Data::CompactReadonly->create($filename, $data); $db = Data::CompactReadonly->read($filename, tie => 1); is_deeply($db, $data, "array structures match"); done_testing(); Data-CompactReadonly-0.1.1/t/create-collection.t000644 000765 000024 00000031576 14517557311 021747 0ustar00davidstaff000000 000000 use strict; use warnings; no warnings qw(portable); use File::Temp qw(tempfile); use Scalar::Type qw(bool_supported); Scalar::Type->import('is_bool') if(bool_supported()); use Test::More; use Test::Exception; use lib 't/lib'; use TestFloat; use Data::CompactReadonly; (undef, my $filename) = tempfile(UNLINK => 1); Data::CompactReadonly->create($filename, []); isa_ok(my $data = Data::CompactReadonly->read($filename), 'Data::CompactReadonly::V0::Array::Byte', "can create an Array::Byte"); isa_ok($data, 'Data::CompactReadonly::Array', "and that isa Data::CompactReadonly::Array"); is($data->count(), 0, "it's empty"); is((stat($filename))[7], 7, "file size is correct"); my $true = 1 == 1; my $false = 1 == 0; my $array = [ # header 5 bytes # OMGANARRAY 1 byte # number of elements (in Byte) 1 byte # 14 pointers 14 bytes 0x10000, # Scalar::Medium, 4 bytes undef, # Scalar::Null, 1 byte "apple", # Text::Byte, 7 bytes 0x1, # Scalar::Byte, 2 bytes 0x100, # Scalar::Short, 3 bytes 3.4, # Scalar::Float64, 9 bytes 0x12345678, # Scalar::Long, 5 bytes 0x100000000, # Scalar::Huge, 9 bytes 0x100000000, # Scalar::Huge, no storage, same as one already in db "apple", # Text::Byte, no storage $true, # Scalar::True, 1 byte $true, # Scalar::True, no storage $false, # Scalar::False, 1 byte 'x' x 256 # Text::Short, 259 bytes ]; Data::CompactReadonly->create($filename, $array); isa_ok($data = Data::CompactReadonly->read($filename), 'Data::CompactReadonly::V0::Array::Byte', "got another Array::Byte"); # yes, 1 byte despite the file being more than 255 bytes long. The # last thing pointed to starts before the boundary. is($data->_ptr_size(), 1, "pointers are 1 byte"); is($data->count(), 14, "got a non-empty array"); is($data->element(0), 0x10000, "read a Medium from the array"); is($data->element(1), undef, "read a Null"); is($data->element(2), 'apple', "read a Text::Byte"); is($data->element(3), 1, "read a Byte"); is($data->element(4), 256, "read a Short"); cmp_float($data->element(5), 3.4, "read a Float64"); is($data->element(6), 0x12345678, "read a Long"); is($data->element(7), 0x100000000, "read a Huge"); is($data->element(8), 0x100000000, "read another Huge"); is($data->element(9), 'apple', "read another Text"); ok($data->element(10), "read a True"); if(bool_supported) { ok(is_bool($data->element(10)), "and on super-modern perl the Boolean flag is set correctly"); } ok($data->element(11), "read another True"); if(bool_supported) { ok(is_bool($data->element(11)), "and on super-modern perl the Boolean flag is set correctly"); } ok(!$data->element(12), "read a False"); if(bool_supported) { ok(is_bool($data->element(12)), "and on super-modern perl the Boolean flag is set correctly"); } is($data->element(13), 'x' x 256, "read another Text"); is((stat($filename))[7], 322, "file size is correct"); push @{$array}, [], $array; Data::CompactReadonly->create($filename, $array); isa_ok($data = Data::CompactReadonly->read($filename), 'Data::CompactReadonly::V0::Array::Byte', "got another Array::Byte"); # last item pointed at is too far along for 1 byte pointers. # TODO alter the order in which things are added to the file so # that this array can have items after the long text, but they're # stored before it, so we can keep using short pointers for longer is($data->_ptr_size(), 2, "pointers are 2 bytes"); is($data->count(), 16, "got a non-empty array"); is($data->element(0), 0x10000, "read a Medium from the array"); is($data->element(1), undef, "read a Null"); is($data->element(2), 'apple', "read a Text::Byte"); is($data->element(3), 1, "read a Byte"); is($data->element(4), 256, "read a Short"); cmp_float($data->element(5), 3.4, "read a Float64"); is($data->element(6), 0x12345678, "read a Long"); is($data->element(7), 0x100000000, "read a Huge"); is($data->element(8), 0x100000000, "read another Huge"); is($data->element(9), 'apple', "read another Text"); ok($data->element(10), "read a True"); if(bool_supported) { ok(is_bool($data->element(10)), "and on super-modern perl the Boolean flag is set correctly"); } ok($data->element(11), "read another True"); if(bool_supported) { ok(is_bool($data->element(11)), "and on super-modern perl the Boolean flag is set correctly"); } ok(!$data->element(12), "read a False"); if(bool_supported) { ok(is_bool($data->element(12)), "and on super-modern perl the Boolean flag is set correctly"); } is($data->element(13), 'x' x 256, "read a Text::Short"); isa_ok(my $embedded_array = $data->element(14), 'Data::CompactReadonly::V0::Array::Byte', "can embed an array in an array"); is($embedded_array->count(), 0, "sub-array is empty"); is($data->element(15)->element(15)->element(14)->id(), $embedded_array->id(), "circular array-refs work"); # this is: # original size + # two extra pointers + # sixteen for the pointers now being Shorts # two for the empty array is((stat($filename))[7], 322 + 2 + 16 + 2, "file size is correct"); Data::CompactReadonly->create($filename, {}); isa_ok($data = Data::CompactReadonly->read($filename), 'Data::CompactReadonly::V0::Dictionary::Byte', "got a Dictionary::Byte"); is($data->count(), 0, "it's empty"); is($data->_ptr_size(), 1, "pointers are 1 byte"); my $hash = { # header 5 bytes # OMGADICT 1 byte # number of elements (in Byte) 1 byte # 20 pairs of pointers # 40 bytes true => $true, # 6 bytes for key, 1 for value false => $false, # 7 bytes for key, 1 for value $false => $false, # 2 bytes for stringified key, value is FREE!!! float => 3.14, # 7 bytes for key, 9 bytes for value byte => 65, # 6 bytes for key, 2 bytes for value short => 65534, # 7 bytes for key, 3 bytes for value medium => 65536, # 8 bytes for key, 4 bytes for value long => 0x1000000, # 6 bytes for key, 5 bytes for value huge => 0xffffffff1, # 6 bytes for key, 9 bytes for value array => [], # 7 bytes for key, 2 bytes for value dict => {}, # 6 bytes for key, 2 bytes for value null => undef, # 6 bytes for key, 1 byte for value text => 'hi mum!', # 6 bytes for key, 9 bytes for value (Text::Byte) 'hi mum!' => 'hi mum!', # free!!! storage "\x{5317}\x{4eac}\x{5e02}" => 'Beijing', # 11 bytes for key, 9 bytes for value 'Beijing' => "\x{5317}\x{4eac}\x{5e02}", # free storage 2 => 65, # 3 bytes for key, free storage for value 900 => 65, # 5 bytes for key, free storage for value 6.28 => 65, # 6 bytes for key, free storage for value # the last element in the hash, cos its key sorts last zzlongtext => 'z' x 300, # 12 bytes for key, 303 for value (Text::Short) # 524 bytes total }; Data::CompactReadonly->create($filename, $hash); isa_ok($data = Data::CompactReadonly->read($filename), 'Data::CompactReadonly::V0::Dictionary::Byte', "got a Dictionary::Byte"); isa_ok($data, 'Data::CompactReadonly::Dictionary', "and that isa Data::CompactReadonly::Dictionary"); is($data->count(), 20, "20 entries"); is($data->_ptr_size(), 1, "pointers are 1 byte"); cmp_float($data->element('float'), 3.14, "read a Float64"); ok($data->element('true'), "read a True"); if(bool_supported) { ok(is_bool($data->element('true')), "and on super-modern perl the Boolean flag is set correctly"); } ok(!$data->element('false'), "read a False"); if(bool_supported) { ok(is_bool($data->element('false')), "and on super-modern perl the Boolean flag is set correctly"); } ok(!$data->element($false), "False as a key"); if(bool_supported) { ok(is_bool($data->element($false)), "and on super-modern perl the Boolean flag is set correctly"); } is($data->element('byte'), 65, "read a Byte"); is($data->element('short'), 65534, "read a Short"); is($data->element('medium'), 65536, "read a Medium"); is($data->element('long'), 0x1000000, "read a Long"); is($data->element('huge'), 0xffffffff1, "read a Huge"); is($data->element('null'), undef, "read a Null"); is($data->element('text'), 'hi mum!', "read a Text::Byte"); is($data->element('hi mum!'), 'hi mum!', "read the same text again (reused)"); is($data->element('zzlongtext'), 'z' x 300, "read a Text::Short"); isa_ok($embedded_array = $data->element('array'), 'Data::CompactReadonly::V0::Array::Byte', "read an array from the Dictionary"); is($embedded_array->count(), 0, "array is empty"); isa_ok(my $embedded_dict = $data->element('dict'), 'Data::CompactReadonly::V0::Dictionary::Byte', "read a dictionary from the Dictionary"); is($embedded_dict->count(), 0, "dict is empty"); is($data->element("\x{5317}\x{4eac}\x{5e02}"), "Beijing", "non-ASCII keys work"); is($data->element('Beijing'), "\x{5317}\x{4eac}\x{5e02}", "non-ASCII values work"); is((stat($filename))[7], 524, "file size is correct"); if(bool_supported) { ok((!grep { is_bool($_) } $data->indices), "bools as keys are stringified"); } # the previous 20 pointer pairs are now 20 * 2 * _2_ bytes == 80, so an extra 40 bytes $hash->{zzz} = 'say the bees'; # extra pair of pointers (4 bytes), plus 5 bytes for key, 14 bytes for value Data::CompactReadonly->create($filename, $hash); isa_ok($data = Data::CompactReadonly->read($filename), 'Data::CompactReadonly::V0::Dictionary::Byte', "got a Dictionary::Byte"); is($data->count(), 21, "got a hash with 18 entries"); is($data->_ptr_size(), 2, "pointers are 2 bytes"); is($data->element('null'), undef, "read a Null"); is($data->element('text'), 'hi mum!', "read a Text::Byte"); is($data->element('zzz'), 'say the bees', "can retrieve data after the long text"); is( (stat($filename))[7], 587, # 524 (original size) + 40 (extra pointer bytes for previous data) + 23 (new pointers/data) "file size is correct" ); $hash = { 'Bond' => '007', '007' => 'Bond', '0.07' => 'Baby Bond', '00.7' => 'Weird Bond', '000' => 'Georgian Bond', array => [ 5, 'four', [ 3 ], { two => 2 }, 1 ], '7.0' => 'seven point oh', '7.00' => 'seven point oh oh', '7.10' => 'seven point one oh', }; $hash->{dict} = $hash; $hash->{$_} = $_ foreach(0 .. 65536); # Dictionary::Medium, longer 3 byte pointers push @{$hash->{array}}, $hash->{array}; Data::CompactReadonly->create($filename, $hash); isa_ok($data = Data::CompactReadonly->read($filename), 'Data::CompactReadonly::V0::Dictionary::Medium', "got a Dictionary::Medium"); isa_ok($data, 'Data::CompactReadonly::Dictionary', "and that isa Data::CompactReadonly::Dictionary"); is($data->count(), 65547, "right number of elements"); is($data->_ptr_size(), 3, "pointers are 3 bytes"); is($data->element('array')->element(2)->element(0), 3, "can retrieve from an array in an array in a hash"); is($data->element('array')->element(3)->element('two'), 2, "can retrieve from a hash in an array in a hash"); is($data->element('dict')->element(65535), 65535, "can retrieve from an array in a hash"); is($data->element('dict')->element('array')->element(3)->element('two'), 2, "can retrieve from a hash in an array in a hash in a hash"); is($data->element('Bond'), '007', "can store text that looks like a number with leading zeroes"); is($data->element('007'), 'Bond', "... and use it as a key too"); is($data->element(0.07), 'Baby Bond', "zero point something works when presented as a number"); is($data->element('0.07'), 'Baby Bond', "zero point something works when presented as text"); is($data->element('00.7'), 'Weird Bond', "00.7 isn't numeric, gets properly encoded as text"); is($data->element('000'), 'Georgian Bond', 'but 000 is a bunch of characters'); is($data->element('7.0'), 'seven point oh', 'trailing zeroes on strings that look like floats are preserved (7.0)'); is($data->element('7.00'), 'seven point oh oh', 'trailing zeroes on strings that look like floats are preserved (7.00)'); is($data->element('7.10'), 'seven point one oh', 'trailing zeroes on strings that look like floats are preserved (7.10)'); throws_ok { $data->element(7.1) } qr/Invalid element: 7.1: doesn't exist/, "key 7.10 is not the same as key 7.1"; Data::CompactReadonly->create($filename, [ { aardvark => 'bat', cat => 'doge' }, [ [ 65, 66 ], { aardvark => 'bat', cat => 'doge' } ], [ 65, 66 ] ]); # this would be 64 without array/hash de-duping is((stat($filename))[7], 54, "arrays and dictionaries aren't repeated if their contents are identical"); done_testing; Data-CompactReadonly-0.1.1/t/root-node-scalar.t000644 000765 000024 00000006247 14517557311 021521 0ustar00davidstaff000000 000000 use strict; use warnings; no warnings 'portable'; use Test::More; use Test::Exception; use lib 't/lib'; use TestFloat; use File::Temp qw(tempfile); use String::Binary::Interpolation; use Data::IEEE754 qw(pack_double_be); use Scalar::Type qw(bool_supported); Scalar::Type->import('is_bool') if(bool_supported()); use Data::CompactReadonly; my $header_bytes = "CROD\x00"; # version 0, byte pointers foreach my $negative (0, 1) { subtest $negative ? 'negative numbers' : 'positive numbers' => sub { my $type = chr(0b11000000 + $negative * 0b100); open(my $fh, '<', \"$header_bytes$type\x12"); is(Data::CompactReadonly->read($fh), ($negative ? -1 : 1) * 0x12, "can read a Byte"); $type = chr(0b11001000 + $negative * 0b100); open($fh, '<', \"$header_bytes$type\xff\xfe"); is(Data::CompactReadonly->read($fh), ($negative ? -1 : 1) * 0xFFFE, "can read a Short"); $type = chr(0b11010000 + $negative * 0b100); open($fh, '<', \"$header_bytes$type\xff\xfe\x00"); is(Data::CompactReadonly->read($fh), ($negative ? -1 : 1) * 0xFFFE00, "can read a Medium (24 bits)"); $type = chr(0b11011000 + $negative * 0b100); open($fh, '<', \"$header_bytes$type\xff\xfe\x00\x00"); is(Data::CompactReadonly->read($fh), ($negative ? -1 : 1) * 0xFFFE0000, "can read a Long (32 bits)"); $type = chr(0b11100000 + $negative * 0b100); open($fh, '<', \"$header_bytes$type\xff\xfe\x00\x00\x00\x00\x00\x00"); is(Data::CompactReadonly->read($fh), ($negative ? -1 : 1) * 0xFFFE000000000000, "can read a Huge (64 bits)"); }; } subtest 'floats' => sub { my $float_bytes = pack_double_be(3.1415); open(my $fh, '<', \"$header_bytes${b11101100}$float_bytes"); cmp_float(Data::CompactReadonly->read($fh), 3.1415, "can read a Float64"); $float_bytes = pack_double_be(2.718e-50); open($fh, '<', \"$header_bytes${b11101100}$float_bytes"); cmp_float(Data::CompactReadonly->read($fh), 2.718e-50, "can read a teeny-tiny Float64"); $float_bytes = pack_double_be(-1e100/137); open($fh, '<', \"$header_bytes${b11101100}$float_bytes"); cmp_float(Data::CompactReadonly->read($fh), -1e100/137, "can read a hugely negative Float64"); }; open(my $fh, '<', \"$header_bytes${b11101000}"); is(Data::CompactReadonly->read($fh), undef, "can read a Null (undef)"); open($fh, '<', \"$header_bytes${b11110000}"); my $true = Data::CompactReadonly->read($fh); ok($true, "can read a True"); if(bool_supported) { ok(is_bool($true), "and on super-modern perl the Boolean flag is set correctly"); } open($fh, '<', \"$header_bytes${b11110100}"); my $false = Data::CompactReadonly->read($fh); ok(!$false, "can read a False"); if(bool_supported) { ok(is_bool($false), "and on super-modern perl the Boolean flag is set correctly"); } foreach my $scalar_type (0b1110 .. 0b1111) { my $type = chr(($scalar_type << 2) + 0b11000000); my $binary = sprintf('0b%08b', ord($type)); open($fh, '<', \"$header_bytes$type"); throws_ok { Data::CompactReadonly->read($fh)} qr/Invalid type: $binary: Reserved/, "invalid type $binary throws a wobbly"; } done_testing; Data-CompactReadonly-0.1.1/t/tie.t000644 000765 000024 00000007251 14033654112 017113 0ustar00davidstaff000000 000000 use strict; use warnings; use File::Temp qw(tempfile); use Test::More; use Test::Exception; use Test::Differences; use Data::CompactReadonly; (undef, my $filename) = tempfile(UNLINK => 1); Data::CompactReadonly->create($filename, [ [5, 4, 3, 2, 1, 0], {}, { hash => { lemon => 'curry' }, array => [ qw(lemon curry) ], }, 'fishfingers', [] ]); subtest 'tieing with fast_collections cache' => sub { my $tied = Data::CompactReadonly->read($filename, 'tie' => 1, fast_collections => 1); ok(tied(@{$tied}), "db is tied"); is($tied->[2]->{hash}->{lemon}, 'curry', "can read from hashes"); eq_or_diff( $tied->[2]->{array}, [qw(lemon curry)], "read some more" ); }; my $tied = Data::CompactReadonly->read($filename, 'tie' => 1); my $untied = Data::CompactReadonly->read($filename); is($#{$tied}, $untied->count() - 1, "can de-ref and count elements in an Array"); is($tied->[3], 'fishfingers', "can de-ref and retrieve an array element"); is($#{$tied->[0]}, $untied->element(0)->count() - 1, "those work on nested arrays"); throws_ok { $tied->[5] } qr/Invalid element: 5: out of range/, "can't fetch illegal array index"; throws_ok { $tied->[2] = 3 } qr/Illegal access: store: this is a read-only database/, "can't update an array element"; throws_ok { push @{$tied->[0]}, 8 } qr/Illegal access: store: this is a read-only database/, "can't push onto an array"; throws_ok { pop @{$tied->[0]} } qr/Illegal access: store: this is a read-only database/, "can't pop from an array"; throws_ok { unshift @{$tied->[0]}, 8 } qr/Illegal access: store: this is a read-only database/, "can't unshift onto an array"; throws_ok { shift @{$tied->[0]} } qr/Illegal access: store: this is a read-only database/, "can't shift from an array"; throws_ok { delete $tied->[0]->[3] } qr/Illegal access: store: this is a read-only database/, "can't delete from an array"; throws_ok { @{$tied->[0]} = () } qr/Illegal access: store: this is a read-only database/, "can't clear an array"; throws_ok { splice(@{$tied->[0]}, 0, 2, 4) } qr/Illegal access: store: this is a read-only database/, "can't splice an array"; throws_ok { $#{$tied->[0]} = 94 } qr/Illegal access: store: this is a read-only database/, "can't update an array's length"; ok(exists($tied->[0]), "exists() works on an existent index"); ok(!exists($tied->[10]), "... and on a non-existent index"); ok(!exists($tied->[4]->[0]), "... and on an empty array"); throws_ok { $tied->[2]->{cow} } qr/Invalid element: cow: doesn't exist/, "can't fetch illegal dict key"; throws_ok { $tied->[2]->{hash} = 'pipe' } qr/Illegal access: store: this is a read-only database/, "can't update a hash element"; throws_ok { delete($tied->[2]->{hash}) } qr/Illegal access: store: this is a read-only database/, "can't delete from a hash"; throws_ok { %{$tied->[2]->{hash}} = () } qr/Illegal access: store: this is a read-only database/, "can't clear a hash"; is($tied->[2]->{hash}->{lemon}, 'curry', "can de-ref and retrieve Dictionary elements"); ok(exists($tied->[2]->{hash}->{lemon}), "exists() works on an existent key"); ok(!exists($tied->[2]->{hash}->{lime}), "... and on a non-existent key"); ok(!exists($tied->[1]->{wibble}), "... and on an empty hash"); eq_or_diff([keys %{$tied->[2]}], [qw(array hash)], "can get keys of a Dictionary"); eq_or_diff([keys %{$tied->[1]}], [], "can get keys of an empty Dictionary"); is(scalar(%{$tied->[2]}), 2, "can count keys in the hash"); eq_or_diff( [@{$tied->[0]}], [5, 4, 3, 2, 1, 0], "can de-ref an array completely" ); eq_or_diff( { %{$tied->[2]} }, { hash => { lemon => 'curry' }, array => [qw(lemon curry)] }, "can de-ref a dictionary completely" ); done_testing; Data-CompactReadonly-0.1.1/t/file-open.t000644 000765 000024 00000003606 13761512610 020213 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; use Test::Exception; use File::Temp qw(tempfile); use String::Binary::Interpolation; use Fcntl qw(:seek); use Data::CompactReadonly; my $header_bytes = "CROD\x00"; my $byte_at_root = "$header_bytes${b11000000}A"; # 65 (undef, my $filename) = tempfile(UNLINK => 1); open(my $fh, '>', $filename) || die("Can't write $filename: $!\n"); print $fh $byte_at_root; close($fh); is(Data::CompactReadonly->read($filename), 65, "can read a Byte from root node when given a filename"); open($fh, '<:unix', $filename) || die("Can't read $filename: $!\n"); is(Data::CompactReadonly->read($fh), 65, "can read from file handle"); close($fh); open($fh, '<', \$byte_at_root) || die("Can't read from reference: $!\n");; is(Data::CompactReadonly->read($fh), 65, "can read from in-memory file handle"); seek($fh, 0, SEEK_SET); is(Data::CompactReadonly->read($fh), 65, "can re-read from in-memory file handle after seeking back to beginning"); close($fh); open($fh, '<:utf8', $filename) || die("Can'tread $filename: $!\n"); throws_ok { Data::CompactReadonly->read($fh) } qr/invalid encoding/, "refuse to play with a file not opened as bytes (:utf8)"; close($fh); open($fh, '<:encoding(UTF-8)', $filename) || die("Can'tread $filename: $!\n"); throws_ok { Data::CompactReadonly->read($fh) } qr/invalid encoding/, "refuse to play with a file not opened as bytes (:encoding(UTF-8))"; close($fh); throws_ok { Data::CompactReadonly->read('i-dont-exist') } qr/couldn't open file/, "can't open file"; open($fh, '<', \'CROD'); throws_ok { Data::CompactReadonly->read($fh) } qr/header invalid: doesn't match .CROD../, "refuse to play with a file with a dodgy header"; close($fh); open($fh, '<', \"CROD\xff"); throws_ok { Data::CompactReadonly->read($fh) } qr/header invalid: bad version/, "version number too high"; close($fh); done_testing; Data-CompactReadonly-0.1.1/t/root-node-array.t000644 000765 000024 00000020062 13761512610 021352 0ustar00davidstaff000000 000000 use strict; use warnings; no warnings qw(portable); use Test::More; use Test::Differences; use Test::Exception; use File::Temp qw(tempfile); use String::Binary::Interpolation; use Data::CompactReadonly; my $header_bytes = "CROD\x00"; # version 0, byte pointers open(my $fh, '<', \"$header_bytes${b01000000}\x00"); isa_ok( my $array = Data::CompactReadonly->read($fh), "Data::CompactReadonly::V0::Array::Byte" ); is($array->count(), 0, "empty array"); is($array->_ptr_size(), 1, "1 byte pointers"); eq_or_diff($array->indices(), [], "can list collection indices"); throws_ok { $array->element(-1) } qr/Invalid element: -1: negative/, "negative elements are illegal"; throws_ok { $array->element(3.7) } qr/Invalid element: 3.7: non-integer/, "non-integer elements are illegal"; throws_ok { $array->element('horse') } qr/Invalid element: horse: non-integer/, "non-numeric elements are illegal"; throws_ok { $array->element(0) } qr/Invalid element: 0: out of range/, "trying to read beyond end of empty array is fatal"; my $ARRAYBYTE = $b01000000; my $ARRAYSHORT = $b01001000; my $ARRAYMEDIUM = $b01010000; my $ARRAYLONG = $b01011000; my $TEXTBYTE = $b00000000; my $DICTBYTE = $b10000000; my $BYTE = $b11000000; my $SHORT = $b11001000; my $MEDIUM = $b11010000; my $LONG = $b11011000; my $HUGE = $b11100000; my $NULL = $b11101000; open($fh, '<', \( "\x00\x00". # these don't count, we'll seek past them before we start "$header_bytes". # 0x00 "$ARRAYBYTE\x02\x0c\x09". # 0x05 A::Byte, two pointers, dests in reverse order of index "$SHORT\x94\x45". # 0x09 Short, 0x9445 "$BYTE\x94" # 0x0c Byte, 0x94 )); read($fh, my $blah, 2); $array = Data::CompactReadonly->read($fh); is($array->_db_base(), 2, "the fh was opened after having already been partially read"); isa_ok($array, 'Data::CompactReadonly::V0::Array::Byte'); is($array->count(), 2, "2 element array"); throws_ok { $array->element(94) } qr/Invalid element: 94: out of range/, "trying to read beyond end of non-empty array is fatal"; is($array->element(0), 0x94, "fetched a Byte element from the array"); is($array->element(1), 0x9445, "fetched a Short element from the array"); open($fh, '<', \( "$header_bytes". # 0x00 "$ARRAYSHORT\x00\x02\x0d\x0a". # 0x05 A::Short, two pointers "$SHORT\x94\x45". # 0x0a Short, 0x9445 "$MEDIUM\x12\x34\x56" # 0x0d Medium, 0x123456 )); $array = Data::CompactReadonly->read($fh); isa_ok($array, 'Data::CompactReadonly::V0::Array::Short'); is($array->count(), 2, "2 element array"); is($array->element(0), 0x123456, "fetched a Medium element from the array"); is($array->element(1), 0x9445, "fetched a Short element from the array"); open($fh, '<', \( "$header_bytes". # 0x00 "$ARRAYSHORT\x00\x03\x10\x0b\x19". # 0x05 A::Short, three pointers "$LONG\xab\xcd\xef\x01". # 0x0b Long, 0xabcdef01 "$HUGE\xfe\xdc\xba\x98\x76\x54\x32\x10". # 0x10 Huge, 0xfedcba9876543210 "$NULL" # 0x19 )); $array = Data::CompactReadonly->read($fh); isa_ok($array, 'Data::CompactReadonly::V0::Array::Short'); is($array->count(), 3, "3 element array"); is($array->element(0), 0xfedcba9876543210, "fetched a Huge element from the array"); is($array->element(1), 0xabcdef01, "fetched a Long element from the array"); is($array->element(2), undef, "fetched a Null element from the array"); eq_or_diff($array->indices(), [0, 1, 2], "can list collection indices"); open($fh, '<', \( "CROD${b00000001}". # 0x00 pointers are Shorts "$ARRAYSHORT\x00\x06". # 0x05 A::Short, 6 elements "\x00\x19". "\x00\x14". "\x00\x22". "\x00\x23". "\x00\x05". # NB pointer to the array it's a member of "\x00\x2e". "$LONG\xab\xcd\xef\x01". # 0x14 Long, 0xabcdef01 "$HUGE\xfe\xdc\xba\x98\x76\x54\x32\x10". # 0x19 Huge, 0xfedcba9876543210 "$NULL". # 0x22 "$TEXTBYTE\x09Fran\xc3\xa7ais". # 0x23 Text, Franc,ais "$DICTBYTE\x00" # 0x2e Dictionary, empty )); $array = Data::CompactReadonly->read($fh); isa_ok($array, 'Data::CompactReadonly::V0::Array::Short'); is($array->_ptr_size(), 2, "2 byte pointers"); is($array->count(), 6, "6 element array"); is($array->element(0), 0xfedcba9876543210, "fetched a Huge element from the array"); is($array->element(1), 0xabcdef01, "fetched a Long element from the array"); is($array->element(2), undef, "fetched a Null element from the array"); is($array->element(3), "Fran\xe7ais", "fetched a Text element from the array"); isa_ok(my $array2 = $array->element(4), 'Data::CompactReadonly::V0::Array::Short', "fetched an Array element from the array"); isa_ok($array->element(5), # no further tests for this here 'Data::CompactReadonly::V0::Dictionary::Byte', "fetched a Dictionary element from the array"); is($array2->_ptr_size(), 2, "2 byte pointers"); is($array2->count(), 6, "6 element array"); is($array2->element(0), 0xfedcba9876543210, "fetched a Huge element from the array"); is($array2->element(1), 0xabcdef01, "fetched a Long element from the array"); is($array2->element(2), undef, "fetched a Null element from the array"); is($array2->element(3), "Fran\xe7ais", "fetched a Text element from the array"); isa_ok($array2->element(4), 'Data::CompactReadonly::V0::Array::Short', "fetched an Array element from the embedded array"); isa_ok($array->element(4)->element(4)->element(4)->element(4)->element(4), 'Data::CompactReadonly::V0::Array::Short', "it's arrays all the way down"); is($array->id(), $array->element(4)->element(4)->id(), "circular references to arrays all have the same id"); is($array->exists(6), 0, "exists() works on a non-existent element"); is($array->exists(2), 1, "exists() works on an existent element"); throws_ok { $array->exists(-1) } qr/negative/, "exists() dies as expected on an illegal (negative) index"; throws_ok { $array->exists('horse') } qr/non-integer/, "exists() dies as expected on an illegal (non-integer) index"; # at this point we've tested Array::Byte and ::Short, and 1 and 2 byte # pointers. We now test 3, 4, and 8 byte pointers (can't be arsed with # 5/6/7, they'll obviously work if 8 works) and Array::Medium and # Array::Long. We've also fetched all types from the array except Dictionaries open($fh, '<', \( "CROD${b00000010}". # 0x00 pointers are Mediums "$ARRAYLONG\x00\x00\x00\x01". # 0x05 array has 1 member "\x00\x00\x0d". # 0x0a "$BYTE\x09" # 0x0d )); $array = Data::CompactReadonly->read($fh); isa_ok($array, 'Data::CompactReadonly::V0::Array::Long'); is($array->count(), 1, "1 element array"); is($array->_ptr_size(), 3, "3 byte pointers"); is($array->element(0), 9, "can fetch"); open($fh, '<', \( "CROD${b00000011}". # 0x00 pointers are Longs "$ARRAYLONG\x00\x00\x00\x01". # 0x05 array has 1 member "\x00\x00\x00\x0e". # 0x0a "$BYTE\x09" # 0x0e )); $array = Data::CompactReadonly->read($fh); isa_ok($array, 'Data::CompactReadonly::V0::Array::Long'); is($array->count(), 1, "1 element array"); is($array->_ptr_size(), 4, "4 byte pointers"); is($array->element(0), 9, "can fetch"); open($fh, '<', \( "CROD${b00000111}". # 0x00 pointers are Huges "$ARRAYMEDIUM\x00\x00\x01". # 0x05 array has 1 member "\x00\x00\x00\x00\x00\x00\x00\x11". # 0x09 "$BYTE\x09" # 0x11 )); $array = Data::CompactReadonly->read($fh); isa_ok($array, 'Data::CompactReadonly::V0::Array::Medium'); is($array->count(), 1, "1 element array"); is($array->_ptr_size(), 8, "8 byte pointers"); is($array->element(0), 9, "can fetch"); done_testing; Data-CompactReadonly-0.1.1/t/create-scalar.t000644 000765 000024 00000011047 14166354123 021044 0ustar00davidstaff000000 000000 use strict; use warnings; no warnings qw(portable overflow); use File::Temp qw(tempfile); use Scalar::Type qw(:all); use Test::More; use lib 't/lib'; use TestFloat; use Data::CompactReadonly; *_bytes_required_for_int = \&Data::CompactReadonly::V0::Node::_bytes_required_for_int; (undef, my $filename) = tempfile(UNLINK => 1); Data::CompactReadonly->create($filename, undef); is(my $data = Data::CompactReadonly->read($filename), undef, "can create a Null file"); Data::CompactReadonly->create($filename, 1 == 1); my $true = Data::CompactReadonly->read($filename); ok($true, "can create a True file"); if(bool_supported) { ok(is_bool($true), "and on super-modern perl the Boolean flag is set correctly"); } Data::CompactReadonly->create($filename, 1 == 0); my $false = Data::CompactReadonly->read($filename); ok(!$false, "can create a False file"); if(bool_supported) { ok(is_bool($false), "and on super-modern perl the Boolean flag is set correctly"); } foreach my $tuple ( [0, 7], # Byte [0x01, 7], [0x0102, 8], [0x010203, 9], [0x01020304, 10], [0xFFFFFFFF0, 14], # Huge, will require zero-padding [0x10000000000000000, 14], # too big for a Huge, encoded as Float64 ) { my($value, $filesize) = @{$tuple}; foreach my $value ($value, -$value) { Data::CompactReadonly->create($filename, $value); is($data = Data::CompactReadonly->read($filename), $value, abs($value) == 0x10000000000000000 ? "auto-promoted humungo-Int to a Float64" : "can create an Int file ($value)" ); is((stat($filename))[7], $filesize, "... file is expected size for data $value") || diag(`hexdump -C $filename`); } } # normal size, practically zero, ginormously -ve foreach my $value (5.1413, 81.72e-50, -1.37e100/3) { Data::CompactReadonly->create($filename, $value); cmp_float($data = Data::CompactReadonly->read($filename), $value, "can create a Float64 file ($value)"); } foreach my $length (1, 1000, 100000, 0x1000000) { # ^ ^ ^ ^ # Byte --+ | | +-- Long # Short -----+ +---------- Medium my $filesize = 5 + 1 + _bytes_required_for_int(undef, $length) + $length; my $value = 'x' x $length; Data::CompactReadonly->create($filename, $value); my $data = Data::CompactReadonly->read($filename); ok($data eq $value, "can create an ASCII Text file ($length chars), got ".length($data)." chars") || diag("Got ".length($data)." bytes from the db; expected ".length($value).":\n\n".`hexdump -C $filename`); is((stat($filename))[7], $filesize, "... file is expected size $filesize"); } foreach my $length (1, 1000) { my $filesize = 5 + 1 + _bytes_required_for_int(undef, $length) + 9 * $length; my $value = "\x{5317}\x{4eac}\x{5e02}" x $length; Data::CompactReadonly->create($filename, $value); is($data = Data::CompactReadonly->read($filename), $value, "can create a non-ASCII Text file ($length times three chars, each 3 utf-8 bytes)"); is((stat($filename))[7], $filesize, "... file is expected size $filesize"); } foreach my $test ( # torture tests ['007', 10, 'Text'], [007, 7, 'Int'], ['7', 8, 'Text'], [7, 7, 'Int'], [7.0, 14, 'Float64'], ['000', 10, 'Text'], ['0', 8, 'Text'], [0, 7, 'Int'], [0.0, 14, 'Float64'], ['00.7', 11, 'Text'], ['00.07', 12, 'Text'], [0.07, 14, 'Float64'], ['0.07', 11, 'Text'], [7.01, 14, 'Float64'], ['7.01', 11, 'Text'], ['7.0', 10, 'Text'], ['7.00', 11, 'Text'], ['7.10', 11, 'Text'], ) { my($value, $filesize, $type) = @{$test}; Data::CompactReadonly->create($filename, $value); my $data = Data::CompactReadonly->read($filename); $type eq 'Text' ? ok($data eq $value, "can create a file with text value '$value'") && is(type($data), 'SCALAR', "... and read back an SV of the right type"): $type eq 'Float64' ? cmp_float($data, $value, "can create a file with float value $value") && is(type($data), 'NUMBER', "... and read back an SV of the right type"): $type eq 'Int' ? ok($data == $value, "can create a file with integer value $value") && is(type($data), 'INTEGER', "... and read back an SV of the right type"): die("WTF is a $type?\n"); is((stat($filename))[7], $filesize, "... and file is expected size") || diag(`hexdump -C $filename`); } done_testing; Data-CompactReadonly-0.1.1/t/lib/000755 000765 000024 00000000000 14517560621 016716 5ustar00davidstaff000000 000000 Data-CompactReadonly-0.1.1/t/pod-coverage.t000644 000765 000024 00000000624 13761512610 020705 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; eval "use Test::Pod::Coverage 1.08"; plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; foreach my $module (grep { $_ !~ /^Data::CompactReadonly::(V0::)?((Tied)?Array|(Negative)?Scalar|(Tied)?Dictionary|Text|Collection|Node)/ } all_modules()) { diag("Checking $module"); pod_coverage_ok($module); } done_testing(); Data-CompactReadonly-0.1.1/t/root-node-text.t000644 000765 000024 00000005067 14166354123 021233 0ustar00davidstaff000000 000000 use strict; use warnings; use utf8; BEGIN { binmode STDOUT, ":utf8" } use Test::More; use Test::Exception; use File::Temp qw(tempfile); use String::Binary::Interpolation; use Data::CompactReadonly; my $header_bytes = "CROD\x00"; # version 0, byte pointers open(my $fh, '<', \"$header_bytes${b00000000}\x05hippo"); is(Data::CompactReadonly->read($fh), 'hippo', "can read a Text with Byte length"); open($fh, '<', \"$header_bytes${b00001000}\x00\x05hippo"); is(Data::CompactReadonly->read($fh), 'hippo', "can read a Text with Short length"); open($fh, '<', \"$header_bytes${b00010000}\x00\x00\x05hippo"); is(Data::CompactReadonly->read($fh), 'hippo', "can read a Text with Medium (24 bits) length"); open($fh, '<', \"$header_bytes${b00011000}\x00\x00\x00\x05hippo"); is(Data::CompactReadonly->read($fh), 'hippo', "can read a Text with Long (32 bits) length"); foreach my $length_type (0b000, 0b001, 0b010, 0b011, 0b100) { my $type = chr(($length_type << 3) + 0b100); my $binary = sprintf('0b%08b', ord($type)); open($fh, '<', \"$header_bytes$type"); throws_ok { Data::CompactReadonly->read($fh)} qr/Invalid type: $binary: length Negative/, "invalid negative length type $binary throws a wobbly"; } open($fh, '<', \"$header_bytes${b00101000}"); throws_ok { Data::CompactReadonly->read($fh) } qr/Invalid type: 0b00101000: length Null/, "invalid Null length type b00101000 throws a wobbly"; open($fh, '<', \"$header_bytes${b00101100}"); throws_ok { Data::CompactReadonly->read($fh) } qr/Invalid type: 0b00101100: length Float64/, "invalid Float64 length type b00101100 throws a wobbly"; open($fh, '<', \"$header_bytes${b00110000}"); throws_ok { Data::CompactReadonly->read($fh) } qr/Invalid type: 0b00110000: length True/, "invalid Float64 length type b00101100 throws a wobbly"; open($fh, '<', \"$header_bytes${b00110100}"); throws_ok { Data::CompactReadonly->read($fh) } qr/Invalid type: 0b00110100: length False/, "invalid Float64 length type b00101100 throws a wobbly"; foreach my $length_type (0b1110 .. 0b1111) { my $type = chr($length_type << 2); my $binary = sprintf('0b%08b', ord($type)); open($fh, '<', \"$header_bytes$type"); throws_ok { Data::CompactReadonly->read($fh)} qr/Invalid type: $binary: Reserved/, "invalid type $binary throws a wobbly"; } open($fh, '<', \"$header_bytes${b00000000}\x09\xe5\x8c\x97\xe4\xba\xac\xe5\xb8\x82"); is(Data::CompactReadonly->read($fh), "\x{5317}\x{4eac}\x{5e02}", "bytes are converted to utf-8 text: got 3 chars [北, 京, 市] from 9 bytes"); done_testing; Data-CompactReadonly-0.1.1/t/coverage.sh000755 000765 000024 00000000116 13761512610 020273 0ustar00davidstaff000000 000000 #!/bin/sh cover -delete HARNESS_PERL_SWITCHES=-MDevel::Cover make test cover Data-CompactReadonly-0.1.1/t/lib/TestFloat.pm000644 000765 000024 00000001162 14056255640 021161 0ustar00davidstaff000000 000000 package TestFloat; use strict; use warnings; use base qw(Exporter); use Test::More; our @EXPORT = qw(cmp_float); sub cmp_float { my($got, $wanted, $expn) = @_; my $fudge = 1e-8; ok( ( $got >= 0 && ( $wanted * ( 1 - $fudge) <= $got && $wanted * ( 1 + $fudge) >= $got ) ) || ( $got < 0 && ( $wanted * ( 1 - $fudge) >= $got && $wanted * ( 1 + $fudge) <= $got ) ), $expn ) || diag(" got: $got\n expected: $wanted\n"); # copies format of is()'s output }