IO-Stringy-2.113000755000000000000 013610227567 14024 5ustar00unknownunknown000000000000README100644000000000000 325513610227567 14772 0ustar00unknownunknown000000000000IO-Stringy-2.113NAME IO-stringy - I/O on in-core objects like strings and arrays SYNOPSIS use strict; use warnings; use IO::AtomicFile; # Write a file which is updated atomically use IO::InnerFile; # define a file inside another file use IO::Lines; # I/O handle to read/write to array of lines use IO::Scalar; # I/O handle to read/write to a string use IO::ScalarArray; # I/O handle to read/write to array of scalars use IO::Wrap; # Wrap old-style FHs in standard OO interface use IO::WrapTie; # Tie your handles & retain full OO interface # ... DESCRIPTION This toolkit primarily provides modules for performing both traditional and object-oriented i/o) on things *other* than normal filehandles; in particular, IO::Scalar, IO::ScalarArray, and IO::Lines. In the more-traditional IO::Handle front, we have IO::AtomicFile which may be used to painlessly create files which are updated atomically. And in the "this-may-prove-useful" corner, we have IO::Wrap, whose exported wraphandle() function will clothe anything that's not a blessed object in an IO::Handle-like wrapper... so you can just use OO syntax and stop worrying about whether your function's caller handed you a string, a globref, or a FileHandle. AUTHOR Eryq (eryq@zeegee.com). President, ZeeGee Software Inc (http://www.zeegee.com). CONTRIBUTORS Dianne Skoll (dfs@roaringpenguin.com). COPYRIGHT & LICENSE Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. COPYING100644000000000000 361313610227567 15143 0ustar00unknownunknown000000000000IO-Stringy-2.113The "IO-stringy" Perl5 toolkit. Copyright (c) 1996 by Eryq. All rights reserved. Copyright (c) 1999,2001 by ZeeGee Software Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. You should have received a copy of the Perl license along with Perl; see the file README in Perl distribution. You should have received a copy of the GNU General Public License along with Perl; see the file Copying. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. You should have received a copy of the Artistic License along with Perl; see the file Artistic. NO WARRANTY 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. 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 Changes100644000000000000 1643213610227567 15426 0ustar00unknownunknown000000000000IO-Stringy-2.113Revision history IO-Stringy 2.113 2020-01-16 - Get rid of use of Common and TBone in all tests - Convert to Dist::Zilla for authoring - Cleaned up some of the docs. Needs more. 2.112 2019-12-13 - Added the change log from any prior source that could be found. Formatted the log to fit metacpan.org loose standards. - Added .mailmap to correctly attribute all commits to Dianne Skoll when using: git shortlog -s -e - Added .gitattributes and .gitignore to assist with keeping the repo clean - Change use vars qw() to our $whatever instead. 'our' - Hide IO::WrapTie subclasses from PAUSE - Rebuild Makefile.PL to contain all of the prerequisites. Make use of the stub from Dist::Zilla - Convert README to README.md - Fix the documentation in the main module, IO::Stringy to better indicate where to get info and how to use the module - Fix the dist's META information to indicate the original author and license - Add a LICENSE file - Get rid of the set-version.pl file as it's no longer needed - Add AppVeyor CI testing - Add Travis CI testing - update t/IO_InnerFile.t to use Test::More and a proper TEMP file (RT #103895) 2.111 2015-04-22 - Update maintainer's name, which is now Dianne Skoll. 2.110 2005-02-10 - Maintainership taken over by DSKOLL - RT 2208 IO::ScalarArray->getline does not return undef for EOF if undef($/) - RT 7132 IO-stringy/Makefile.PL bug - name should be module name - RT 11249 IO::Scalar flush shouldn't return undef - RT 2172 $\ (output record separator) not respected - RT 8605 IO::InnerFile::seek() should return 1 on success - RT 4798 *.html in lib/ 2.109 2003-12-21 - IO::Scalar::getline now works with ref to int. *Dominique Quatravaux* - RT 4369 Improvement: handling of fixed-size reads in IO::Scalar 2.108 2001-08-20 - The terms-of-use have been placed in the distribution file "COPYING". Also, small documentation tweaks were made. 2.105 2001-08-09 - Added support for various seek() whences to IO::ScalarArray. - Added support for consulting $/ in IO::Scalar and IO::ScalarArray. - The old "use_RS()" is not even an option. Unsupported record separators will cause a croak(). - Added a lot of regression tests to supoprt the above. - Better on-line docs (hyperlinks to individual functions). 2.103 2001-08-08 - After sober consideration I have reimplemented IO::Scalar::print() so that it once again always seeks to the end of the string. Benchmarks show the new implementation to be just as fast as Juergen's contributed patch; until someone can convince me otherwise, the current, safer implementation stays. - I thought more about giving IO::Scalar two separate handles, one for reading and one for writing, as suggested by Binkley. His points about what tell() and eof() return are, I think, show-stoppers for this feature. Even the manpages for stdio's fseek() seem to imply a *single* file position indicator, not two. So I think I will take this off the TO DO list. Remedy: you can always have two handles open on the same scalar, one which you only write to, and one which you only read from. That should give the same effect. 2.101 2001-08-07 - Alpha release. This is the initial release of the "IO::Scalar and friends are now subclasses of IO::Handle". I'm flinging it against the wall. Please tell me if the banana sticks. When it does, the banana will be called 2.2x. - First off, *many many thanks to Doug Wilson*, who has provided an *invaluable* service by patching IO::Scalar and friends so that they (1) inherit from IO::Handle, (2) automatically tie themselves so that the "new()" objects can be used in native i/o constructs, and (3) doing it so that the whole damn thing passes its regression tests. As Doug knows, my globref Kung-Fu was not up to the task; he graciously provided the patches. This has earned him a seat at the Co-Authors table, and the right to have me address him as *sensei*. - Performance of IO::Scalar::print() has been improved by as much as 2x for lots of little prints, with the cost of forcing those who print-then-seek-then-print to explicitly seek to end-of-string before printing again. *Thanks to Juergen Zeller for this patch.* - Added the COPYING file, which had been missing from prior versions. *Thanks to Albert Chin-A-Young for pointing this out.* - IO::Scalar consults $/ by default (1.x ignored it by default). Yes, I still need to support IO::ScalarArray. 1.221 2001-08-07 - Add missing information to "INSTALLATION" -- David Beroff 1.220 2001-04-03 - Added untested SEEK, TELL, and EOF methods to IO::Scalar and IO::ScalarArray to support corresponding functions for tied filehandles: untested, because I'm still running 5.00556 and Perl is complaining about "tell() on unopened file". *Thanks to Graham Barr* - Removed not-fully-blank lines from modules; these were causing lots of POD-related warnings. *Thanks to Nicolas Joly* 1.219 2001-02-23 - IO::Scalar objects can now be made sensitive to $/ . Pains were taken to keep the fast code fast while adding this feature. *Cheers to Graham Barr for submitting his patch; jeers to me for losing his email for 6 months.* 1.218 2001-02-23 - IO::Scalar has a new sysseek() method. (Richard Jones) - New "TO DO" section, because people who submit patches/ideas should at least know that they're in the system... and that I won't lose their stuff. Please read it. - New entries in "AUTHOR". Please read those too. 1.216 2000-09-28 - IO::Scalar and IO::ScalarArray now inherit from IO::Handle. (B. K. Oxley) - Nasty bug fixed in IO::Scalar::write(). Apparently, the offset and the number-of-bytes arguments were, for all practical purposes, *reversed.* You were okay if you did all your writing with print(), but boy was *this* a stupid bug! *Thanks to Richard Jones* - New sysread and syswrite methods for IO::Scalar. *Thanks again to Richard Jones for this.* 1.215 2000-09-05 - Added 'bool' overload to '""' overload, so object always evaluates to true. 1.214 2000-09-03 - Evaluating an IO::Scalar in a string context now yields the underlying string. *Thanks to B. K. Oxley (binkley) for this.* 1.213 2000-08-16 - Minor documentation fixes. 1.212 2000-06-02 - Fixed IO::InnerFile incompatibility with Perl5.004. *Thanks to many folks for reporting this.* 1.210 2000-04-17 - Added flush() and other no-op methods. -- Doru Petrescu 1.209 2000-03-17 - Small bug fixes. 1.208 2000-03-14 - Incorporated a number of contributed patches and extensions, mostly related to speed hacks, support for "offset", and WRITE/CLOSE methods. *Thanks to Richard Jones, Doru Petrescu, and many others.* 1.206 1999-04-18 - Added creation of ./testout when Makefile.PL is run. 1.205 1999-01-15 - Verified for Perl5.005. 1.202 1998-04-18 - New IO::WrapTie and IO::AtomicFile added. 1.110 1998-03-27 - Added IO::WrapTie. 1.109 1998-03-23 1.107 - Added IO::Lines, and made some bug fixes to IO::ScalarArray. - Also, added getc(). 1.105 1997-12-15 - No real changes; just upgraded IO::Wrap to have a $VERSION string. 1.104 1997-11-05 - Earliest release found t000755000000000000 013610227567 14210 5ustar00unknownunknown000000000000IO-Stringy-2.113two.t100644000000000000 110413610227567 15342 0ustar00unknownunknown000000000000IO-Stringy-2.113/tuse strict; use warnings; use IO::Scalar; use Test::More tests => 3; ### Open handles on strings: my $str1 = "Tea for two"; my $str2 = "Me 4 U"; my $str3 = "hello"; my $S1 = IO::Scalar->new(\$str1); my $S2 = IO::Scalar->new(\$str2); ### Interleave output: print $S1 ", and two "; print $S2 ", and U "; my $S3 = IO::Scalar->new(\$str3); $S3->print(", world"); print $S1 "for tea"; print $S2 "4 me"; ### Verify: is($str1, "Tea for two, and two for tea", "COHERENT STRING 1"); is($str2, "Me 4 U, and U 4 me", "COHERENT STRING 2"); is($str3, "hello, world", "COHERENT STRING 3"); LICENSE100644000000000000 4373513610227567 15146 0ustar00unknownunknown000000000000IO-Stringy-2.113This software is copyright (c) 1997 by Erik Dorfman . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 1997 by Erik Dorfman . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 1997 by Erik Dorfman . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End cpanfile100644000000000000 211513610227567 15610 0ustar00unknownunknown000000000000IO-Stringy-2.113on 'runtime' => sub { requires 'perl' => '5.008'; requires 'strict'; requires 'warnings'; requires 'overload'; requires 'parent'; requires 'Carp'; requires 'Exporter' => '5.57'; requires 'File::Spec'; requires 'FileHandle'; requires 'IO::File'; requires 'IO::Handle'; requires 'Symbol'; }; on 'build' => sub { requires 'ExtUtils::MakeMaker'; }; on 'test' => sub { requires 'strict'; requires 'warnings'; requires 'ExtUtils::MakeMaker'; requires 'File::Basename'; requires 'File::Spec'; requires 'File::Temp'; requires 'FileHandle'; requires 'IO::File'; requires 'IO::Handle'; requires 'Symbol'; requires 'Test::More' => '0.88'; # already uses done_testing requires 'Test::Tester'; }; on 'develop' => sub { requires 'Dist::Zilla'; requires 'Test::CheckManifest' => '1.29'; requires 'Test::CPAN::Changes' => '0.4'; requires 'Test::Kwalitee' => '1.22'; requires 'Test::Pod'; requires 'Test::Pod::Spelling::CommonMistakes' => '1.000'; requires 'Test::TrailingSpace'; };dist.ini100644000000000000 304213610227567 15550 0ustar00unknownunknown000000000000IO-Stringy-2.113name = IO-Stringy author = Erik Dorfman license = Perl_5 copyright_holder = Erik Dorfman copyright_year = 1997 ; version = 2.113 ; abstract = I/O on in-core objects like strings and arrays [Git::GatherDir] exclude_filename = Makefile.PL exclude_filename = META.json exclude_filename = README.md exclude_filename = LICENSE exclude_filename = t/00-report-prereqs.t [@Starter] -remove = GatherDir revision = 3 managed_versions = 1 installer = MakeMaker::Awesome RewriteVersion.global = 1 NextRelease.format = %-9v %{yyyy-MM-dd}d [ReadmeAnyFromPod / Markdown_Readme] type = gfm source_filename = lib/IO/Stringy.pm filename = README.md location = root [Prereqs::FromCPANfile] [Git::Contributors] [GithubMeta] issues = 1 user = genio [@Git] [CheckChangeLog] [CheckChangesHasContent] [Test::ChangesHasContent] [Test::Kwalitee] skiptest = no_symlinks [Test::Version] [Test::Pod::Coverage::Configurable] trustme = IO::Scalar => qr/^(?:use_RS)$/ trustme = IO::WrapTie => qr/^(?:new)$/ [Test::PodSpelling] wordlist = Pod::Wordlist ; spell_cmd = hunspell -l stopword = SLAVECLASS stopword = getline stopword = getlines stopword = tieable stopword = wraphandle stopword = dfs stopword = POS stopword = SCALARREF stopword = ing stopword = getpos stopword = setpos stopword = sref stopword = Doru stopword = FOO stopword = Foo stopword = aref stopword = reblessed stopword = ZeeGee stopword = BUF stopword = NBYTES [CopyFilesFromBuild] copy = lib/IO/Stringy.pm copy = Makefile.PL copy = META.json copy = LICENSE copy = t/00-report-prereqs.tMETA.yml100644000000000000 2763113610227567 15407 0ustar00unknownunknown000000000000IO-Stringy-2.113--- abstract: 'I/O on in-core objects like strings and arrays' author: - 'Erik Dorfman ' build_requires: ExtUtils::MakeMaker: '0' File::Basename: '0' File::Spec: '0' File::Temp: '0' FileHandle: '0' IO::File: '0' IO::Handle: '0' Symbol: '0' Test::More: '0.88' Test::Tester: '0' strict: '0' warnings: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: IO-Stringy no_index: directory: - eg - examples - inc - share - t - xt provides: IO::AtomicFile: file: lib/IO/AtomicFile.pm version: '2.113' IO::InnerFile: file: lib/IO/InnerFile.pm version: '2.113' IO::Lines: file: lib/IO/Lines.pm version: '2.113' IO::Scalar: file: lib/IO/Scalar.pm version: '2.113' IO::ScalarArray: file: lib/IO/ScalarArray.pm version: '2.113' IO::Stringy: file: lib/IO/Stringy.pm version: '2.113' IO::Wrap: file: lib/IO/Wrap.pm version: '2.113' IO::WrapTie: file: lib/IO/WrapTie.pm version: '2.113' requires: Carp: '0' Exporter: '5.57' File::Spec: '0' FileHandle: '0' IO::File: '0' IO::Handle: '0' Symbol: '0' overload: '0' parent: '0' perl: '5.008' strict: '0' warnings: '0' resources: bugtracker: https://github.com/genio/IO-Stringy/issues homepage: https://github.com/genio/IO-Stringy repository: https://github.com/genio/IO-Stringy.git version: '2.113' x_Dist_Zilla: perl: version: '5.030000' plugins: - class: Dist::Zilla::Plugin::Git::GatherDir config: Dist::Zilla::Plugin::GatherDir: exclude_filename: - LICENSE - META.json - Makefile.PL - README.md - t/00-report-prereqs.t exclude_match: [] follow_symlinks: 0 include_dotfiles: 0 prefix: '' prune_directory: [] root: . Dist::Zilla::Plugin::Git::GatherDir: include_untracked: 0 name: Git::GatherDir version: '2.046' - class: Dist::Zilla::Plugin::MetaYAML name: '@Starter/MetaYAML' version: '6.012' - class: Dist::Zilla::Plugin::MetaJSON name: '@Starter/MetaJSON' version: '6.012' - class: Dist::Zilla::Plugin::License name: '@Starter/License' version: '6.012' - class: Dist::Zilla::Plugin::Pod2Readme name: '@Starter/Pod2Readme' version: '0.004' - class: Dist::Zilla::Plugin::PodSyntaxTests name: '@Starter/PodSyntaxTests' version: '6.012' - class: Dist::Zilla::Plugin::Test::ReportPrereqs name: '@Starter/Test::ReportPrereqs' version: '0.027' - class: Dist::Zilla::Plugin::Test::Compile config: Dist::Zilla::Plugin::Test::Compile: bail_out_on_fail: '0' fail_on_warning: author fake_home: 0 filename: xt/author/00-compile.t module_finder: - ':InstallModules' needs_display: 0 phase: develop script_finder: - ':PerlExecFiles' skips: [] switch: [] name: '@Starter/Test::Compile' version: '2.058' - class: Dist::Zilla::Plugin::MakeMaker::Awesome config: Dist::Zilla::Plugin::MakeMaker: make_path: gmake version: '6.012' Dist::Zilla::Role::TestRunner: default_jobs: 1 version: '6.012' name: '@Starter/MakeMaker::Awesome' version: '0.48' - class: Dist::Zilla::Plugin::Manifest name: '@Starter/Manifest' version: '6.012' - class: Dist::Zilla::Plugin::PruneCruft name: '@Starter/PruneCruft' version: '6.012' - class: Dist::Zilla::Plugin::ManifestSkip name: '@Starter/ManifestSkip' version: '6.012' - class: Dist::Zilla::Plugin::RunExtraTests config: Dist::Zilla::Role::TestRunner: default_jobs: 1 name: '@Starter/RunExtraTests' version: '0.029' - class: Dist::Zilla::Plugin::RewriteVersion config: Dist::Zilla::Plugin::RewriteVersion: add_tarball_name: 0 finders: - ':ExecFiles' - ':InstallModules' global: 1 skip_version_provider: 0 name: '@Starter/RewriteVersion' version: '0.018' - class: Dist::Zilla::Plugin::NextRelease name: '@Starter/NextRelease' version: '6.012' - class: Dist::Zilla::Plugin::BumpVersionAfterRelease config: Dist::Zilla::Plugin::BumpVersionAfterRelease: finders: - ':ExecFiles' - ':InstallModules' global: 0 munge_makefile_pl: 1 name: '@Starter/BumpVersionAfterRelease' version: '0.018' - class: Dist::Zilla::Plugin::TestRelease name: '@Starter/TestRelease' version: '6.012' - class: Dist::Zilla::Plugin::ConfirmRelease name: '@Starter/ConfirmRelease' version: '6.012' - class: Dist::Zilla::Plugin::UploadToCPAN name: '@Starter/UploadToCPAN' version: '6.012' - class: Dist::Zilla::Plugin::MetaConfig name: '@Starter/MetaConfig' version: '6.012' - class: Dist::Zilla::Plugin::MetaNoIndex name: '@Starter/MetaNoIndex' version: '6.012' - class: Dist::Zilla::Plugin::MetaProvides::Package config: Dist::Zilla::Plugin::MetaProvides::Package: finder_objects: - class: Dist::Zilla::Plugin::FinderCode name: '@Starter/MetaProvides::Package/AUTOVIV/:InstallModulesPM' version: '6.012' include_underscores: 0 Dist::Zilla::Role::MetaProvider::Provider: $Dist::Zilla::Role::MetaProvider::Provider::VERSION: '2.002004' inherit_missing: '1' inherit_version: '1' meta_noindex: '1' Dist::Zilla::Role::ModuleMetadata: Module::Metadata: '1.000036' version: '0.006' name: '@Starter/MetaProvides::Package' version: '2.004003' - class: Dist::Zilla::Plugin::ShareDir name: '@Starter/ShareDir' version: '6.012' - class: Dist::Zilla::Plugin::ExecDir name: '@Starter/ExecDir' version: '6.012' - class: Dist::Zilla::Plugin::ReadmeAnyFromPod config: Dist::Zilla::Role::FileWatcher: version: '0.006' name: Markdown_Readme version: '0.163250' - class: Dist::Zilla::Plugin::Prereqs::FromCPANfile name: Prereqs::FromCPANfile version: '0.08' - class: Dist::Zilla::Plugin::Git::Contributors config: Dist::Zilla::Plugin::Git::Contributors: git_version: 2.16.1.windows.1 include_authors: 0 include_releaser: 1 order_by: name paths: [] name: Git::Contributors version: '0.035' - class: Dist::Zilla::Plugin::GithubMeta name: GithubMeta version: '0.58' - class: Dist::Zilla::Plugin::Git::Check config: Dist::Zilla::Plugin::Git::Check: untracked_files: die Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes - dist.ini allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.16.1.windows.1 repo_root: . name: '@Git/Check' version: '2.046' - class: Dist::Zilla::Plugin::Git::Commit config: Dist::Zilla::Plugin::Git::Commit: add_files_in: [] commit_msg: v%V%n%n%c Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes - dist.ini allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.16.1.windows.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@Git/Commit' version: '2.046' - class: Dist::Zilla::Plugin::Git::Tag config: Dist::Zilla::Plugin::Git::Tag: branch: ~ changelog: Changes signed: 0 tag: v2.113 tag_format: v%V tag_message: v%V Dist::Zilla::Role::Git::Repo: git_version: 2.16.1.windows.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@Git/Tag' version: '2.046' - class: Dist::Zilla::Plugin::Git::Push config: Dist::Zilla::Plugin::Git::Push: push_to: - origin remotes_must_exist: 1 Dist::Zilla::Role::Git::Repo: git_version: 2.16.1.windows.1 repo_root: . name: '@Git/Push' version: '2.046' - class: Dist::Zilla::Plugin::CheckChangeLog name: CheckChangeLog version: '0.05' - class: Dist::Zilla::Plugin::CheckChangesHasContent name: CheckChangesHasContent version: '0.011' - class: Dist::Zilla::Plugin::Test::ChangesHasContent name: Test::ChangesHasContent version: '0.011' - class: Dist::Zilla::Plugin::Test::Kwalitee config: Dist::Zilla::Plugin::Test::Kwalitee: filename: xt/release/kwalitee.t skiptest: - no_symlinks name: Test::Kwalitee version: '2.12' - class: Dist::Zilla::Plugin::Test::Version name: Test::Version version: '1.09' - class: Dist::Zilla::Plugin::Test::Pod::Coverage::Configurable name: Test::Pod::Coverage::Configurable version: '0.07' - class: Dist::Zilla::Plugin::Test::PodSpelling config: Dist::Zilla::Plugin::Test::PodSpelling: directories: - bin - lib spell_cmd: '' stopwords: - BUF - Doru - FOO - Foo - NBYTES - POS - SCALARREF - SLAVECLASS - ZeeGee - aref - dfs - getline - getlines - getpos - ing - reblessed - setpos - sref - tieable - wraphandle wordlist: Pod::Wordlist name: Test::PodSpelling version: '2.007005' - class: Dist::Zilla::Plugin::CopyFilesFromBuild name: CopyFilesFromBuild version: '0.170880' - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':ExtraTestFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':PerlExecFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':AllFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':NoFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: '@Starter/MetaProvides::Package/AUTOVIV/:InstallModulesPM' version: '6.012' zilla: class: Dist::Zilla::Dist::Builder config: is_trial: '0' version: '6.012' x_contributors: - 'Chase Whitener ' - 'Dianne Skoll ' x_generated_by_perl: v5.30.0 x_serialization_backend: 'YAML::Tiny version 1.73' MANIFEST100644000000000000 124613610227567 15241 0ustar00unknownunknown000000000000IO-Stringy-2.113# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. COPYING Changes LICENSE MANIFEST META.json META.yml Makefile.PL README contrib/Clever.pm cpanfile dist.ini examples/IO_Scalar_synopsis lib/IO/AtomicFile.pm lib/IO/InnerFile.pm lib/IO/Lines.pm lib/IO/Scalar.pm lib/IO/ScalarArray.pm lib/IO/Stringy.pm lib/IO/Wrap.pm lib/IO/WrapTie.pm t/00-report-prereqs.dd t/00-report-prereqs.t t/IO_InnerFile.t t/IO_Lines.t t/IO_Scalar.t t/IO_ScalarArray.t t/IO_WrapTie.t t/simple.t t/two.t xt/author/00-compile.t xt/author/pod-coverage.t xt/author/pod-spell.t xt/author/pod-syntax.t xt/author/test-version.t xt/release/changes_has_content.t xt/release/kwalitee.t META.json100644000000000000 4634413610227567 15561 0ustar00unknownunknown000000000000IO-Stringy-2.113{ "abstract" : "I/O on in-core objects like strings and arrays", "author" : [ "Erik Dorfman " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "IO-Stringy", "no_index" : { "directory" : [ "eg", "examples", "inc", "share", "t", "xt" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Dist::Zilla" : "0", "File::Spec" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Pod::Coverage::TrustPod" : "0", "Test::CPAN::Changes" : "0.4", "Test::CheckManifest" : "1.29", "Test::Kwalitee" : "1.22", "Test::More" : "0.88", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08", "Test::Pod::Spelling::CommonMistakes" : "1.000", "Test::Spelling" : "0.12", "Test::TrailingSpace" : "0", "Test::Version" : "1" } }, "runtime" : { "requires" : { "Carp" : "0", "Exporter" : "5.57", "File::Spec" : "0", "FileHandle" : "0", "IO::File" : "0", "IO::Handle" : "0", "Symbol" : "0", "overload" : "0", "parent" : "0", "perl" : "5.008", "strict" : "0", "warnings" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "ExtUtils::MakeMaker" : "0", "File::Basename" : "0", "File::Spec" : "0", "File::Temp" : "0", "FileHandle" : "0", "IO::File" : "0", "IO::Handle" : "0", "Symbol" : "0", "Test::More" : "0.88", "Test::Tester" : "0", "strict" : "0", "warnings" : "0" } } }, "provides" : { "IO::AtomicFile" : { "file" : "lib/IO/AtomicFile.pm", "version" : "2.113" }, "IO::InnerFile" : { "file" : "lib/IO/InnerFile.pm", "version" : "2.113" }, "IO::Lines" : { "file" : "lib/IO/Lines.pm", "version" : "2.113" }, "IO::Scalar" : { "file" : "lib/IO/Scalar.pm", "version" : "2.113" }, "IO::ScalarArray" : { "file" : "lib/IO/ScalarArray.pm", "version" : "2.113" }, "IO::Stringy" : { "file" : "lib/IO/Stringy.pm", "version" : "2.113" }, "IO::Wrap" : { "file" : "lib/IO/Wrap.pm", "version" : "2.113" }, "IO::WrapTie" : { "file" : "lib/IO/WrapTie.pm", "version" : "2.113" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/genio/IO-Stringy/issues" }, "homepage" : "https://github.com/genio/IO-Stringy", "repository" : { "type" : "git", "url" : "https://github.com/genio/IO-Stringy.git", "web" : "https://github.com/genio/IO-Stringy" } }, "version" : "2.113", "x_Dist_Zilla" : { "perl" : { "version" : "5.030000" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::Git::GatherDir", "config" : { "Dist::Zilla::Plugin::GatherDir" : { "exclude_filename" : [ "LICENSE", "META.json", "Makefile.PL", "README.md", "t/00-report-prereqs.t" ], "exclude_match" : [], "follow_symlinks" : 0, "include_dotfiles" : 0, "prefix" : "", "prune_directory" : [], "root" : "." }, "Dist::Zilla::Plugin::Git::GatherDir" : { "include_untracked" : 0 } }, "name" : "Git::GatherDir", "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "@Starter/MetaYAML", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "@Starter/MetaJSON", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "@Starter/License", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::Pod2Readme", "name" : "@Starter/Pod2Readme", "version" : "0.004" }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "@Starter/PodSyntaxTests", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::Test::ReportPrereqs", "name" : "@Starter/Test::ReportPrereqs", "version" : "0.027" }, { "class" : "Dist::Zilla::Plugin::Test::Compile", "config" : { "Dist::Zilla::Plugin::Test::Compile" : { "bail_out_on_fail" : 0, "fail_on_warning" : "author", "fake_home" : 0, "filename" : "xt/author/00-compile.t", "module_finder" : [ ":InstallModules" ], "needs_display" : 0, "phase" : "develop", "script_finder" : [ ":PerlExecFiles" ], "skips" : [], "switch" : [] } }, "name" : "@Starter/Test::Compile", "version" : "2.058" }, { "class" : "Dist::Zilla::Plugin::MakeMaker::Awesome", "config" : { "Dist::Zilla::Plugin::MakeMaker" : { "make_path" : "gmake", "version" : "6.012" }, "Dist::Zilla::Role::TestRunner" : { "default_jobs" : 1, "version" : "6.012" } }, "name" : "@Starter/MakeMaker::Awesome", "version" : "0.48" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "@Starter/Manifest", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::PruneCruft", "name" : "@Starter/PruneCruft", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::ManifestSkip", "name" : "@Starter/ManifestSkip", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::RunExtraTests", "config" : { "Dist::Zilla::Role::TestRunner" : { "default_jobs" : 1 } }, "name" : "@Starter/RunExtraTests", "version" : "0.029" }, { "class" : "Dist::Zilla::Plugin::RewriteVersion", "config" : { "Dist::Zilla::Plugin::RewriteVersion" : { "add_tarball_name" : 0, "finders" : [ ":ExecFiles", ":InstallModules" ], "global" : 1, "skip_version_provider" : 0 } }, "name" : "@Starter/RewriteVersion", "version" : "0.018" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "@Starter/NextRelease", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::BumpVersionAfterRelease", "config" : { "Dist::Zilla::Plugin::BumpVersionAfterRelease" : { "finders" : [ ":ExecFiles", ":InstallModules" ], "global" : 0, "munge_makefile_pl" : 1 } }, "name" : "@Starter/BumpVersionAfterRelease", "version" : "0.018" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "@Starter/TestRelease", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "@Starter/ConfirmRelease", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "@Starter/UploadToCPAN", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "@Starter/MetaConfig", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::MetaNoIndex", "name" : "@Starter/MetaNoIndex", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::MetaProvides::Package", "config" : { "Dist::Zilla::Plugin::MetaProvides::Package" : { "finder_objects" : [ { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "@Starter/MetaProvides::Package/AUTOVIV/:InstallModulesPM", "version" : "6.012" } ], "include_underscores" : 0 }, "Dist::Zilla::Role::MetaProvider::Provider" : { "$Dist::Zilla::Role::MetaProvider::Provider::VERSION" : "2.002004", "inherit_missing" : 1, "inherit_version" : 1, "meta_noindex" : 1 }, "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000036", "version" : "0.006" } }, "name" : "@Starter/MetaProvides::Package", "version" : "2.004003" }, { "class" : "Dist::Zilla::Plugin::ShareDir", "name" : "@Starter/ShareDir", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::ExecDir", "name" : "@Starter/ExecDir", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::ReadmeAnyFromPod", "config" : { "Dist::Zilla::Role::FileWatcher" : { "version" : "0.006" } }, "name" : "Markdown_Readme", "version" : "0.163250" }, { "class" : "Dist::Zilla::Plugin::Prereqs::FromCPANfile", "name" : "Prereqs::FromCPANfile", "version" : "0.08" }, { "class" : "Dist::Zilla::Plugin::Git::Contributors", "config" : { "Dist::Zilla::Plugin::Git::Contributors" : { "git_version" : "2.16.1.windows.1", "include_authors" : 0, "include_releaser" : 1, "order_by" : "name", "paths" : [] } }, "name" : "Git::Contributors", "version" : "0.035" }, { "class" : "Dist::Zilla::Plugin::GithubMeta", "name" : "GithubMeta", "version" : "0.58" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "config" : { "Dist::Zilla::Plugin::Git::Check" : { "untracked_files" : "die" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes", "dist.ini" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.16.1.windows.1", "repo_root" : "." } }, "name" : "@Git/Check", "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "config" : { "Dist::Zilla::Plugin::Git::Commit" : { "add_files_in" : [], "commit_msg" : "v%V%n%n%c" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes", "dist.ini" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.16.1.windows.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@Git/Commit", "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "config" : { "Dist::Zilla::Plugin::Git::Tag" : { "branch" : null, "changelog" : "Changes", "signed" : 0, "tag" : "v2.113", "tag_format" : "v%V", "tag_message" : "v%V" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.16.1.windows.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@Git/Tag", "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::Git::Push", "config" : { "Dist::Zilla::Plugin::Git::Push" : { "push_to" : [ "origin" ], "remotes_must_exist" : 1 }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.16.1.windows.1", "repo_root" : "." } }, "name" : "@Git/Push", "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::CheckChangeLog", "name" : "CheckChangeLog", "version" : "0.05" }, { "class" : "Dist::Zilla::Plugin::CheckChangesHasContent", "name" : "CheckChangesHasContent", "version" : "0.011" }, { "class" : "Dist::Zilla::Plugin::Test::ChangesHasContent", "name" : "Test::ChangesHasContent", "version" : "0.011" }, { "class" : "Dist::Zilla::Plugin::Test::Kwalitee", "config" : { "Dist::Zilla::Plugin::Test::Kwalitee" : { "filename" : "xt/release/kwalitee.t", "skiptest" : [ "no_symlinks" ] } }, "name" : "Test::Kwalitee", "version" : "2.12" }, { "class" : "Dist::Zilla::Plugin::Test::Version", "name" : "Test::Version", "version" : "1.09" }, { "class" : "Dist::Zilla::Plugin::Test::Pod::Coverage::Configurable", "name" : "Test::Pod::Coverage::Configurable", "version" : "0.07" }, { "class" : "Dist::Zilla::Plugin::Test::PodSpelling", "config" : { "Dist::Zilla::Plugin::Test::PodSpelling" : { "directories" : [ "bin", "lib" ], "spell_cmd" : "", "stopwords" : [ "BUF", "Doru", "FOO", "Foo", "NBYTES", "POS", "SCALARREF", "SLAVECLASS", "ZeeGee", "aref", "dfs", "getline", "getlines", "getpos", "ing", "reblessed", "setpos", "sref", "tieable", "wraphandle" ], "wordlist" : "Pod::Wordlist" } }, "name" : "Test::PodSpelling", "version" : "2.007005" }, { "class" : "Dist::Zilla::Plugin::CopyFilesFromBuild", "name" : "CopyFilesFromBuild", "version" : "0.170880" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExtraTestFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":PerlExecFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":AllFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":NoFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "@Starter/MetaProvides::Package/AUTOVIV/:InstallModulesPM", "version" : "6.012" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : 0 }, "version" : "6.012" } }, "x_contributors" : [ "Chase Whitener ", "Dianne Skoll " ], "x_generated_by_perl" : "v5.30.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.11" } simple.t100644000000000000 171313610227567 16030 0ustar00unknownunknown000000000000IO-Stringy-2.113/tuse strict; use warnings; use IO::Scalar; use IO::ScalarArray; use IO::Lines; use Test::More tests => 6; my $SH = IO::Scalar->new(); print $SH "Hi there!\n"; print $SH "Tres cool, no?\n"; is(${$SH->sref}, "Hi there!\nTres cool, no?\n", 'sref: Got the correct string'); $SH->seek(0, 0); my $line = <$SH>; is($line, "Hi there!\n", 'readline: got the right first line'); my $AH = IO::ScalarArray->new; print $AH "Hi there!\n"; print $AH "Tres cool, no?\n"; is(join('', @{$AH->aref}), "Hi there!\nTres cool, no?\n", 'array aref: got the right contents'); $AH->seek(0, 0); $line = <$AH>; is($line, "Hi there!\n", 'array readline: got the right first line'); #------------------------------ my $LH = IO::Lines->new; print $LH "Hi there!\n"; print $LH "Tres cool, no?\n"; is(join('', @{$LH->aref}), "Hi there!\nTres cool, no?\n", 'lines aref: got the right content'); $LH->seek(0, 0); $line = <$LH>; is($line, "Hi there!\n", 'lines readline: got the right first line'); Makefile.PL100644000000000000 355713610227567 16071 0ustar00unknownunknown000000000000IO-Stringy-2.113# This Makefile.PL for IO-Stringy was generated by # Dist::Zilla::Plugin::MakeMaker::Awesome 0.48. # Don't edit it but the dist.ini and plugins used to construct it. use strict; use warnings; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "I/O on in-core objects like strings and arrays", "AUTHOR" => "Erik Dorfman ", "BUILD_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "IO-Stringy", "LICENSE" => "perl", "NAME" => "IO::Stringy", "PREREQ_PM" => { "Carp" => 0, "Exporter" => "5.57", "File::Spec" => 0, "FileHandle" => 0, "IO::File" => 0, "IO::Handle" => 0, "Symbol" => 0, "overload" => 0, "parent" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Basename" => 0, "File::Spec" => 0, "File::Temp" => 0, "FileHandle" => 0, "IO::File" => 0, "IO::Handle" => 0, "Symbol" => 0, "Test::More" => "0.88", "Test::Tester" => 0, "strict" => 0, "warnings" => 0 }, "VERSION" => "2.113", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Exporter" => "5.57", "ExtUtils::MakeMaker" => 0, "File::Basename" => 0, "File::Spec" => 0, "File::Temp" => 0, "FileHandle" => 0, "IO::File" => 0, "IO::Handle" => 0, "Symbol" => 0, "Test::More" => "0.88", "Test::Tester" => 0, "overload" => 0, "parent" => 0, "strict" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION('6.63_03') } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); IO_Lines.t100644000000000000 746713610227567 16214 0ustar00unknownunknown000000000000IO-Stringy-2.113/tuse strict; use warnings; use IO::Lines; use Symbol qw(geniosym); # tied file handle NON-BAREWORD use Test::More; plan tests => 33; my @orig = ( "A diner while dining at Crewe\n", "Found a rather large mouse in his stew\n", " Said the waiter, \"Don't shout,\n", " And wave it about..." ); my $io = IO::Lines->new(\@orig); ok($io, "open: open a scalar on a ref to an array"); # append with print { my $error; { # catch block local $@; $error = $@ || 'Error' unless eval { # try block $io->print("\nor the rest"); $io->print(" will be wanting one ", "too.\"\n"); 1 }; } is($error, undef, 'print: able to print to the handle'); } # getc { my @c_str; $io->seek(0,0); for my $i (0..2) { $c_str[$i] = $io->getc; } is($c_str[0], 'A', 'seek/getc: got A'); is($c_str[1], ' ', 'seek/getc: got space'); is($c_str[2], 'd', 'seek/getc: got d'); } # getline { my $str; $io->seek(3,0); $str = $io->getline; is($str, "iner while dining at Crewe\n", 'getline: got the line'); $str = undef; $str = $io->getline; is($str, "Found a rather large mouse in his stew\n", 'getline: get subsequent line'); $str = undef; # we know we're trying to grab too many lines for (0..5) { $str = $io->getline; } is($str, undef, 'getline: repeat past end of stream'); } # getlines { my @data; $io->seek(0,0); @data = $io->getlines; is(join('', @data), join('', @orig), 'getlines: got our original input!'); } # read { my $buff; $io->seek(0, 0); $io->read($buff, 10); is($buff, 'A diner wh', 'read: read(10) got correct value'); $buff = undef; $io->read($buff, 10); is($buff, 'ile dining', 'read: read(10) again got correct value'); is($io->tell, 20, 'tell: got correct current position'); $buff = undef; $io->seek(0, 0); $io->read($buff, 1000); is($buff, join('', @orig), 'read(1000): got full slurped value'); } # seek { my $buff; $io->seek(2, 0); $io->read($buff, 5); is($buff, 'diner', 'seek(2,0) - read: got correct value'); $buff = undef; $io->seek(-6, 2); $io->read($buff, 3); is($buff, 'too', 'seek(-6,2) - read(): got correct value'); $buff = undef; $io->seek(-7, 1); $io->read($buff, 7); is($buff, 'one too', 'seek(-7,1) - read(): got correct value'); } # tie { my $th = geniosym; tie(*{$th}, 'IO::Lines', []); ok($th, 'tie: got tied handle'); print {$th} @orig; tied(*{$th})->seek(0, 0); my @lines; while (my $line = <$th>) { push @lines, $line; } is(join('', @lines), join('', @orig), 'tied seek readline: got correct value'); @lines = (); tied(*{$th})->seek(0, 0); @lines = <$th>; is(join('', @lines), join('', @orig), 'tied seek readlines: got correct value'); } # record seps { my @lines = ( "par 1, line 1\n", "par 1, line 2\n", "\n", "\n", "\n", "\n", "par 2, line 1\n", "\n", "par 3, line 1\n", "par 3, line 2\n", "par 3, line 3", ); my $all = [@lines]; # Slurp everything { my $ios = IO::Lines->new($all); local $/ = undef; is($ios->getline, join('', @lines), "recordsep: undef - getline"); } # Read a little, slurp the rest { my $ios = IO::Lines->new($all); is($ios->getline, $lines[0], "recordsep: undef - get first line"); local $/ = undef; is($ios->getline, join('', @lines[1..$#lines]), "recordsep: undef - slurp the rest"); } # Read line by line { my $ios = IO::Lines->new($all); local $/ = "\n"; for my $i (0..10) { is($ios->getline, $lines[$i], "recordsep: newline - rec $i"); } } } IO_Scalar.t100644000000000000 1051413610227567 16352 0ustar00unknownunknown000000000000IO-Stringy-2.113/tuse strict; use warnings; use IO::Scalar; use Symbol qw(geniosym); # tied file handle NON-BAREWORD use Test::More; plan tests => 39; # Some data my @orig = ( "A diner while dining at Crewe\n", "Found a rather large mouse in his stew\n", " Said the waiter, \"Don't shout,\n", " And wave it about..." ); my @extra = ( "\nor the rest", " will be wanting one ", "too.\"\n", ); my $s = join('', @orig); my $whole = $s . join('', @extra); # start testing my $io = IO::Scalar->new(\$s); ok($io, "open: open a scalar on a ref to a string"); is($io->fileno(), undef, "fileno() returns undef"); # test print { ok($io->print($extra[0]), "print: able to print"); ok($io->print(@extra[1,2]), "print: able to print again"); # is("$io", $whole, "Whole string matches"); } # getc { my @c_str; $io->seek(0,0); for my $i (0..2) { $c_str[$i] = $io->getc; } is($c_str[0], 'A', 'seek/getc: got A'); is($c_str[1], ' ', 'seek/getc: got space'); is($c_str[2], 'd', 'seek/getc: got d'); } # getline { my $str; $io->seek(3,0); $str = $io->getline; is($str, "iner while dining at Crewe\n", 'getline: got the line'); $str = undef; $str = $io->getline; is($str, "Found a rather large mouse in his stew\n", 'getline: get subsequent line'); $str = undef; # we know we're trying to grab too many lines for (0..5) { $str = $io->getline; } is($str, undef, 'getline: repeat past end of stream'); } # read { my $buff; $io->seek(0, 0); $io->read($buff, 10); is($buff, 'A diner wh', 'read: read(10) got correct value'); $buff = undef; $io->read($buff, 10); is($buff, 'ile dining', 'read: read(10) again got correct value'); is($io->tell, 20, 'tell: got correct current position'); $buff = undef; $io->seek(0, 0); $io->read($buff, 1000); is($buff, $whole, 'read(1000): got full slurped value'); } # seek { my $buff; $io->seek(2, 0); $io->read($buff, 5); is($buff, 'diner', 'seek(2,0) - read: got correct value'); $buff = undef; $io->seek(-6, 2); $io->read($buff, 3); is($buff, 'too', 'seek(-6,2) - read(): got correct value'); $buff = undef; $io->seek(-7, 1); $io->read($buff, 7); is($buff, 'one too', 'seek(-7,1) - read(): got correct value'); } # tie { my $th = geniosym; tie(*{$th}, 'IO::Scalar'); ok($th, 'tie: got tied handle'); print {$th} @orig; tied(*{$th})->seek(0, 0); my @lines; while (my $line = <$th>) { push @lines, $line; } is(join('', @lines), join('', @orig), 'tied seek readline: got correct value'); @lines = (); tied(*{$th})->seek(0, 0); @lines = <$th>; is(join('', @lines), join('', @orig), 'tied seek readlines: got correct value'); } # record seps { my @lines = ( "par 1, line 1\n", "par 1, line 2\n", "\n", "\n", "\n", "\n", "par 2, line 1\n", "\n", "par 3, line 1\n", "par 3, line 2\n", "par 3, line 3", ); my $all = join('', @lines); # Slurp everything { my $ios = IO::Scalar->new(\$all); local $/ = undef; is($ios->getline, $all, "recordsep: undef - getline"); } # Read a little, slurp the rest { my $ios = IO::Scalar->new(\$all); is($ios->getline, $lines[0], "recordsep: undef - get first line"); local $/ = undef; is($ios->getline, join('', @lines[1..$#lines]), "recordsep: undef - slurp the rest"); } # Read paragraph by paragraph { my $ios = IO::Scalar->new(\$all); local $/ = ""; is($ios->getline, join('', @lines[0..2]), "recordsep: empty - first par"); is($ios->getline, join('', @lines[6..7]), "recordsep: empty - second par"); is($ios->getline, join('', @lines[8..10]), "recordsep empty - third par"); } # Read record by record { my $ios = IO::Scalar->new(\$all); local $/ = "1,"; is($ios->getline, "par 1,", "recordsep: custom - first rec"); is($ios->getline, " line 1\npar 1,", "recordsep: custom - second rec"); } # Read line by line { my $ios = IO::Scalar->new(\$all); local $/ = "\n"; for my $i (0..10) { is($ios->getline, $lines[$i], "recordsep: newline - rec $i"); } } } IO000755000000000000 013610227567 15022 5ustar00unknownunknown000000000000IO-Stringy-2.113/libWrap.pm100644000000000000 2112513610227567 16452 0ustar00unknownunknown000000000000IO-Stringy-2.113/lib/IOpackage IO::Wrap; use strict; use Exporter; use FileHandle; use Carp; our $VERSION = '2.113'; our @ISA = qw(Exporter); our @EXPORT = qw(wraphandle); #------------------------------ # wraphandle RAW #------------------------------ sub wraphandle { my $raw = shift; new IO::Wrap $raw; } #------------------------------ # new STREAM #------------------------------ sub new { my ($class, $stream) = @_; no strict 'refs'; ### Convert raw scalar to globref: ref($stream) or $stream = \*$stream; ### Wrap globref and incomplete objects: if ((ref($stream) eq 'GLOB') or ### globref (ref($stream) eq 'FileHandle') && !defined(&FileHandle::read)) { return bless \$stream, $class; } $stream; ### already okay! } #------------------------------ # I/O methods... #------------------------------ sub close { my $self = shift; return close($$self); } sub fileno { my $self = shift; my $fh = $$self; return fileno($fh); } sub getline { my $self = shift; my $fh = $$self; return scalar(<$fh>); } sub getlines { my $self = shift; wantarray or croak("Can't call getlines in scalar context!"); my $fh = $$self; <$fh>; } sub print { my $self = shift; print { $$self } @_; } sub read { my $self = shift; return read($$self, $_[0], $_[1]); } sub seek { my $self = shift; return seek($$self, $_[0], $_[1]); } sub tell { my $self = shift; return tell($$self); } 1; __END__ =head1 NAME IO::Wrap - Wrap raw filehandles in the IO::Handle interface =head1 SYNOPSIS use strict; use warnings; use IO::Wrap; # this is a fairly senseless use case as IO::Handle already does this. my $wrap_fh = IO::Wrap->new(\*STDIN); my $line = $wrap_fh->getline(); # Do stuff with any kind of filehandle (including a bare globref), or # any kind of blessed object that responds to a print() message. # already have a globref? a FileHandle? a scalar filehandle name? $wrap_fh = IO::Wrap->new($some_unknown_thing); # At this point, we know we have an IO::Handle-like object! YAY $wrap_fh->print("Hey there!"); You can also do this using a convenience wrapper function use strict; use warnings; use IO::Wrap qw(wraphandle); # this is a fairly senseless use case as IO::Handle already does this. my $wrap_fh = wraphandle(\*STDIN); my $line = $wrap_fh->getline(); # Do stuff with any kind of filehandle (including a bare globref), or # any kind of blessed object that responds to a print() message. # already have a globref? a FileHandle? a scalar filehandle name? $wrap_fh = wraphandle($some_unknown_thing); # At this point, we know we have an IO::Handle-like object! YAY $wrap_fh->print("Hey there!"); =head1 DESCRIPTION Let's say you want to write some code which does I/O, but you don't want to force the caller to provide you with a L or L object. You want them to be able to say: do_stuff(\*STDOUT); do_stuff('STDERR'); do_stuff($some_FileHandle_object); do_stuff($some_IO_Handle_object); And even: do_stuff($any_object_with_a_print_method); Sure, one way to do it is to force the caller to use C. But that puts the burden on them. Another way to do it is to use B. Clearly, when wrapping a raw external filehandle (like C<\*STDOUT>), I didn't want to close the file descriptor when the wrapper object is destroyed; the user might not appreciate that! Hence, there's no C method in this class. When wrapping a L object, however, I believe that Perl will invoke the C when the last reference goes away, so in that case, the filehandle is closed if the wrapped L really was the last reference to it. =head1 FUNCTIONS L makes the following functions available. =head2 wraphandle # wrap a filehandle glob my $fh = wraphandle(\*STDIN); # wrap a raw filehandle glob by name $fh = wraphandle('STDIN'); # wrap a handle in an object $fh = wraphandle('Class::HANDLE'); # wrap a blessed FileHandle object use FileHandle; my $fho = FileHandle->new("/tmp/foo.txt", "r"); $fh = wraphandle($fho); # wrap any other blessed object that shares IO::Handle's interface $fh = wraphandle($some_object); This function is simply a wrapper to the L constructor method. =head1 METHODS L implements the following methods. =head2 close $fh->close(); The C method will attempt to close the system file descriptor. For a more complete description, read L. =head2 fileno my $int = $fh->fileno(); The C method returns the file descriptor for the wrapped filehandle. See L for more information. =head2 getline my $data = $fh->getline(); The C method mimics the function by the same name in L. It's like calling C<< my $data = <$fh>; >> but only in scalar context. =head2 getlines my @data = $fh->getlines(); The C method mimics the function by the same name in L. It's like calling C<< my @data = <$fh>; >> but only in list context. Calling this method in scalar context will result in a croak. =head2 new # wrap a filehandle glob my $fh = IO::Wrap->new(\*STDIN); # wrap a raw filehandle glob by name $fh = IO::Wrap->new('STDIN'); # wrap a handle in an object $fh = IO::Wrap->new('Class::HANDLE'); # wrap a blessed FileHandle object use FileHandle; my $fho = FileHandle->new("/tmp/foo.txt", "r"); $fh = IO::Wrap->new($fho); # wrap any other blessed object that shares IO::Handle's interface $fh = IO::Wrap->new($some_object); The C constructor method takes in a single argument and decides to wrap it or not it based on what it seems to be. A raw scalar file handle name, like C<"STDOUT"> or C<"Class::HANDLE"> can be wrapped, returning an L object instance. A raw filehandle glob, like C<\*STDOUT> can also be wrapped, returning an L object instance. A blessed L object can also be wrapped. This is a special case where an L object instance will only be returned in the case that your L object doesn't support the C method. Also, any other kind of blessed object that conforms to the L interface can be passed in. In this case, you just get back that object. In other words, we only wrap it into an L object when what you've supplied doesn't already conform to the L interface. If you get back an L object, it will obey a basic subset of the C interface. It will do so with object B, not B. =head3 CAVEATS This module does not allow you to wrap filehandle names which are given as strings that lack the package they were opened in. That is, if a user opens FOO in package Foo, they must pass it to you either as C<\*FOO> or as C<"Foo::FOO">. However, C<"STDIN"> and friends will work just fine. =head2 print $fh->print("Some string"); $fh->print("more", " than one", " string"); The C method will attempt to print a string or list of strings to the filehandle. For a more complete description, read L. =head2 read my $buffer; # try to read 30 chars into the buffer starting at the # current cursor position. my $num_chars_read = $fh->read($buffer, 30); The L method attempts to read a number of characters, starting at the filehandle's current cursor position. It returns the number of characters actually read. See L for more information. =head2 seek use Fcntl qw(:seek); # import the SEEK_CUR, SEEK_SET, SEEK_END constants # seek to the position in bytes $fh->seek(0, SEEK_SET); # seek to the position in bytes from the current position $fh->seek(22, SEEK_CUR); # seek to the EOF plus bytes $fh->seek(0, SEEK_END); The C method will attempt to set the cursor to a given position in bytes for the wrapped file handle. See L for more information. =head2 tell my $bytes = $fh->tell(); The C method will attempt to return the current position of the cursor in bytes for the wrapped file handle. See L for more information. =head1 AUTHOR Eryq (F). President, ZeeGee Software Inc (F). =head1 CONTRIBUTORS Dianne Skoll (F). =head1 COPYRIGHT & LICENSE Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut IO_WrapTie.t100644000000000000 131613610227567 16500 0ustar00unknownunknown000000000000IO-Stringy-2.113/tuse strict; use warnings; use IO::Handle; use IO::Scalar; use IO::WrapTie; use Test::More tests => 5; my $hello = 'Hello, '; my $world = "world!\n"; #### test my $s = ''; my $SH = IO::WrapTie->new('IO::Scalar', \$s); isa_ok($SH, 'IO::WrapTie::Master', 'new: got the object'); #### test print {$SH} $hello, $world; is($s, "$hello$world", 'print {FH} ARGS: tied string is correct'); #### test $SH->print($hello, $world); is($s, "$hello$world$hello$world", 'FH->print(ARGS): tied string is correct'); #### test $SH->seek(0,0); #### test my @x = <$SH>; ok( (($x[0] eq "$hello$world") && ($x[1] eq "$hello$world") && !$x[2]), "array = " ); #### test my $sref = $SH->sref; ok($sref eq \$s, "FH->sref"); Lines.pm100644000000000000 1011213610227567 16605 0ustar00unknownunknown000000000000IO-Stringy-2.113/lib/IOpackage IO::Lines; use strict; use Carp; use IO::ScalarArray; # The package version, both in 1.23 style *and* usable by MakeMaker: our $VERSION = '2.113'; # Inheritance: our @ISA = qw(IO::ScalarArray); ### also gets us new_tie :-) =head1 NAME IO::Lines - IO:: interface for reading/writing an array of lines =head1 SYNOPSIS use IO::Lines; ### See IO::ScalarArray for details =head1 DESCRIPTION This class implements objects which behave just like FileHandle (or IO::Handle) objects, except that you may use them to write to (or read from) an array of lines. C capable as well. This is a subclass of L in which the underlying array has its data stored in a line-oriented-format: that is, every element ends in a C<"\n">, with the possible exception of the final element. This makes C I more efficient; if you plan to do line-oriented reading/printing, you want this class. The C method will enforce this rule, so you can print arbitrary data to the line-array: it will break the data at newlines appropriately. See L for full usage and warnings. =cut #------------------------------ # # getline # # Instance method, override. # Return the next line, or undef on end of data. # Can safely be called in an array context. # Currently, lines are delimited by "\n". # sub getline { my $self = shift; if (!defined $/) { return join( '', $self->_getlines_for_newlines ); } elsif ($/ eq "\n") { if (!*$self->{Pos}) { ### full line... return *$self->{AR}[*$self->{Str}++]; } else { ### partial line... my $partial = substr(*$self->{AR}[*$self->{Str}++], *$self->{Pos}); *$self->{Pos} = 0; return $partial; } } else { croak 'unsupported $/: must be "\n" or undef'; } } #------------------------------ # # getlines # # Instance method, override. # Return an array comprised of the remaining lines, or () on end of data. # Must be called in an array context. # Currently, lines are delimited by "\n". # sub getlines { my $self = shift; wantarray or croak("can't call getlines in scalar context!"); if ((defined $/) and ($/ eq "\n")) { return $self->_getlines_for_newlines(@_); } else { ### slow but steady return $self->SUPER::getlines(@_); } } #------------------------------ # # _getlines_for_newlines # # Instance method, private. # If $/ is newline, do fast getlines. # This CAN NOT invoke getline! # sub _getlines_for_newlines { my $self = shift; my ($rArray, $Str, $Pos) = @{*$self}{ qw( AR Str Pos ) }; my @partial = (); if ($Pos) { ### partial line... @partial = (substr( $rArray->[ $Str++ ], $Pos )); *$self->{Pos} = 0; } *$self->{Str} = scalar @$rArray; ### about to exhaust @$rArray return (@partial, @$rArray[ $Str .. $#$rArray ]); ### remaining full lines... } #------------------------------ # # print ARGS... # # Instance method, override. # Print ARGS to the underlying line array. # sub print { if (defined $\ && $\ ne "\n") { croak 'unsupported $\: must be "\n" or undef'; } my $self = shift; ### print STDERR "\n[[ARRAY WAS...\n", @{*$self->{AR}}, "<>\n"; my @lines = split /^/, join('', @_); @lines or return 1; ### Did the previous print not end with a newline? ### If so, append first line: if (@{*$self->{AR}} and (*$self->{AR}[-1] !~ /\n\Z/)) { *$self->{AR}[-1] .= shift @lines; } push @{*$self->{AR}}, @lines; ### add the remainder ### print STDERR "\n[[ARRAY IS NOW...\n", @{*$self->{AR}}, "<>\n"; 1; } #------------------------------ 1; __END__ =head1 VERSION $Id: Lines.pm,v 1.3 2005/02/10 21:21:53 dfs Exp $ =head1 AUTHOR Eryq (F). President, ZeeGee Software Inc (F). =head1 CONTRIBUTORS Dianne Skoll (F). =head1 COPYRIGHT & LICENSE Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Scalar.pm100644000000000000 3526413610227567 16757 0ustar00unknownunknown000000000000IO-Stringy-2.113/lib/IOpackage IO::Scalar; use strict; use Carp; use IO::Handle; ### Stringification, courtesy of B. K. Oxley (binkley): :-) use overload '""' => sub { ${*{$_[0]}->{SR}} }; use overload 'bool' => sub { 1 }; ### have to do this, so object is true! ### The package version, both in 1.23 style *and* usable by MakeMaker: our $VERSION = '2.113'; ### Inheritance: our @ISA = qw(IO::Handle); ### This stuff should be got rid of ASAP. require IO::WrapTie and push @ISA, 'IO::WrapTie::Slave' if ($] >= 5.004); #============================== =head1 NAME IO::Scalar - IO:: interface for reading/writing a scalar =head1 SYNOPSIS Perform I/O on strings, using the basic OO interface... use 5.005; use IO::Scalar; $data = "My message:\n"; ### Open a handle on a string, and append to it: $SH = new IO::Scalar \$data; $SH->print("Hello"); $SH->print(", world!\nBye now!\n"); print "The string is now: ", $data, "\n"; ### Open a handle on a string, read it line-by-line, then close it: $SH = new IO::Scalar \$data; while (defined($_ = $SH->getline)) { print "Got line: $_"; } $SH->close; ### Open a handle on a string, and slurp in all the lines: $SH = new IO::Scalar \$data; print "All lines:\n", $SH->getlines; ### Get the current position (either of two ways): $pos = $SH->getpos; $offset = $SH->tell; ### Set the current position (either of two ways): $SH->setpos($pos); $SH->seek($offset, 0); ### Open an anonymous temporary scalar: $SH = new IO::Scalar; $SH->print("Hi there!"); print "I printed: ", ${$SH->sref}, "\n"; ### get at value Don't like OO for your I/O? No problem. Thanks to the magic of an invisible tie(), the following now works out of the box, just as it does with IO::Handle: use 5.005; use IO::Scalar; $data = "My message:\n"; ### Open a handle on a string, and append to it: $SH = new IO::Scalar \$data; print $SH "Hello"; print $SH ", world!\nBye now!\n"; print "The string is now: ", $data, "\n"; ### Open a handle on a string, read it line-by-line, then close it: $SH = new IO::Scalar \$data; while (<$SH>) { print "Got line: $_"; } close $SH; ### Open a handle on a string, and slurp in all the lines: $SH = new IO::Scalar \$data; print "All lines:\n", <$SH>; ### Get the current position (WARNING: requires 5.6): $offset = tell $SH; ### Set the current position (WARNING: requires 5.6): seek $SH, $offset, 0; ### Open an anonymous temporary scalar: $SH = new IO::Scalar; print $SH "Hi there!"; print "I printed: ", ${$SH->sref}, "\n"; ### get at value And for you folks with 1.x code out there: the old tie() style still works, though this is I: use IO::Scalar; ### Writing to a scalar... my $s; tie *OUT, 'IO::Scalar', \$s; print OUT "line 1\nline 2\n", "line 3\n"; print "String is now: $s\n" ### Reading and writing an anonymous scalar... tie *OUT, 'IO::Scalar'; print OUT "line 1\nline 2\n", "line 3\n"; tied(OUT)->seek(0,0); while () { print "Got line: ", $_; } Stringification works, too! my $SH = new IO::Scalar \$data; print $SH "Hello, "; print $SH "world!"; print "I printed: $SH\n"; =head1 DESCRIPTION This class is part of the IO::Stringy distribution; see L for change log and general information. The IO::Scalar class implements objects which behave just like IO::Handle (or FileHandle) objects, except that you may use them to write to (or read from) scalars. These handles are automatically Cd (though please see L<"WARNINGS"> for information relevant to your Perl version). Basically, this: my $s; $SH = new IO::Scalar \$s; $SH->print("Hel", "lo, "); ### OO style $SH->print("world!\n"); ### ditto Or this: my $s; $SH = tie *OUT, 'IO::Scalar', \$s; print OUT "Hel", "lo, "; ### non-OO style print OUT "world!\n"; ### ditto Causes $s to be set to: "Hello, world!\n" =head1 PUBLIC INTERFACE =head2 Construction =over 4 =cut #------------------------------ =item new [ARGS...] I Return a new, unattached scalar handle. If any arguments are given, they're sent to open(). =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = bless \do { local *FH }, $class; tie *$self, $class, $self; $self->open(@_); ### open on anonymous by default $self; } sub DESTROY { shift->close; } #------------------------------ =item open [SCALARREF] I Open the scalar handle on a new scalar, pointed to by SCALARREF. If no SCALARREF is given, a "private" scalar is created to hold the file data. Returns the self object on success, undefined on error. =cut sub open { my ($self, $sref) = @_; ### Sanity: defined($sref) or do {my $s = ''; $sref = \$s}; (ref($sref) eq "SCALAR") or croak "open() needs a ref to a scalar"; ### Setup: *$self->{Pos} = 0; ### seek position *$self->{SR} = $sref; ### scalar reference $self; } #------------------------------ =item opened I Is the scalar handle opened on something? =cut sub opened { *{shift()}->{SR}; } #------------------------------ =item close I Disassociate the scalar handle from its underlying scalar. Done automatically on destroy. =cut sub close { my $self = shift; %{*$self} = (); 1; } =back =cut #============================== =head2 Input and output =over 4 =cut #------------------------------ =item flush I No-op, provided for OO compatibility. =cut sub flush { "0 but true" } #------------------------------ =item fileno I No-op, returns undef =cut sub fileno { } #------------------------------ =item getc I Return the next character, or undef if none remain. =cut sub getc { my $self = shift; ### Return undef right away if at EOF; else, move pos forward: return undef if $self->eof; substr(${*$self->{SR}}, *$self->{Pos}++, 1); } #------------------------------ =item getline I Return the next line, or undef on end of string. Can safely be called in an array context. Currently, lines are delimited by "\n". =cut sub getline { my $self = shift; ### Return undef right away if at EOF: return undef if $self->eof; ### Get next line: my $sr = *$self->{SR}; my $i = *$self->{Pos}; ### Start matching at this point. ### Minimal impact implementation! ### We do the fast thing (no regexps) if using the ### classic input record separator. ### Case 1: $/ is undef: slurp all... if (!defined($/)) { *$self->{Pos} = length $$sr; return substr($$sr, $i); } ### Case 2: $/ is "\n": zoom zoom zoom... elsif ($/ eq "\012") { ### Seek ahead for "\n"... yes, this really is faster than regexps. my $len = length($$sr); for (; $i < $len; ++$i) { last if ord (substr ($$sr, $i, 1)) == 10; } ### Extract the line: my $line; if ($i < $len) { ### We found a "\n": $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos} + 1); *$self->{Pos} = $i+1; ### Remember where we finished up. } else { ### No "\n"; slurp the remainder: $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos}); *$self->{Pos} = $len; } return $line; } ### Case 3: $/ is ref to int. Do fixed-size records. ### (Thanks to Dominique Quatravaux.) elsif (ref($/)) { my $len = length($$sr); my $i = ${$/} + 0; my $line = substr ($$sr, *$self->{Pos}, $i); *$self->{Pos} += $i; *$self->{Pos} = $len if (*$self->{Pos} > $len); return $line; } ### Case 4: $/ is either "" (paragraphs) or something weird... ### This is Graham's general-purpose stuff, which might be ### a tad slower than Case 2 for typical data, because ### of the regexps. else { pos($$sr) = $i; ### If in paragraph mode, skip leading lines (and update i!): length($/) or (($$sr =~ m/\G\n*/g) and ($i = pos($$sr))); ### If we see the separator in the buffer ahead... if (length($/) ? $$sr =~ m,\Q$/\E,g ### (ordinary sep) TBD: precomp! : $$sr =~ m,\n\n,g ### (a paragraph) ) { *$self->{Pos} = pos $$sr; return substr($$sr, $i, *$self->{Pos}-$i); } ### Else if no separator remains, just slurp the rest: else { *$self->{Pos} = length $$sr; return substr($$sr, $i); } } } #------------------------------ =item getlines I Get all remaining lines. It will croak() if accidentally called in a scalar context. =cut sub getlines { my $self = shift; wantarray or croak("can't call getlines in scalar context!"); my ($line, @lines); push @lines, $line while (defined($line = $self->getline)); @lines; } #------------------------------ =item print ARGS... I Print ARGS to the underlying scalar. B this continues to always cause a seek to the end of the string, but if you perform seek()s and tell()s, it is still safer to explicitly seek-to-end before subsequent print()s. =cut sub print { my $self = shift; *$self->{Pos} = length(${*$self->{SR}} .= join('', @_) . (defined($\) ? $\ : "")); 1; } sub _unsafe_print { my $self = shift; my $append = join('', @_) . $\; ${*$self->{SR}} .= $append; *$self->{Pos} += length($append); 1; } sub _old_print { my $self = shift; ${*$self->{SR}} .= join('', @_) . $\; *$self->{Pos} = length(${*$self->{SR}}); 1; } #------------------------------ =item read BUF, NBYTES, [OFFSET] I Read some bytes from the scalar. Returns the number of bytes actually read, 0 on end-of-file, undef on error. =cut sub read { my $self = $_[0]; my $n = $_[2]; my $off = $_[3] || 0; my $read = substr(${*$self->{SR}}, *$self->{Pos}, $n); $n = length($read); *$self->{Pos} += $n; ($off ? substr($_[1], $off) : $_[1]) = $read; return $n; } #------------------------------ =item write BUF, NBYTES, [OFFSET] I Write some bytes to the scalar. =cut sub write { my $self = $_[0]; my $n = $_[2]; my $off = $_[3] || 0; my $data = substr($_[1], $off, $n); $n = length($data); $self->print($data); return $n; } #------------------------------ =item sysread BUF, LEN, [OFFSET] I Read some bytes from the scalar. Returns the number of bytes actually read, 0 on end-of-file, undef on error. =cut sub sysread { my $self = shift; $self->read(@_); } #------------------------------ =item syswrite BUF, NBYTES, [OFFSET] I Write some bytes to the scalar. =cut sub syswrite { my $self = shift; $self->write(@_); } =back =cut #============================== =head2 Seeking/telling and other attributes =over 4 =cut #------------------------------ =item autoflush I No-op, provided for OO compatibility. =cut sub autoflush {} #------------------------------ =item binmode I No-op, provided for OO compatibility. =cut sub binmode {} #------------------------------ =item clearerr I Clear the error and EOF flags. A no-op. =cut sub clearerr { 1 } #------------------------------ =item eof I Are we at end of file? =cut sub eof { my $self = shift; (*$self->{Pos} >= length(${*$self->{SR}})); } #------------------------------ =item seek OFFSET, WHENCE I Seek to a given position in the stream. =cut sub seek { my ($self, $pos, $whence) = @_; my $eofpos = length(${*$self->{SR}}); ### Seek: if ($whence == 0) { *$self->{Pos} = $pos } ### SEEK_SET elsif ($whence == 1) { *$self->{Pos} += $pos } ### SEEK_CUR elsif ($whence == 2) { *$self->{Pos} = $eofpos + $pos} ### SEEK_END else { croak "bad seek whence ($whence)" } ### Fixup: if (*$self->{Pos} < 0) { *$self->{Pos} = 0 } if (*$self->{Pos} > $eofpos) { *$self->{Pos} = $eofpos } return 1; } #------------------------------ =item sysseek OFFSET, WHENCE I Identical to C, I =cut sub sysseek { my $self = shift; $self->seek (@_); } #------------------------------ =item tell I Return the current position in the stream, as a numeric offset. =cut sub tell { *{shift()}->{Pos} } #------------------------------ # # use_RS [YESNO] # # I # Obey the current setting of $/, like IO::Handle does? # Default is false in 1.x, but cold-welded true in 2.x and later. # sub use_RS { my ($self, $yesno) = @_; carp "use_RS is deprecated and ignored; \$/ is always consulted\n"; } #------------------------------ =item setpos POS I Set the current position, using the opaque value returned by C. =cut sub setpos { shift->seek($_[0],0) } #------------------------------ =item getpos I Return the current position in the string, as an opaque object. =cut *getpos = \&tell; #------------------------------ =item sref I Return a reference to the underlying scalar. =cut sub sref { *{shift()}->{SR} } #------------------------------ # Tied handle methods... #------------------------------ # Conventional tiehandle interface: sub TIEHANDLE { ((defined($_[1]) && UNIVERSAL::isa($_[1], "IO::Scalar")) ? $_[1] : shift->new(@_)); } sub GETC { shift->getc(@_) } sub PRINT { shift->print(@_) } sub PRINTF { shift->print(sprintf(shift, @_)) } sub READ { shift->read(@_) } sub READLINE { wantarray ? shift->getlines(@_) : shift->getline(@_) } sub WRITE { shift->write(@_); } sub CLOSE { shift->close(@_); } sub SEEK { shift->seek(@_); } sub TELL { shift->tell(@_); } sub EOF { shift->eof(@_); } sub BINMODE { 1; } #------------------------------------------------------------ 1; __END__ =back =cut =head1 AUTHOR Eryq (F). President, ZeeGee Software Inc (F). =head1 CONTRIBUTORS Dianne Skoll (F). =head1 COPYRIGHT & LICENSE Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut IO_InnerFile.t100644000000000000 354413610227567 17005 0ustar00unknownunknown000000000000IO-Stringy-2.113/tuse strict; use warnings; use File::Spec (); use File::Temp qw(tempfile); use IO::InnerFile; use IO::File; use Test::More; sub temp_file_path { # older EUMMs turn this on. We don't want to emit warnings. local $^W; my $file; (undef, $file) = tempfile('tempXXXXX', DIR => File::Spec->tmpdir, OPEN => 0); return $file; } plan tests => 7; # Create a test file my $temp_file = temp_file_path(); open(my $ofh, '>', $temp_file) || die("Cannot write $temp_file: $!"); binmode $ofh; my $data = "Here is some dummy content.\n"; $data .= "Here is some more dummy content\n"; $data .= "Here is yet more dummy content.\n"; $data .= "And finally another line.\n"; print {$ofh} $data; close($ofh); # Open it as a regular file handle my $fh = IO::File->new("<$temp_file"); my $inner = IO::InnerFile->new($fh, 28, 64); # Second and third lines my $line; $line = <$inner>; is($line, "Here is some more dummy content\n", "readline: got the right second line"); $line = <$inner>; is($line, "Here is yet more dummy content.\n", "readline: got the right third line"); $line = <$inner>; is($line, undef, "readline: undef reached when past our definition"); $inner->close(); $inner = IO::InnerFile->new($fh, 28, 64); # Second and third lines # Test list context (CPAN ticket #66186) my @arr; @arr = <$inner>; is(scalar(@arr), 2, 'readline: list context: got the right number'); is($arr[0], "Here is some more dummy content\n", 'readline: list context: got the right second line'); is($arr[1], "Here is yet more dummy content.\n", 'readline: list context: got the right third line'); # Make sure slurp mode works as expected $inner->seek(0, 0); { local $/; my $contents = <$inner>; is($contents, "Here is some more dummy content\nHere is yet more dummy content.\n", 'readline: slurpy: got full contents'); } # So we know everything went well... unlink($temp_file); contrib000755000000000000 013610227567 15405 5ustar00unknownunknown000000000000IO-Stringy-2.113Clever.pm100644000000000000 144213610227567 17324 0ustar00unknownunknown000000000000IO-Stringy-2.113/contribpackage IO::Clever; require 5.005_03; use strict; use vars qw($VERSION @ISA); @ISA = qw(IO::String); $VERSION = "1.01"; # ChangeLog: # 1999-07-21-02:06:47 Uri Guttman told me a critical fix: # $fp->input_record_separator is _Global_; local($/) is safer my(%params); sub new { my $class = shift; return IO::File->new(@_) unless $_[0] =~ /^>/; my $self = bless IO::String->new(), ref($class) || $class; $params{$self} = [ @_ ]; $self; } sub DESTROY { my($self) = @_; my $filename = $params{$self}->[0]; return unless $filename =~ s/^>//; my($new) = ${$self->string_ref}; if (-f $filename) { my $fp = IO::File->new("<$filename") || die "$0: $filename: $!\n"; local ($/); return if $new eq $fp->getline; } IO::File->new(@{$params{$self}})->print($new); delete $params{$self}; } 1; Stringy.pm100644000000000000 343513610227567 17164 0ustar00unknownunknown000000000000IO-Stringy-2.113/lib/IOpackage IO::Stringy; use strict; use Exporter; our $VERSION = '2.113'; 1; __END__ =head1 NAME IO-stringy - I/O on in-core objects like strings and arrays =head1 SYNOPSIS use strict; use warnings; use IO::AtomicFile; # Write a file which is updated atomically use IO::InnerFile; # define a file inside another file use IO::Lines; # I/O handle to read/write to array of lines use IO::Scalar; # I/O handle to read/write to a string use IO::ScalarArray; # I/O handle to read/write to array of scalars use IO::Wrap; # Wrap old-style FHs in standard OO interface use IO::WrapTie; # Tie your handles & retain full OO interface # ... =head1 DESCRIPTION This toolkit primarily provides modules for performing both traditional and object-oriented i/o) on things I than normal filehandles; in particular, L, L, and L. In the more-traditional IO::Handle front, we have L which may be used to painlessly create files which are updated atomically. And in the "this-may-prove-useful" corner, we have L, whose exported wraphandle() function will clothe anything that's not a blessed object in an IO::Handle-like wrapper... so you can just use OO syntax and stop worrying about whether your function's caller handed you a string, a globref, or a FileHandle. =head1 AUTHOR Eryq (F). President, ZeeGee Software Inc (F). =head1 CONTRIBUTORS Dianne Skoll (F). =head1 COPYRIGHT & LICENSE Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut WrapTie.pm100644000000000000 3457413610227567 17130 0ustar00unknownunknown000000000000IO-Stringy-2.113/lib/IOpackage IO::WrapTie; use strict; use Exporter; # Inheritance, exporting, and package version: our @ISA = qw(Exporter); our @EXPORT = qw(wraptie); our $VERSION = '2.113'; # Function, exported. sub wraptie { IO::WrapTie::Master->new(@_); } # Class method; BACKWARDS-COMPATIBILITY ONLY! sub new { shift; IO::WrapTie::Master->new(@_); } #------------------------------------------------------------ package # hide from pause IO::WrapTie::Master; #------------------------------------------------------------ use strict; use vars qw($AUTOLOAD); use IO::Handle; # We inherit from IO::Handle to get methods which invoke i/o operators, # like print(), on our tied handle: our @ISA = qw(IO::Handle); #------------------------------ # new SLAVE, TIEARGS... #------------------------------ # Create a new subclass of IO::Handle which... # # (1) Handles i/o OPERATORS because it is tied to an instance of # an i/o-like class, like IO::Scalar. # # (2) Handles i/o METHODS by delegating them to that same tied object!. # # Arguments are the slave class (e.g., IO::Scalar), followed by all # the arguments normally sent into that class's C method. # In other words, much like the arguments to tie(). :-) # # NOTE: # The thing $x we return must be a BLESSED REF, for ($x->print()). # The underlying symbol must be a FILEHANDLE, for (print $x "foo"). # It has to have a way of getting to the "real" back-end object... # sub new { my $master = shift; my $io = IO::Handle->new; ### create a new handle my $slave = shift; tie *$io, $slave, @_; ### tie: will invoke slave's TIEHANDLE bless $io, $master; ### return a master } #------------------------------ # AUTOLOAD #------------------------------ # Delegate method invocations on the master to the underlying slave. # sub AUTOLOAD { my $method = $AUTOLOAD; $method =~ s/.*:://; my $self = shift; tied(*$self)->$method(\@_); } #------------------------------ # PRELOAD #------------------------------ # Utility. # # Most methods like print(), getline(), etc. which work on the tied object # via Perl's i/o operators (like 'print') are inherited from IO::Handle. # # Other methods, like seek() and sref(), we must delegate ourselves. # AUTOLOAD takes care of these. # # However, it may be necessary to preload delegators into your # own class. PRELOAD will do this. # sub PRELOAD { my $class = shift; foreach (@_) { eval "sub ${class}::$_ { my \$s = shift; tied(*\$s)->$_(\@_) }"; } } # Preload delegators for some standard methods which we can't simply # inherit from IO::Handle... for example, some IO::Handle methods # assume that there is an underlying file descriptor. # PRELOAD IO::WrapTie::Master qw(open opened close read clearerr eof seek tell setpos getpos); #------------------------------------------------------------ package # hide from pause IO::WrapTie::Slave; #------------------------------------------------------------ # Teeny private class providing a new_tie constructor... # # HOW IT ALL WORKS: # # Slaves inherit from this class. # # When you send a new_tie() message to a tie-slave class (like IO::Scalar), # it first determines what class should provide its master, via TIE_MASTER. # In this case, IO::Scalar->TIE_MASTER would return IO::Scalar::Master. # Then, we create a new master (an IO::Scalar::Master) with the same args # sent to new_tie. # # In general, the new() method of the master is inherited directly # from IO::WrapTie::Master. # sub new_tie { my $self = shift; $self->TIE_MASTER->new($self,@_); ### e.g., IO::Scalar::Master->new(@_) } # Default class method for new_tie(). # All your tie-slave class (like IO::Scalar) has to do is override this # method with a method that returns the name of an appropriate "master" # class for tying that slave. # sub TIE_MASTER { 'IO::WrapTie::Master' } #------------------------------ 1; __END__ package IO::WrapTie; ### for doc generator =head1 NAME IO::WrapTie - wrap tieable objects in IO::Handle interface I =head1 SYNOPSIS First of all, you'll need tie(), so: require 5.004; I Use this with any existing class... use IO::WrapTie; use FooHandle; ### implements TIEHANDLE interface ### Suppose we want a "FooHandle->new(&FOO_RDWR, 2)". ### We can instead say... $FH = wraptie('FooHandle', &FOO_RDWR, 2); ### Now we can use... print $FH "Hello, "; ### traditional operator syntax... $FH->print("world!\n"); ### ...and OO syntax as well! I You can inherit from the L mixin to get a nifty C constructor... #------------------------------ package FooHandle; ### a class which can TIEHANDLE use IO::WrapTie; @ISA = qw(IO::WrapTie::Slave); ### inherit new_tie() ... #------------------------------ package main; $FH = FooHandle->new_tie(&FOO_RDWR, 2); ### $FH is an IO::WrapTie::Master print $FH "Hello, "; ### traditional operator syntax $FH->print("world!\n"); ### OO syntax See IO::Scalar as an example. It also shows you how to create classes which work both with and without 5.004. =head1 DESCRIPTION Suppose you have a class C, where... =over 4 =item * C does not inherit from L. That is, it performs file handle-like I/O, but to something other than an underlying file descriptor. Good examples are L (for printing to a string) and L (for printing to an array of lines). =item * C implements the C interface (see L). That is, it provides methods C, C, C, C, C, and C. =item * C implements the traditional OO interface of L and L. i.e., it contains methods like C, C, C, C, C, C, etc. =back Normally, users of your class would have two options: =over 4 =item * B and forsake named I/O operators like C. =item * B and forsake treating it as a first-class object (i.e., class-specific methods can only be invoked through the underlying object via C... giving the object a "split personality"). =back But now with L, you can say: $WT = wraptie('FooHandle', &FOO_RDWR, 2); $WT->print("Hello, world\n"); ### OO syntax print $WT "Yes!\n"; ### Named operator syntax too! $WT->weird_stuff; ### Other methods! And if you're authoring a class like C, just have it inherit from C and that first line becomes even prettier: $WT = FooHandle->new_tie(&FOO_RDWR, 2); B now, almost any class can look and work exactly like an L and be used both with OO and non-OO file handle syntax. =head1 HOW IT ALL WORKS =head2 The data structures Consider this example code, using classes in this distribution: use IO::Scalar; use IO::WrapTie; $WT = wraptie('IO::Scalar',\$s); print $WT "Hello, "; $WT->print("world!\n"); In it, the C function creates a data structure as follows: * $WT is a blessed reference to a tied filehandle $WT glob; that glob is tied to the "Slave" object. | * You would do all your i/o with $WT directly. | | | ,---isa--> IO::WrapTie::Master >--isa--> IO::Handle V / .-------------. | | | | * Perl i/o operators work on the tied object, | "Master" | invoking the C methods. | | * Method invocations are delegated to the tied | | slave. `-------------' | tied(*$WT) | .---isa--> IO::WrapTie::Slave V / .-------------. | | | "Slave" | * Instance of FileHandle-like class which doesn't | | actually use file descriptors, like IO::Scalar. | IO::Scalar | * The slave can be any kind of object. | | * Must implement the C interface. `-------------' I just as an L is really just a blessed reference to a I file handle glob. So also, an C is really just a blessed reference to a file handle glob I =head2 How C works =over 4 =item 1. The call to function C is passed onto C. Note that class C is a subclass of L. =item 2. The C<< IO::WrapTie::Master->new >> method creates a new L object, re-blessed into class C. This object is the I, which will be returned from the constructor. At the same time... =item 3. The C method also creates the I: this is an instance of C which is created by tying the master's L to C via C. This call to C creates the slave in the following manner: =item 4. Class C is sent the message C; it will usually delegate this to C<< SLAVECLASS->new(TIEARGS) >>, resulting in a new instance of C being created and returned. =item 5. Once both master and slave have been created, the master is returned to the caller. =back =head2 How I/O operators work (on the master) Consider using an i/o operator on the master: print $WT "Hello, world!\n"; Since the master C<$WT> is really a C reference to a glob, the normal Perl I/O operators like C may be used on it. They will just operate on the symbol part of the glob. Since the glob is tied to the slave, the slave's C method (part of the C interface) will be automatically invoked. If the slave is an L, that means L will be invoked, and that method happens to delegate to the C method of the same class. So the I work is ultimately done by L. =head2 How methods work (on the master) Consider using a method on the master: $WT->print("Hello, world!\n"); Since the master C<$WT> is blessed into the class C, Perl first attempts to find a C method there. Failing that, Perl next attempts to find a C method in the super class, L. It just so happens that there I such a method; that method merely invokes the C I/O operator on the self object... and for that, see above! But let's suppose we're dealing with a method which I part of L... for example: my $sref = $WT->sref; In this case, the intuitive behavior is to have the master delegate the method invocation to the slave (now do you see where the designations come from?). This is indeed what happens: C contains an C method which performs the delegation. So: when C can't be found in L, the C method of C is invoked, and the standard behavior of delegating the method to the underlying slave (here, an L) is done. Sometimes, to get this to work properly, you may need to create a subclass of C which is an effective master for I class, and do the delegation there. =head1 NOTES B Because that means forsaking the use of named operators like C, and you may need to pass the object to a subroutine which will attempt to use those operators: $O = FooHandle->new(&FOO_RDWR, 2); $O->print("Hello, world\n"); ### OO syntax is okay, BUT.... sub nope { print $_[0] "Nope!\n" } X nope($O); ### ERROR!!! (not a glob ref) B Because (1) you have to use C to invoke methods in the object's public interface (yuck), and (2) you may need to pass the tied symbol to another subroutine which will attempt to treat it in an OO-way... and that will break it: tie *T, 'FooHandle', &FOO_RDWR, 2; print T "Hello, world\n"; ### Operator is okay, BUT... tied(*T)->other_stuff; ### yuck! AND... sub nope { shift->print("Nope!\n") } X nope(\*T); ### ERROR!!! (method "print" on unblessed ref) B Why not simply write C to inherit from L I tried this, with an implementation similar to that of L. The problem is that I. Subclassing L will work fine for the OO stuff, and fine with named operators I you C... but if you just attempt to say: $IO = FooHandle->new(&FOO_RDWR, 2); print $IO "Hello!\n"; you get a warning from Perl like: Filehandle GEN001 never opened because it's trying to do system-level I/O on an (unopened) file descriptor. To avoid this, you apparently have to C the handle... which brings us right back to where we started! At least the L mixin lets us say: $IO = FooHandle->new_tie(&FOO_RDWR, 2); print $IO "Hello!\n"; and so is not I bad. C<:-)> =head1 WARNINGS Remember: this stuff is for doing L-like I/O on things I. If you have an underlying file descriptor, you're better off just inheriting from L. B it does B return an instance of the I/O class you're tying to! Invoking some methods on the master object causes C to delegate them to the slave object... so it I like you're manipulating a C object directly, but you're not. I have not explored all the ramifications of this use of C. I. =head1 AUTHOR Eryq (F). President, ZeeGee Software Inc (F). =head1 CONTRIBUTORS Dianne Skoll (F). =head1 COPYRIGHT & LICENSE Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut IO_ScalarArray.t100644000000000000 740113610227567 17332 0ustar00unknownunknown000000000000IO-Stringy-2.113/tuse strict; use warnings; use IO::ScalarArray; use Symbol qw(geniosym); # tied file handle NON-BAREWORD use Test::More; plan tests => 33; my @orig = ( "A diner while dining at Crewe\n", "Found a rather large mouse in his stew\n", " Said the waiter, \"Don't shout,\n", " And wave it about..." ); my @extra = ( "\nor the rest", " will be wanting one ", "too.\"\n", ); my $s = join('', @orig); my $whole = $s . join('', @extra); my $io = IO::ScalarArray->new(\@orig); ok($io, "open: open a scalar on a ref to an array"); is($io->fileno(), undef, 'fileno() returns undef'); # print { ok($io->print($extra[0]), 'print: Able to print to handle'); ok($io->print(@extra[1..2]), 'print, Able to print to handle'); } # getc { my $buffer = ''; $io->seek(0, 0); for (0..2) { $buffer .= $io->getc }; is($buffer, 'A d', 'SAH: seek(0, 0) and getc() to buffer'); } # getline { my $last; $io->seek(3, 0); is($io->getline, "iner while dining at Crewe\n", 'getline/seek: got part of 1st line'); is($io->getline, "Found a rather large mouse in his stew\n", 'getline/next: next getline gets subsequent line'); for (1..6) { $last = $io->getline } ok(!$last, 'getline/eof: repeated getline() finds end of stream'); $io->seek(0, 0); my @got = $io->getlines; is(join('', @got), $whole, "getline/getlines: seek(0,0) and getlines slurps in string"); } # read { my $buffer = ''; $io->seek(0, 0); $io->read($buffer, 10); is($buffer, "A diner wh", "read/first10: reading first 10 bytes with seek(0,START) + read(10)"); $io->read($buffer, 10); is($buffer, "ile dining", "read/next10: reading next 10 bytes with read(10)"); is($io->tell, 20, 'read/tell20: tell() the current location as 20'); $io->seek(0,0); $io->read($buffer,1000); is($buffer, $whole, 'read/slurp: seek(0,start)+read(1000) reads in whole handle'); } # seek { my $buffer = ''; $io->seek(2, 0); $io->read($buffer, 5); is($buffer, 'diner', 'seek/set: seek(2, set) + read(5) returns "diner"'); $io->seek(-6,2); $io->read($buffer,3); is($buffer, 'too', 'seek/end: seek(-6,end)+read(3) returns "too"'); $io->seek(-7,1); $io->read($buffer,7); is($buffer, 'one too', "SEEK/CUR: seek(-7,CUR) + read(7) returns 'one too'"); } # tie { my $th = geniosym; tie(*{$th}, 'IO::ScalarArray'); ok($th, 'tie: got tied handle'); print {$th} @orig; tied(*{$th})->seek(0, 0); my @lines; while (my $line = <$th>) { push @lines, $line; } is(join('', @lines), join('', @orig), 'tied seek readline: got correct value'); @lines = (); tied(*{$th})->seek(0, 0); @lines = <$th>; is(join('', @lines), join('', @orig), 'tied seek readlines: got correct value'); } # record separators { my @lines = ( "par 1, line 1\n", "par 1, line 2\n", "\n", "\n", "\n", "\n", "par 2, line 1\n", "\n", "par 3, line 1\n", "par 3, line 2\n", "par 3, line 3", ); my $all = join('', @lines); # Slurp everything { my $iosa = IO::ScalarArray->new(\@lines); local $/ = undef; is($iosa->getline, $all, "RECORDSEP undef: getline slurps everything"); } # Read a little, slurp the rest { my $iosa = IO::ScalarArray->new(\@lines); is($iosa->getline, $lines[0], "RECORDSEP undef: get first line"); local $/ = undef; is($iosa->getline, join('', @lines[1..$#lines]), "RECORDSEP undef: slurp the rest"); } # Read line by line { my $iosa = IO::ScalarArray->new(\@lines); local $/ = "\n"; for my $i (0..10) { is($iosa->getline, $lines[$i], "RECORDSEP newline: rec $i"); } } } InnerFile.pm100644000000000000 1560113610227567 17416 0ustar00unknownunknown000000000000IO-Stringy-2.113/lib/IOpackage IO::InnerFile; use strict; use warnings; use Symbol; our $VERSION = '2.113'; sub new { my ($class, $fh, $start, $lg) = @_; $start = 0 if (!$start or ($start < 0)); $lg = 0 if (!$lg or ($lg < 0)); ### Create the underlying "object": my $a = { FH => $fh, CRPOS => 0, START => $start, LG => $lg, }; ### Create a new filehandle tied to this object: $fh = gensym; tie(*$fh, $class, $a); return bless($fh, $class); } sub TIEHANDLE { my ($class, $data) = @_; return bless($data, $class); } sub DESTROY { my ($self) = @_; $self->close() if (ref($self) eq 'SCALAR'); } sub set_length { tied(${$_[0]})->{LG} = $_[1]; } sub get_length { tied(${$_[0]})->{LG}; } sub add_length { tied(${$_[0]})->{LG} += $_[1]; } sub set_start { tied(${$_[0]})->{START} = $_[1]; } sub get_start { tied(${$_[0]})->{START}; } sub set_end { tied(${$_[0]})->{LG} = $_[1] - tied(${$_[0]})->{START}; } sub get_end { tied(${$_[0]})->{LG} + tied(${$_[0]})->{START}; } sub write { shift->WRITE(@_) } sub print { shift->PRINT(@_) } sub printf { shift->PRINTF(@_) } sub flush { "0 but true"; } sub fileno { } sub binmode { 1; } sub getc { return GETC(tied(${$_[0]}) ); } sub read { return READ( tied(${$_[0]}), @_[1,2,3] ); } sub readline { return READLINE( tied(${$_[0]}) ); } sub getline { return READLINE( tied(${$_[0]}) ); } sub close { return CLOSE(tied(${$_[0]}) ); } sub seek { my ($self, $ofs, $whence) = @_; $self = tied( $$self ); $self->{CRPOS} = $ofs if ($whence == 0); $self->{CRPOS}+= $ofs if ($whence == 1); $self->{CRPOS} = $self->{LG} + $ofs if ($whence == 2); $self->{CRPOS} = 0 if ($self->{CRPOS} < 0); $self->{CRPOS} = $self->{LG} if ($self->{CRPOS} > $self->{LG}); return 1; } sub tell { return tied(${$_[0]})->{CRPOS}; } sub WRITE { die "inner files can only open for reading\n"; } sub PRINT { die "inner files can only open for reading\n"; } sub PRINTF { die "inner files can only open for reading\n"; } sub GETC { my ($self) = @_; return 0 if ($self->{CRPOS} >= $self->{LG}); my $data; ### Save and seek... my $old_pos = $self->{FH}->tell; $self->{FH}->seek($self->{CRPOS}+$self->{START}, 0); ### ...read... my $lg = $self->{FH}->read($data, 1); $self->{CRPOS} += $lg; ### ...and restore: $self->{FH}->seek($old_pos, 0); $self->{LG} = $self->{CRPOS} unless ($lg); return ($lg ? $data : undef); } sub READ { my ($self, $undefined, $lg, $ofs) = @_; $undefined = undef; return 0 if ($self->{CRPOS} >= $self->{LG}); $lg = $self->{LG} - $self->{CRPOS} if ($self->{CRPOS} + $lg > $self->{LG}); return 0 unless ($lg); ### Save and seek... my $old_pos = $self->{FH}->tell; $self->{FH}->seek($self->{CRPOS}+$self->{START}, 0); ### ...read... $lg = $self->{FH}->read($_[1], $lg, $_[3] ); $self->{CRPOS} += $lg; ### ...and restore: $self->{FH}->seek($old_pos, 0); $self->{LG} = $self->{CRPOS} unless ($lg); return $lg; } sub READLINE { my ($self) = @_; return $self->_readline_helper() unless wantarray; my @arr; while(defined(my $line = $self->_readline_helper())) { push(@arr, $line); } return @arr; } sub _readline_helper { my ($self) = @_; return undef if ($self->{CRPOS} >= $self->{LG}); # Handle slurp mode (CPAN ticket #72710) if (! defined($/)) { my $text; $self->READ($text, $self->{LG} - $self->{CRPOS}); return $text; } ### Save and seek... my $old_pos = $self->{FH}->tell; $self->{FH}->seek($self->{CRPOS}+$self->{START}, 0); ### ...read... my $text = $self->{FH}->getline; ### ...and restore: $self->{FH}->seek($old_pos, 0); #### If we detected a new EOF ... unless (defined $text) { $self->{LG} = $self->{CRPOS}; return undef; } my $lg=length($text); $lg = $self->{LG} - $self->{CRPOS} if ($self->{CRPOS} + $lg > $self->{LG}); $self->{CRPOS} += $lg; return substr($text, 0,$lg); } sub CLOSE { %{$_[0]}=(); } 1; __END__ __END__ =head1 NAME IO::InnerFile - define a file inside another file =head1 SYNOPSIS use strict; use warnings; use IO::InnerFile; # Read a subset of a file: my $fh = _some_file_handle; my $start = 10; my $length = 50; my $inner = IO::InnerFile->new($fh, $start, $length); while (my $line = <$inner>) { # ... } =head1 DESCRIPTION If you have a file handle that can C and C, then you can open an L on a range of the underlying file. =head1 CONSTRUCTORS L implements the following constructors. =head2 new my $inner = IO::InnerFile->new($fh); $inner = IO::InnerFile->new($fh, 10); $inner = IO::InnerFile->new($fh, 10, 50); Create a new L opened on the given file handle. The file handle supplied B be able to both C and C. The second and third parameters are start and length. Both are defaulted to zero (C<0>). Negative values are silently coerced to zero. =head1 METHODS L implements the following methods. =head2 add_length $inner->add_length(30); Add to the virtual length of the inner file by the number given in bytes. =head2 add_start $inner->add_start(30); Add to the virtual position of the inner file by the number given in bytes. =head2 binmode $inner->binmode(); This is a NOOP method just to satisfy the normal L interface. =head2 close =head2 fileno $inner->fileno(); This is a NOOP method just to satisfy the normal L interface. =head2 flush $inner->flush(); This is a NOOP method just to satisfy the normal L interface. =head2 get_end my $num_bytes = $inner->get_end(); Get the virtual end position of the inner file in bytes. =head2 get_length my $num_bytes = $inner->get_length(); Get the virtual length of the inner file in bytes. =head2 get_start my $num_bytes = $inner->get_start(); Get the virtual position of the inner file in bytes. =head2 getc =head2 getline =head2 print LIST =head2 printf =head2 read =head2 readline =head2 seek =head2 set_end $inner->set_end(30); Set the virtual end of the inner file in bytes (this basically just alters the length). =head2 set_length $inner->set_length(30); Set the virtual length of the inner file in bytes. =head2 set_start $inner->set_start(30); Set the virtual start position of the inner file in bytes. =head2 tell =head2 write =head1 AUTHOR Eryq (F). President, ZeeGee Software Inc (F). =head1 CONTRIBUTORS Dianne Skoll (F). =head1 COPYRIGHT & LICENSE Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut AtomicFile.pm100644000000000000 1237213610227567 17561 0ustar00unknownunknown000000000000IO-Stringy-2.113/lib/IOpackage IO::AtomicFile; use strict; use warnings; use parent 'IO::File'; our $VERSION = '2.113'; #------------------------------ # new ARGS... #------------------------------ # Class method, constructor. # Any arguments are sent to open(). # sub new { my $class = shift; my $self = $class->SUPER::new(); ${*$self}{'io_atomicfile_suffix'} = ''; $self->open(@_) if @_; $self; } #------------------------------ # DESTROY #------------------------------ # Destructor. # sub DESTROY { shift->close(1); ### like close, but raises fatal exception on failure } #------------------------------ # open PATH, MODE #------------------------------ # Class/instance method. # sub open { my ($self, $path, $mode) = @_; ref($self) or $self = $self->new; ### now we have an instance! ### Create tmp path, and remember this info: my $temp = "${path}..TMP" . ${*$self}{'io_atomicfile_suffix'}; ${*$self}{'io_atomicfile_temp'} = $temp; ${*$self}{'io_atomicfile_path'} = $path; ### Open the file! Returns filehandle on success, for use as a constructor: $self->SUPER::open($temp, $mode) ? $self : undef; } #------------------------------ # _closed [YESNO] #------------------------------ # Instance method, private. # Are we already closed? Argument sets new value, returns previous one. # sub _closed { my $self = shift; my $oldval = ${*$self}{'io_atomicfile_closed'}; ${*$self}{'io_atomicfile_closed'} = shift if @_; $oldval; } #------------------------------ # close #------------------------------ # Instance method. # Close the handle, and rename the temp file to its final name. # sub close { my ($self, $die) = @_; unless ($self->_closed(1)) { ### sentinel... if ($self->SUPER::close()) { rename(${*$self}{'io_atomicfile_temp'}, ${*$self}{'io_atomicfile_path'}) or ($die ? die "close (rename) atomic file: $!\n" : return undef); } else { ($die ? die "close atomic file: $!\n" : return undef); } } 1; } #------------------------------ # delete #------------------------------ # Instance method. # Close the handle, and delete the temp file. # sub delete { my $self = shift; unless ($self->_closed(1)) { ### sentinel... $self->SUPER::close(); return unlink(${*$self}{'io_atomicfile_temp'}); } 1; } #------------------------------ # detach #------------------------------ # Instance method. # Close the handle, but DO NOT delete the temp file. # sub detach { my $self = shift; $self->SUPER::close() unless ($self->_closed(1)); 1; } #------------------------------ 1; __END__ =head1 NAME IO::AtomicFile - write a file which is updated atomically =head1 SYNOPSIS use strict; use warnings; use feature 'say'; use IO::AtomicFile; # Write a temp file, and have it install itself when closed: my $fh = IO::AtomicFile->open("bar.dat", "w"); $fh->say("Hello!"); $fh->close || die "couldn't install atomic file: $!"; # Write a temp file, but delete it before it gets installed: my $fh = IO::AtomicFile->open("bar.dat", "w"); $fh->say("Hello!"); $fh->delete; # Write a temp file, but neither install it nor delete it: my $fh = IO::AtomicFile->open("bar.dat", "w"); $fh->say("Hello!"); $fh->detach; =head1 DESCRIPTION This module is intended for people who need to update files reliably in the face of unexpected program termination. For example, you generally don't want to be halfway in the middle of writing I and have your program terminate! Even the act of writing a single scalar to a filehandle is I atomic. But this module gives you true atomic updates, via C. When you open a file I via this module, you are I opening a temporary file I, and writing your output there. The act of closing this file (either explicitly via C, or implicitly via the destruction of the object) will cause C to be called... therefore, from the point of view of the outside world, the file's contents are updated in a single time quantum. To ensure that problems do not go undetected, the C method done by the destructor will raise a fatal exception if the C fails. The explicit C just returns C. You can also decide at any point to trash the file you've been building. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 close $fh->close(); This method calls its parent L and then renames its temporary file as the original file name. =head2 delete $fh->delete(); This method calls its parent L and then deletes the temporary file. =head2 detach $fh->detach(); This method calls its parent L. Unlike L it does not then delete the temporary file. =head1 AUTHOR Eryq (F). President, ZeeGee Software Inc (F). =head1 CONTRIBUTORS Dianne Skoll (F). =head1 COPYRIGHT & LICENSE Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut ScalarArray.pm100644000000000000 4007713610227567 17754 0ustar00unknownunknown000000000000IO-Stringy-2.113/lib/IOpackage IO::ScalarArray; use strict; use Carp; use IO::Handle; # The package version, both in 1.23 style *and* usable by MakeMaker: our $VERSION = '2.113'; # Inheritance: our @ISA = qw(IO::Handle); require IO::WrapTie and push @ISA, 'IO::WrapTie::Slave' if ($] >= 5.004); =head1 NAME IO::ScalarArray - IO:: interface for reading/writing an array of scalars =head1 SYNOPSIS Perform I/O on strings, using the basic OO interface... use IO::ScalarArray; @data = ("My mes", "sage:\n"); ### Open a handle on an array, and append to it: $AH = new IO::ScalarArray \@data; $AH->print("Hello"); $AH->print(", world!\nBye now!\n"); print "The array is now: ", @data, "\n"; ### Open a handle on an array, read it line-by-line, then close it: $AH = new IO::ScalarArray \@data; while (defined($_ = $AH->getline)) { print "Got line: $_"; } $AH->close; ### Open a handle on an array, and slurp in all the lines: $AH = new IO::ScalarArray \@data; print "All lines:\n", $AH->getlines; ### Get the current position (either of two ways): $pos = $AH->getpos; $offset = $AH->tell; ### Set the current position (either of two ways): $AH->setpos($pos); $AH->seek($offset, 0); ### Open an anonymous temporary array: $AH = new IO::ScalarArray; $AH->print("Hi there!"); print "I printed: ", @{$AH->aref}, "\n"; ### get at value Don't like OO for your I/O? No problem. Thanks to the magic of an invisible tie(), the following now works out of the box, just as it does with IO::Handle: use IO::ScalarArray; @data = ("My mes", "sage:\n"); ### Open a handle on an array, and append to it: $AH = new IO::ScalarArray \@data; print $AH "Hello"; print $AH ", world!\nBye now!\n"; print "The array is now: ", @data, "\n"; ### Open a handle on a string, read it line-by-line, then close it: $AH = new IO::ScalarArray \@data; while (<$AH>) { print "Got line: $_"; } close $AH; ### Open a handle on a string, and slurp in all the lines: $AH = new IO::ScalarArray \@data; print "All lines:\n", <$AH>; ### Get the current position (WARNING: requires 5.6): $offset = tell $AH; ### Set the current position (WARNING: requires 5.6): seek $AH, $offset, 0; ### Open an anonymous temporary scalar: $AH = new IO::ScalarArray; print $AH "Hi there!"; print "I printed: ", @{$AH->aref}, "\n"; ### get at value And for you folks with 1.x code out there: the old tie() style still works, though this is I: use IO::ScalarArray; ### Writing to a scalar... my @a; tie *OUT, 'IO::ScalarArray', \@a; print OUT "line 1\nline 2\n", "line 3\n"; print "Array is now: ", @a, "\n" ### Reading and writing an anonymous scalar... tie *OUT, 'IO::ScalarArray'; print OUT "line 1\nline 2\n", "line 3\n"; tied(OUT)->seek(0,0); while () { print "Got line: ", $_; } =head1 DESCRIPTION This class is part of the IO::Stringy distribution; see L for change log and general information. The IO::ScalarArray class implements objects which behave just like IO::Handle (or FileHandle) objects, except that you may use them to write to (or read from) arrays of scalars. Logically, an array of scalars defines an in-core "file" whose contents are the concatenation of the scalars in the array. The handles created by this class are automatically Cd (though please see L<"WARNINGS"> for information relevant to your Perl version). For writing large amounts of data with individual print() statements, this class is likely to be more efficient than IO::Scalar. Basically, this: my @a; $AH = new IO::ScalarArray \@a; $AH->print("Hel", "lo, "); ### OO style $AH->print("world!\n"); ### ditto Or this: my @a; $AH = new IO::ScalarArray \@a; print $AH "Hel", "lo, "; ### non-OO style print $AH "world!\n"; ### ditto Causes @a to be set to the following array of 3 strings: ( "Hel" , "lo, " , "world!\n" ) See L and compare with this class. =head1 PUBLIC INTERFACE =head2 Construction =over 4 =cut #------------------------------ =item new [ARGS...] I Return a new, unattached array handle. If any arguments are given, they're sent to open(). =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = bless \do { local *FH }, $class; tie *$self, $class, $self; $self->open(@_); ### open on anonymous by default $self; } sub DESTROY { shift->close; } #------------------------------ =item open [ARRAYREF] I Open the array handle on a new array, pointed to by ARRAYREF. If no ARRAYREF is given, a "private" array is created to hold the file data. Returns the self object on success, undefined on error. =cut sub open { my ($self, $aref) = @_; ### Sanity: defined($aref) or do {my @a; $aref = \@a}; (ref($aref) eq "ARRAY") or croak "open needs a ref to a array"; ### Setup: $self->setpos([0,0]); *$self->{AR} = $aref; $self; } #------------------------------ =item opened I Is the array handle opened on something? =cut sub opened { *{shift()}->{AR}; } #------------------------------ =item close I Disassociate the array handle from its underlying array. Done automatically on destroy. =cut sub close { my $self = shift; %{*$self} = (); 1; } =back =cut #============================== =head2 Input and output =over 4 =cut #------------------------------ =item flush I No-op, provided for OO compatibility. =cut sub flush { "0 but true" } #------------------------------ =item fileno I No-op, returns undef =cut sub fileno { } #------------------------------ =item getc I Return the next character, or undef if none remain. This does a read(1), which is somewhat costly. =cut sub getc { my $buf = ''; ($_[0]->read($buf, 1) ? $buf : undef); } #------------------------------ =item getline I Return the next line, or undef on end of data. Can safely be called in an array context. Currently, lines are delimited by "\n". =cut sub getline { my $self = shift; my ($str, $line) = (undef, ''); ### Minimal impact implementation! ### We do the fast thing (no regexps) if using the ### classic input record separator. ### Case 1: $/ is undef: slurp all... if (!defined($/)) { return undef if ($self->eof); ### Get the rest of the current string, followed by remaining strings: my $ar = *$self->{AR}; my @slurp = ( substr($ar->[*$self->{Str}], *$self->{Pos}), @$ar[(1 + *$self->{Str}) .. $#$ar ] ); ### Seek to end: $self->_setpos_to_eof; return join('', @slurp); } ### Case 2: $/ is "\n": elsif ($/ eq "\012") { ### Until we hit EOF (or exited because of a found line): until ($self->eof) { ### If at end of current string, go fwd to next one (won't be EOF): if ($self->_eos) {++*$self->{Str}, *$self->{Pos}=0}; ### Get ref to current string in array, and set internal pos mark: $str = \(*$self->{AR}[*$self->{Str}]); ### get current string pos($$str) = *$self->{Pos}; ### start matching from here ### Get from here to either \n or end of string, and add to line: $$str =~ m/\G(.*?)((\n)|\Z)/g; ### match to 1st \n or EOS $line .= $1.$2; ### add it *$self->{Pos} += length($1.$2); ### move fwd by len matched return $line if $3; ### done, got line with "\n" } return ($line eq '') ? undef : $line; ### return undef if EOF } ### Case 3: $/ is ref to int. Bail out. elsif (ref($/)) { croak '$/ given as a ref to int; currently unsupported'; } ### Case 4: $/ is either "" (paragraphs) or something weird... ### Bail for now. else { croak '$/ as given is currently unsupported'; } } #------------------------------ =item getlines I Get all remaining lines. It will croak() if accidentally called in a scalar context. =cut sub getlines { my $self = shift; wantarray or croak("can't call getlines in scalar context!"); my ($line, @lines); push @lines, $line while (defined($line = $self->getline)); @lines; } #------------------------------ =item print ARGS... I Print ARGS to the underlying array. Currently, this always causes a "seek to the end of the array" and generates a new array entry. This may change in the future. =cut sub print { my $self = shift; push @{*$self->{AR}}, join('', @_) . (defined($\) ? $\ : ""); ### add the data $self->_setpos_to_eof; 1; } #------------------------------ =item read BUF, NBYTES, [OFFSET]; I Read some bytes from the array. Returns the number of bytes actually read, 0 on end-of-file, undef on error. =cut sub read { my $self = $_[0]; ### we must use $_[1] as a ref my $n = $_[2]; my $off = $_[3] || 0; ### print "getline\n"; my $justread; my $len; ($off ? substr($_[1], $off) : $_[1]) = ''; ### Stop when we have zero bytes to go, or when we hit EOF: my @got; until (!$n or $self->eof) { ### If at end of current string, go forward to next one (won't be EOF): if ($self->_eos) { ++*$self->{Str}; *$self->{Pos} = 0; } ### Get longest possible desired substring of current string: $justread = substr(*$self->{AR}[*$self->{Str}], *$self->{Pos}, $n); $len = length($justread); push @got, $justread; $n -= $len; *$self->{Pos} += $len; } $_[1] .= join('', @got); return length($_[1])-$off; } #------------------------------ =item write BUF, NBYTES, [OFFSET]; I Write some bytes into the array. =cut sub write { my $self = $_[0]; my $n = $_[2]; my $off = $_[3] || 0; my $data = substr($_[1], $n, $off); $n = length($data); $self->print($data); return $n; } =back =cut #============================== =head2 Seeking/telling and other attributes =over 4 =cut #------------------------------ =item autoflush I No-op, provided for OO compatibility. =cut sub autoflush {} #------------------------------ =item binmode I No-op, provided for OO compatibility. =cut sub binmode {} #------------------------------ =item clearerr I Clear the error and EOF flags. A no-op. =cut sub clearerr { 1 } #------------------------------ =item eof I Are we at end of file? =cut sub eof { ### print "checking EOF [*$self->{Str}, *$self->{Pos}]\n"; ### print "SR = ", $#{*$self->{AR}}, "\n"; return 0 if (*{$_[0]}->{Str} < $#{*{$_[0]}->{AR}}); ### before EOA return 1 if (*{$_[0]}->{Str} > $#{*{$_[0]}->{AR}}); ### after EOA ### ### at EOA, past EOS: ((*{$_[0]}->{Str} == $#{*{$_[0]}->{AR}}) && ($_[0]->_eos)); } #------------------------------ # # _eos # # I Are we at end of the CURRENT string? # sub _eos { (*{$_[0]}->{Pos} >= length(*{$_[0]}->{AR}[*{$_[0]}->{Str}])); ### past last char } #------------------------------ =item seek POS,WHENCE I Seek to a given position in the stream. Only a WHENCE of 0 (SEEK_SET) is supported. =cut sub seek { my ($self, $pos, $whence) = @_; ### Seek: if ($whence == 0) { $self->_seek_set($pos); } elsif ($whence == 1) { $self->_seek_cur($pos); } elsif ($whence == 2) { $self->_seek_end($pos); } else { croak "bad seek whence ($whence)" } return 1; } #------------------------------ # # _seek_set POS # # Instance method, private. # Seek to $pos relative to start: # sub _seek_set { my ($self, $pos) = @_; ### Advance through array until done: my $istr = 0; while (($pos >= 0) && ($istr < scalar(@{*$self->{AR}}))) { if (length(*$self->{AR}[$istr]) > $pos) { ### it's in this string! return $self->setpos([$istr, $pos]); } else { ### it's in next string $pos -= length(*$self->{AR}[$istr++]); ### move forward one string } } ### If we reached this point, pos is at or past end; zoom to EOF: return $self->_setpos_to_eof; } #------------------------------ # # _seek_cur POS # # Instance method, private. # Seek to $pos relative to current position. # sub _seek_cur { my ($self, $pos) = @_; $self->_seek_set($self->tell + $pos); } #------------------------------ # # _seek_end POS # # Instance method, private. # Seek to $pos relative to end. # We actually seek relative to beginning, which is simple. # sub _seek_end { my ($self, $pos) = @_; $self->_seek_set($self->_tell_eof + $pos); } #------------------------------ =item tell I Return the current position in the stream, as a numeric offset. =cut sub tell { my $self = shift; my $off = 0; my ($s, $str_s); for ($s = 0; $s < *$self->{Str}; $s++) { ### count all "whole" scalars defined($str_s = *$self->{AR}[$s]) or $str_s = ''; ###print STDERR "COUNTING STRING $s (". length($str_s) . ")\n"; $off += length($str_s); } ###print STDERR "COUNTING POS ($self->{Pos})\n"; return ($off += *$self->{Pos}); ### plus the final, partial one } #------------------------------ # # _tell_eof # # Instance method, private. # Get position of EOF, as a numeric offset. # This is identical to the size of the stream - 1. # sub _tell_eof { my $self = shift; my $len = 0; foreach (@{*$self->{AR}}) { $len += length($_) } $len; } #------------------------------ =item setpos POS I Seek to a given position in the array, using the opaque getpos() value. Don't expect this to be a number. =cut sub setpos { my ($self, $pos) = @_; (ref($pos) eq 'ARRAY') or die "setpos: only use a value returned by getpos!\n"; (*$self->{Str}, *$self->{Pos}) = @$pos; } #------------------------------ # # _setpos_to_eof # # Fast-forward to EOF. # sub _setpos_to_eof { my $self = shift; $self->setpos([scalar(@{*$self->{AR}}), 0]); } #------------------------------ =item getpos I Return the current position in the array, as an opaque value. Don't expect this to be a number. =cut sub getpos { [*{$_[0]}->{Str}, *{$_[0]}->{Pos}]; } #------------------------------ =item aref I Return a reference to the underlying array. =cut sub aref { *{shift()}->{AR}; } =back =cut #------------------------------ # Tied handle methods... #------------------------------ ### Conventional tiehandle interface: sub TIEHANDLE { (defined($_[1]) && UNIVERSAL::isa($_[1],"IO::ScalarArray")) ? $_[1] : shift->new(@_) } sub GETC { shift->getc(@_) } sub PRINT { shift->print(@_) } sub PRINTF { shift->print(sprintf(shift, @_)) } sub READ { shift->read(@_) } sub READLINE { wantarray ? shift->getlines(@_) : shift->getline(@_) } sub WRITE { shift->write(@_); } sub CLOSE { shift->close(@_); } sub SEEK { shift->seek(@_); } sub TELL { shift->tell(@_); } sub EOF { shift->eof(@_); } sub BINMODE { 1; } #------------------------------------------------------------ 1; __END__ # SOME PRIVATE NOTES: # # * The "current position" is the position before the next # character to be read/written. # # * Str gives the string index of the current position, 0-based # # * Pos gives the offset within AR[Str], 0-based. # # * Inital pos is [0,0]. After print("Hello"), it is [1,0]. =head1 AUTHOR Eryq (F). President, ZeeGee Software Inc (F). =head1 CONTRIBUTORS Dianne Skoll (F). =head1 COPYRIGHT & LICENSE Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 00-report-prereqs.t100644000000000000 1342613610227567 17772 0ustar00unknownunknown000000000000IO-Stringy-2.113/t#!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.027 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ($collector, $prereqs) = @_; # CPAN::Meta::Prereqs object if (ref $collector eq $cpan_meta_pre) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new( $prereqs ) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do './t/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; my $cpan_meta_error; if ( $source && $HAS_CPAN_META && (my $meta = eval { CPAN::Meta->load_file($source) } ) ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } else { $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase ( qw(configure build test runtime develop other) ) { next unless $req_hash->{$phase}; next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); for my $type ( qw(requires recommends suggests conflicts modules) ) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase).' '.ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if $mod eq 'perl'; next if grep { $_ eq $mod } @exclude; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); $have = "undef" unless defined $have; push @reports, [$mod, $want, $have]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [$mod, $want, "missing"]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if ( @reports ) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ($type eq 'modules') { splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; } else { splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; } push @full_reports, "\n"; } } } if ( @full_reports ) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( $cpan_meta_error || @dep_errors ) { diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; } if ( $cpan_meta_error ) { my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; } if ( @dep_errors ) { diag join("\n", "\nThe following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass; # vim: ts=4 sts=4 sw=4 et: release000755000000000000 013610227567 16020 5ustar00unknownunknown000000000000IO-Stringy-2.113/xtkwalitee.t100644000000000000 32113610227567 20126 0ustar00unknownunknown000000000000IO-Stringy-2.113/xt/release# this test was generated with Dist::Zilla::Plugin::Test::Kwalitee 2.12 use strict; use warnings; use Test::More 0.88; use Test::Kwalitee 1.21 'kwalitee_ok'; kwalitee_ok( qw( -no_symlinks ) ); done_testing; author000755000000000000 013610227567 15702 5ustar00unknownunknown000000000000IO-Stringy-2.113/xtpod-spell.t100644000000000000 76313610227567 20114 0ustar00unknownunknown000000000000IO-Stringy-2.113/xt/authoruse strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::PodSpelling 2.007005 use Test::Spelling 0.12; use Pod::Wordlist; add_stopwords(); all_pod_files_spelling_ok( qw( bin lib ) ); __DATA__ AtomicFile BUF Chase Dianne Dorfman Doru Erik FOO Foo IO InnerFile Lines NBYTES POS SCALARREF SLAVECLASS Scalar ScalarArray Skoll Stringy Whitener Wrap WrapTie ZeeGee aref capoeirab dfs dskoll eryq getline getlines getpos ing lib reblessed setpos sref tieable wraphandle pod-syntax.t100644000000000000 25213610227567 20314 0ustar00unknownunknown000000000000IO-Stringy-2.113/xt/author#!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); 00-report-prereqs.dd100644000000000000 626013610227567 20074 0ustar00unknownunknown000000000000IO-Stringy-2.113/tdo { my $x = { 'build' => { 'requires' => { 'ExtUtils::MakeMaker' => '0' } }, 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '0' } }, 'develop' => { 'requires' => { 'Dist::Zilla' => '0', 'File::Spec' => '0', 'IO::Handle' => '0', 'IPC::Open3' => '0', 'Pod::Coverage::TrustPod' => '0', 'Test::CPAN::Changes' => '0.4', 'Test::CheckManifest' => '1.29', 'Test::Kwalitee' => '1.22', 'Test::More' => '0.88', 'Test::Pod' => '1.41', 'Test::Pod::Coverage' => '1.08', 'Test::Pod::Spelling::CommonMistakes' => '1.000', 'Test::Spelling' => '0.12', 'Test::TrailingSpace' => '0', 'Test::Version' => '1' } }, 'runtime' => { 'requires' => { 'Carp' => '0', 'Exporter' => '5.57', 'File::Spec' => '0', 'FileHandle' => '0', 'IO::File' => '0', 'IO::Handle' => '0', 'Symbol' => '0', 'overload' => '0', 'parent' => '0', 'perl' => '5.008', 'strict' => '0', 'warnings' => '0' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900' }, 'requires' => { 'ExtUtils::MakeMaker' => '0', 'File::Basename' => '0', 'File::Spec' => '0', 'File::Temp' => '0', 'FileHandle' => '0', 'IO::File' => '0', 'IO::Handle' => '0', 'Symbol' => '0', 'Test::More' => '0.88', 'Test::Tester' => '0', 'strict' => '0', 'warnings' => '0' } } }; $x; }00-compile.t100644000000000000 277013610227567 20102 0ustar00unknownunknown000000000000IO-Stringy-2.113/xt/authoruse 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058 use Test::More; plan tests => 9; my @module_files = ( 'IO/AtomicFile.pm', 'IO/InnerFile.pm', 'IO/Lines.pm', 'IO/Scalar.pm', 'IO/ScalarArray.pm', 'IO/Stringy.pm', 'IO/Wrap.pm', 'IO/WrapTie.pm' ); # no fake home requested my @switches = ( -d 'blib' ? '-Mblib' : '-Ilib', ); use File::Spec; use IPC::Open3; use IO::Handle; open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my @warnings; for my $lib (@module_files) { # see L my $stderr = IO::Handle->new; diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } $^X, @switches, '-e', "require q[$lib]")) if $ENV{PERL_COMPILE_TEST_DEBUG}; my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); binmode $stderr, ':crlf' if $^O eq 'MSWin32'; my @_warnings = <$stderr>; waitpid($pid, 0); is($?, 0, "$lib loaded ok"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { +require blib; blib->VERSION('1.01') }; if (@_warnings) { warn @_warnings; push @warnings, @_warnings; } } is(scalar(@warnings), 0, 'no warnings found') or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ); test-version.t100644000000000000 63713610227567 20657 0ustar00unknownunknown000000000000IO-Stringy-2.113/xt/authoruse strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::Version 1.09 use Test::Version; my @imports = qw( version_all_ok ); my $params = { is_strict => 0, has_version => 1, multiple => 0, }; push @imports, $params if version->parse( $Test::Version::VERSION ) >= version->parse('1.002'); Test::Version->import(@imports); version_all_ok; done_testing; pod-coverage.t100644000000000000 227113610227567 20604 0ustar00unknownunknown000000000000IO-Stringy-2.113/xt/author#!perl # This file was automatically generated by Dist::Zilla::Plugin::Test::Pod::Coverage::Configurable 0.07. use Test::Pod::Coverage 1.08; use Test::More 0.88; BEGIN { if ( $] <= 5.008008 ) { plan skip_all => 'These tests require Pod::Coverage::TrustPod, which only works with Perl 5.8.9+'; } } use Pod::Coverage::TrustPod; my %skip = map { $_ => 1 } qw( ); my @modules; for my $module ( all_modules() ) { next if $skip{$module}; push @modules, $module; } plan skip_all => 'All the modules we found were excluded from POD coverage test.' unless @modules; plan tests => scalar @modules; my %trustme = ( 'IO::Scalar' => [ qr/^(?:use_RS)$/ ], 'IO::WrapTie' => [ qr/^(?:new)$/ ] ); my @also_private; for my $module ( sort @modules ) { pod_coverage_ok( $module, { coverage_class => 'Pod::Coverage::TrustPod', also_private => \@also_private, trustme => $trustme{$module} || [], }, "pod coverage for $module" ); } done_testing(); examples000755000000000000 013610227567 15563 5ustar00unknownunknown000000000000IO-Stringy-2.113IO_Scalar_synopsis100644000000000000 463513610227567 21421 0ustar00unknownunknown000000000000IO-Stringy-2.113/examples#!/usr/bin/perl =head1 NAME IO_Scalar_synopsis - test out IO::Scalar =head1 SYNOPSIS ### From our distribution's top level directory: perl -I./lib examples/IO_Scalar_synopsis =cut use 5.005; use IO::Scalar; use strict; my $line = ('-' x 60)."\n"; my $somestring = "My message:\n"; ### ### Perform I/O on strings, using the basic OO interface... ### ### Open a handle on a string, and append to it: print $line; my $SH = new IO::Scalar \$somestring; $SH->print("Hello"); $SH->print(", world!\nBye now!\n"); print "The string is now: ", $somestring, "\n"; ### Open a handle on a string, read it line-by-line, then close it: print $line; $SH = new IO::Scalar \$somestring; while (defined($_ = $SH->getline)) { print "Got line: $_"; } $SH->close; ### Open a handle on a string, and slurp in all the lines: print $line; $SH = new IO::Scalar \$somestring; print "All lines:\n", $SH->getlines; ### Get the current position (either of two ways): my $pos = $SH->getpos; my $offset = $SH->tell; ### Set the current position (either of two ways): $SH->setpos($pos); $SH->seek($offset, 0); ### Open an anonymous temporary scalar: print $line; $SH = new IO::Scalar; $SH->print("Hi there!"); print "I printed: ", ${$SH->sref}, "\n"; ### get at value ### Don't like OO for your I/O? No problem. ### Thanks to the magic of an invisible tie(), the following now ### works out of the box, just as it does with IO::Handle: ### Open a handle on a string, and append to it: print $line; $SH = new IO::Scalar \$somestring; print $SH "Hello"; print $SH ", world!\nBye now!\n"; print "The string is now: ", $somestring, "\n"; ### Open a handle on a string, read it line-by-line, then close it: print $line; $SH = new IO::Scalar \$somestring; while (<$SH>) { print "Got line: $_"; } close $SH; ### Open a handle on a string, and slurp in all the lines: print $line; $SH = new IO::Scalar \$somestring; print "All lines:\n", <$SH>; ### Get the current position (WARNING: requires 5.6): $offset = tell $SH; ### Set the current position (WARNING: requires 5.6): seek $SH, $offset, 0; ### Open an anonymous temporary scalar: print $line; $SH = new IO::Scalar; print $SH "Hi there!"; print "I printed: ", ${$SH->sref}, "\n"; ### get at value ### Stringification: print $line; my $str = ""; $SH = new IO::Scalar \$str; print $SH "Hello, "; print $SH "world!"; print "I printed: $SH\n"; ### Done! 1; changes_has_content.t100644000000000000 210113610227567 22334 0ustar00unknownunknown000000000000IO-Stringy-2.113/xt/releaseuse Test::More tests => 2; note 'Checking Changes'; my $changes_file = 'Changes'; my $newver = '2.113'; my $trial_token = '-TRIAL'; my $encoding = 'UTF-8'; SKIP: { ok(-e $changes_file, "$changes_file file exists") or skip 'Changes is missing', 1; ok(_get_changes($newver), "$changes_file has content for $newver"); } done_testing; sub _get_changes { my $newver = shift; # parse changelog to find commit message open(my $fh, '<', $changes_file) or die "cannot open $changes_file: $!"; my $changelog = join('', <$fh>); if ($encoding) { require Encode; $changelog = Encode::decode($encoding, $changelog, Encode::FB_CROAK()); } close $fh; my @content = grep { /^$newver(?:$trial_token)?(?:\s+|$)/ ... /^\S/ } # from newver to un-indented split /\n/, $changelog; shift @content; # drop the version line # drop unindented last line and trailing blank lines pop @content while ( @content && $content[-1] =~ /^(?:\S|\s*$)/ ); # return number of non-blank lines return scalar @content; }