IPC-Shareable-0.61/000755 000765 000024 00000000000 12036132031 014410 5ustar00msouthstaff000000 000000 IPC-Shareable-0.61/CHANGES000644 000765 000024 00000013262 12036131453 015416 0ustar00msouthstaff000000 000000 Revision history for Perl extension IPC::Shareable. 0.01 Wed Jul 30 09:00:53 1997 - original version; created by h2xs 1.18. 0.05 Wed Jul 30 15:02:31 EDT 1997 - scalars can now be tied; Ben Sugars. 0.10 Fri Aug 1 13:32:52 EDT 1997 - can now tie both scalars and hashes of arbitrary length; Ben Sugars. 0.11 Wed Aug 6 10:14:49 EDT 1997 - initial implementation of semaphores for versioning and caching; Ben Sugars. 0.12 Thu Aug 7 14:47:42 EDT 1997 - various bug fixes; Ben Sugars. 0.15 Fri Aug 8 15:45:29 EDT 1997 - implemented locking using semaphores; Ben Sugars. 0.16 Mon Aug 11 16:10:54 EDT 1997 - new shared memory segments now initialized with null values; Ben Sugars. 0.17 Wed Aug 27 15:57:11 EDT 1997 - fixed some bugs in &parse_argument_hash; Ben Sugars. 0.18 Thu Aug 28 09:12:30 EDT 1997 - fixed garbage collection bug; Ben Sugars. Thanks to Michael Stevens for the patch. 0.20 Thu Aug 28 15:13:46 EDT 1997 - added ability to magically create ties to implicitly referenced thingys; Ben Sugars. 0.25 Tue Oct 7 14:41:49 EDT 1997 - added more checking of sem*() and shm*() return values; Michael Stevens and Ben Sugars. - added shlock and shunlock; Ben Sugars. - fixed bug that would cause modifications of magically referenced thingys to fail. Thanks to Maurice Aubrey 0.26 Mon Oct 20 10:06:43 EDT 1997 - fixed bug regarding assigning a reference to an empty hash to a tied variable. Thanks to Jason Stevens. 0.28 Wed Oct 22 14:59:08 EDT 1997 - cleaned up the way thingys are magically tied; Ben Sugars. - moved many subroutines so that they are auto-loaded; Ben Sugars. - updated man page; Ben Sugars. 0.29 Mon Jan 12 13:49:42 EST 1998 - $MAXVER patch for when the version semaphore reaches its limit and rolls back over to 0; Maurice Aubrey . - patch to quieten things down under -w; Doug MacEachern 0.30 Mon Jan 19 11:13:41 EST 1998 - Added SEM_UNDO to semop() calls; Maurice Aubrey. - Fixed some bugs in the locking code; Maurice Aubrey. - Made calls to debug() conditional for efficency; Maurice Aubrey. - Fixed a signal handler in test.pl; Maurice Aubrey. 0.50 Tue Mar 21 11:56:32 EST 2000 - Complete rewrite incorporating the following changes. - Requires 5.00503. This allowed the module to get rid of the global cache for shared memory segments; each Shareable object now carries around its own data. - 5.00503 also allowed tied arrays to be implemented - Shared memory segments can no longer be of infinite length thereby reducing the amount of code in the module by a factor of 2. - Uses IPC::Shareable::SharedMem class for accessing shared memory. - Uses IPC::Semaphore module for accessing semaphores. - Completely revisited the way references are dealed with: all referenced thingies are now automagically tied to shared memory. - Constants now imported from IPC::SysV; Shareable.xs is gone - Rewrote test suite and moved into t subdirectory - Updated man page 0.51 Fri May 5 23:47:06 EDT 2000 - Fixed bug that would cause IPC::Shareable::BUF_SIZ to be ignored; thanks to Robert Emmery and Mohammed J. Kabir for reporting. - Stopped tests from leaking shm segments - Added test of argument parsing - doc fixes 0.52 Thu Sep 14 12:30:17 EDT 2000 - Now STORE, PUSH, POP, etc all call _thaw() before doing their business. - Refined SIGALRM handlers in test scripts - Fixed concurrency issues affecting tied arrays and hashes; thanks to thanks to Robert Emmery , Terry Ewing , Tim Fries , and Joe Thomas . - Doc fixes thanks to Paul Makepeace 0.53 Tue Nov 14 00:33:35 EST 2000 - Fixed race condition in test suite causing intermitent failures. - Better checking for success of calls to Storable::thaw(); thanks to Raphael Manfredi . 0.54 Mon Jan 8 11:52:28 EST 2001 - Fix to allow IPC::Shareable to work with 1.0.* versions of Storable 0.60 Mon Mar 5 15:20:18 EST 2001 - Lee Lindley (lee.lindley@bigfoot.com) added the _was_changed optimization, improved the locking functionality, fixed numerous bugs, and generally cleaned things up; thanks. - Removed support for "no" as a false value in arguments; thanks to Dave Rolsky 0.61 Mon Oct 8 00:27:39 2012 - Added patch from Frank Lichtenheld fixing IPC::Shareable's dependence on the presence of a perl bug which is no longer present in perl >= 5.10 - Fixed bug reported by Dan Harbin where the FETCH operation on a tie()d string containing HASH, ARRAY, or SCALAR fails because it was using the stringification of the data to determine what kind of reference it was. Now using Scalar::Util::reftype - Added missing dependency on IPC::Semaphore to Makefile.PL (reported by Adrian Issott) - Added a 'sleep 1' in a test that was hanging on certain systems due (possibly) to two alarm signals coming too quickly to the child process. From Ton Voon. IPC-Shareable-0.61/COPYING000644 000765 000024 00000043076 12036131453 015464 0ustar00msouthstaff000000 000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS 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 the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 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 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, 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) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. IPC-Shareable-0.61/CREDITS000644 000765 000024 00000001573 12036131453 015445 0ustar00msouthstaff000000 000000 CREDITS This project was initiated by myself (Ben Sugars) in August, 1997. After a prolonged absence, I returned to the project in the winter of 2000. Maurice Aubrey co-authored some earlier versions with me. Thanks! Thanks to all others with comments or bug fixes, especially: Stephane Bortzmeyer Doug MacEachern Robert Emmery Mohammed J. Kabir Terry Ewing Tim Fries Joe Thomas Paul Makepeace Raphael Manfredi Lee.Lindley@bigfoot.com Dave Rolsky If you notice any problems, create any patches, or add any features, be sure to let me know so your name can be in the above list! -- Ben Sugars March 5, 2001 IPC-Shareable-0.61/DISCLAIMER000644 000765 000024 00000002324 12036131453 015757 0ustar00msouthstaff000000 000000 NO WARRANTY BECAUSE THE SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "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 SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE 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 SOFTWARE 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 SOFTWARE (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 SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. IPC-Shareable-0.61/eg/000755 000765 000024 00000000000 12036131453 015012 5ustar00msouthstaff000000 000000 IPC-Shareable-0.61/lib/000755 000765 000024 00000000000 12036131453 015165 5ustar00msouthstaff000000 000000 IPC-Shareable-0.61/Makefile.PL000644 000765 000024 00000001071 12036131453 016370 0ustar00msouthstaff000000 000000 use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'IPC::Shareable', VERSION_FROM => 'lib/IPC/Shareable.pm', LIBS => [''], DEFINE => '', INC => '', PREREQ_PM => { "Storable" => 0.607, "Scalar::Util" => 0, "IPC::Semaphore" => 0, }, ); IPC-Shareable-0.61/MANIFEST000644 000765 000024 00000000512 12036131453 015546 0ustar00msouthstaff000000 000000 CHANGES COPYING CREDITS DISCLAIMER MANIFEST Makefile.PL README TO_DO eg/client eg/get eg/hvtest1 eg/hvtest2 eg/put eg/server lib/IPC/Shareable.pm lib/IPC/Shareable/SharedMem.pm t/00base.t t/05sv.t t/10av.t t/15hv.t t/20ref.t t/25ipc.t t/30lock.t t/35clean.t t/36ipcav.t t/38ipchv.t t/40ipcref.t t/45obj.t t/50ipcobj.t t/55lsync.t IPC-Shareable-0.61/README000644 000765 000024 00000014246 12036131453 015306 0ustar00msouthstaff000000 000000 ---------------------------------------------------------------------- This is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License , or (at your option) any later version. This software 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 software. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ---------------------------------------------------------------------- *** This is beta software -- use at your own risks *** Introduction ------------ IPC::Shareable allows you to tie a variable to shared memory making it easy to share the contents of that variable with other Perl processes. Scalars, arrays, and hashes can be tied. The variable being tied may contain arbitrarily complex data structures - including references to arrays, hashes of hashes, etc. Installation ------------ 0. Prerequisites: -Perl version 5.005_03 or more recent. -System V IPC (shmget(2), shmctl(2), etc). -Storable.pm, version 0.6 or more recent. 1. Installation steps: -from the directory where this file is located, type: perl Makefile.PL make make test make install Incompatibility Alert --------------------- This version contains some incompatiblities from earlier versions of IPC::Shareable. Here's a list of them. 1. Earlier versions allowed you to use the word B for true and the word B for false as elements in the options hash. Support for this "feature" is being removed. B will still act as true (since it is true, in the Perl sense), but use of the word B now emits an (optional) warning and then revert to a false value. This warning will become mandatory in a future release and then at some later date stop working altogether. 2. Earlier versions used to accept upper-case values of YES/NO as elements in the options hash in addition to yes/no. Support for this has been entirely removed. 3. Earlier versions would try to allow data of arbitrary length to be tied to shared memory. This well-intentioned (but misguided) approach convoluted the code. Current versions of IPC::Shareable do not allow data of arbitrary length. Each individual tied variable may not have a serialized length greater than the system's maximum shared memory segment size. 4. This version of IPC::Shareable does not understand the format of shared memory segments created versions prior to 0.60. If you try to tie to such segments, you will get an error. The only work around is to clear the shared memory segments and start with a fresh set. The benefits afforded in terms of code simplication and performance on shorter segments more than make up for the above incompatibilities. Documentation ------------- The man page for IPC::Shareable is embedded in IPC::Shareable.pm. Copies of this document in various formats can be found in the doc directory of the distribution. In there will you find information about usage, pitfalls, etc. Known Problems -------------- 1. Running out of semaphores make test may fail with the message Could not create semaphore set: No space left on device This is because the test suite has used up all of the allowed number of semaphore sets and/or semaphores (SEMMNI and/or SEMMNS respectively). This seems to happen often on FreeBSD, where the default value is rather low. The only solution is to increase SEMMNI and/or SEMMNS for the system. Consult your system documentation for how to do this. 2. Running out of shared memory make test may fail with the message Munged shared memory segment (size exceeded?) This is likely because the tests are exceeding the maximum size of a shared memory segment (SHMMAX) or the system-wide limit on shared memory size (SHMALL). The only solution is to increase SHMMAX and/or SHMALL for the system. Consult your system documentation for how to do this. This failure could also mean that IPC::Shareable doesn't like your version of Storable (IPC::Shareable makes some assumptions about the structure of serialized data). This message would happen, for instance, when version 0.53 of IPC::Shareable was used in conjunction with 1.0.x versions of Storable. If you're having problems, try using Storable 1.0.7 which is known to work with IPC::Shareable 0.54. 3. Array operations on references Generally, when a reference is assigned to a shared variable, the referenced data is also supposed to be shared. However, this currently is not the case for references assigned to an array via push(), splice(), and such. Suppose for example, you do @shared = (); push @shared, { %hv }; then the assignment $shared->[0]->{foo} = "bar"; will not be shared with other processes since %hv is not shared. As a workaround you'll have to use array index operations: @shared = (); $shared[0] = { %hv }; $shared->[0]->{foo} = "bar"; Note that push(), splice(), et al. work fine for non-references. This bug will be fixed in a future release. Etc --- I have tested this on Linux only. YMMV may vary on other systems. The two-year hiatus between releases of IPC::Shareable is symptomatic of the amount of time I have to contribute to this project. Help save the world! Submit me patches and improvements. Also, don't be alarmed if I can't answer support emails. If this bothers you, you can always ask for your money back :-) For a more light-weight, non-tie()-based interface to shared memory see Maurice Aubrey's IPC::ShareLite. -- Ben Sugars (bsugars@canoe.ca) March 5, 2001 New co-maintainer ----------------- October 8, 2012 I became co-maintainer so that I could apply some patches that had been sitting around on rt.cpan.org for a few years. Let me know if there is some way I can help, but understand that I have little experience with the module itself. Mike South (msouth@gmail.com) IPC-Shareable-0.61/README.md000644 000765 000024 00000000226 12036131453 015676 0ustar00msouthstaff000000 000000 IPC-Shareable ============= Incorporation of patches provided by others to CPAN's IPC::Shareable, which I did not write and am only helping maintain.IPC-Shareable-0.61/t/000755 000765 000024 00000000000 12036131453 014662 5ustar00msouthstaff000000 000000 IPC-Shareable-0.61/TO_DO000644 000765 000024 00000001701 12036131453 015245 0ustar00msouthstaff000000 000000 Feel free to tackle any of these or any other problems you find. All I ask is that you send me your changes so that they can be incorporated into a common codebase for everyone to benefit from (also, so you can get credit for your work!). - rewriting the core of Shareable in C to gain speed and memory efficiency. (Update as of January, 1998: I am presently working on this. If anybody else has made progress in this area, please let me know so our efforts can be coordinated.) (Update as of March, 2000: I quickly ran out of tuits to complete the rewrite in C. Maybe some other time) - perhaps add news ways to share data in addition to shared memory so that the module becomes portable - have Shareable print proper error messages when system calls fail - really blue sky: could the module overload some operators so that their use will automatically invoke locking and unlocking of a tie()d variable? -- Ben Sugars March 5, 2001 IPC-Shareable-0.61/t/00base.t000644 000765 000024 00000003451 12036131453 016124 0ustar00msouthstaff000000 000000 BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..11\n"; } use strict; use IPC::Shareable; use IPC::SysV qw(IPC_PRIVATE SEM_UNDO IPC_RMID); my $loaded = 1; print "ok 1\n"; END { print "not ok 1\n" unless $loaded; } my $t = 2; my $ok = 1; my $id = shmget(IPC_PRIVATE, 1024, 0666); $ok = defined $id; $ok or warn "shmget: $!"; print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; my $var = 'foobar'; my $copy = ''; $ok = shmwrite($id, $var, 0, length('foobar')); $ok or warn "shmwrite: $!"; print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; shmread($id, $copy, 0, length('foobar')); $ok or warn "shmread: $!"; print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($var eq $copy); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = shmctl($id, IPC_RMID, 0); $ok or warn "shmctl: $!"; print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $id = semget(IPC_PRIVATE, 1, 0666); $ok = defined $id; $ok or warn "semget: $!"; print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; my $semop = pack('sss', 0, 1, SEM_UNDO); $ok = semop($id, $semop); $ok or warn "semop: $!"; print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = semctl($id, 0, IPC_RMID, 0); $ok or warn "semctl: $!"; print $ok ? "ok $t\n" : "not ok $t\n"; # --- Argument parsing my $nothing; ++$t; my $s = tie $nothing => 'IPC::Shareable'; for my $k (keys %IPC::Shareable::Def_Opts) { $s->{_opts}->{$k} eq $IPC::Shareable::Def_Opts{$k} or undef $ok; } print $ok ? "ok $t\n" : "not ok $t\n"; $s->{_shm}->remove; $s->{_sem}->remove; ++$t; my $opts = { key => 1234, create => 'yes', exclusive => 'yes', destroy => 'yes', mode => 0600, size => 999, }; $s = tie $nothing => 'IPC::Shareable', $opts; for my $k (keys %$opts) { $s->{_opts}->{$k} eq $opts->{$k} or undef $ok; } print $ok ? "ok $t\n" : "not ok $t\n"; IPC-Shareable-0.61/t/05sv.t000644 000765 000024 00000001637 12036131453 015653 0ustar00msouthstaff000000 000000 BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..5\n"; } use strict; use IPC::Shareable; my $t = 1; my $ok = 1; # --- TIESCALAR my $sv; tie($sv, 'IPC::Shareable', { destroy => 'yes' }) or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; # --- scalar STORE and FETCH ++$t; $ok = 1; $sv = 'foo'; ($sv eq 'foo') or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; # This is a regression test for the # bug fixed by using Scalar::Util::reftype # instead of looking for HASH, SCALAR, ARRAY # in the stringified version of the scalar. foreach my $mod (qw/HASH SCALAR ARRAY/){ # --- TIESCALAR my $sv; tie($sv, 'IPC::Shareable', { destroy => 'yes' }) or die ('this was not expected to die here'); # --- scalar STORE and FETCH ++$t; $ok = 1; $sv = $mod.'foo'; ($sv eq $mod.'foo') or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; } # --- Done! exit; IPC-Shareable-0.61/t/10av.t000644 000765 000024 00000003322 12036131453 015616 0ustar00msouthstaff000000 000000 BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..11\n"; } use strict; use IPC::Shareable; my $t = 1; my $ok = 1; # --- TIEARRAY my @av; tie(@av, 'IPC::Shareable', { destroy => 'yes' }) or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; # --- STORE and FETCH my @word = qw(tic tac toe); @av = qw(tic tac toe); ++$t; $ok = 1; for (0 .. 2) { $av[$_] eq $word[$_] or undef $ok; } print $ok ? "ok $t\n" : "not ok $t\n"; # --- STORESIZE ++$t; $ok = 1; $#av = 5; my $i = 0; ++$i for @av; $i == 6 or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = 1; for (3 .. 5) { defined $av[$_] and undef $ok; } print $ok ? "ok $t\n" : "not ok $t\n"; # --- FETCHSIZE ++$t; $ok = 1; $#av == 5 or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; # --- CLEAR @av = (); ++$t; $ok = 1; scalar @av == 0 or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; @av = qw(fee fie foe fum); # --- POP ++$t; $ok = 1; my $fum = pop @av; $fum eq 'fum' or undef $ok; $#av == 2 or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; # --- PUSH ++$t; $ok = 1; push @av => $fum; $#av == 3 or undef $ok; $av[3] eq 'fum' or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; # --- SHIFT ++$t; $ok = 1; my $fee = shift @av; $fee eq 'fee' or undef $ok; $#av == 2 or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; # --- UNSHIFT ++$t; $ok = 1; unshift @av => $fee; $#av == 3 or undef $ok; $av[0] eq 'fee' or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; # --- SPLICE ++$t; $ok = 1; my(@gone) = splice @av, 1, 2, qw(i spliced); $av[1] eq 'i' or undef $ok; $av[2] eq 'spliced' or undef $ok; $gone[0] eq 'fie' or undef $ok; $gone[1] eq 'foe' or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; exit; IPC-Shareable-0.61/t/15hv.t000644 000765 000024 00000003124 12036131453 015632 0ustar00msouthstaff000000 000000 BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..10\n"; } use strict; use IPC::Shareable; my $t = 1; my $ok = 1; # --- TIEHASH my %hv; tie(%hv, 'IPC::Shareable', { 'destroy' => 'yes' }) or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; # --- Assign a few values (STORE, FETCH) my %check; ++$t; $ok = 1; my @k = map { ('a' .. 'z')[int(rand(26))] } (0 .. 9); my @v = map { ('A' .. 'Z')[int(rand(26))] } (0 .. 9); @check{@k} = @v; while (my($k, $v) = each %check) { $hv{$k} = $v; } while (my($k, $v) = each %check) { $hv{$k} eq $v or undef $ok; } print $ok ? "ok $t\n" : "not ok $t\n"; # --- FIRSTKEY, NEXTKEY ++$t; $ok = 1; my $kno = keys %check; my $n = 0; while (my($k, $v) = each %hv) { ++$n; if ($n > $kno) { undef $ok; last; } } print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = 1; $n = 0; while (my($k, $v) = each %hv) { ++$n; if ($n > $kno) { undef $ok; last; } $check{$k} or undef $ok; delete $check{$k}; } print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = !(keys %check); print $ok ? "ok $t\n" : "not ok $t\n"; # --- EXISTS ++$t; $hv{there} = undef; $ok = exists $hv{there}; print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = !(exists $hv{not_there}); print $ok ? "ok $t\n" : "not ok $t\n"; # --- DELETE ++$t; $hv{there} = 'yes'; my $smoked = delete $hv{there}; $ok = !(exists $hv{there}); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($smoked eq 'yes'); print $ok ? "ok $t\n" : "not ok $t\n"; # --- CLEAR ++$t; %hv = (); $n = keys %hv; $ok = ($n == 0); print $ok ? "ok $t\n" : "not ok $t\n"; # --- Done! exit; IPC-Shareable-0.61/t/20ref.t000644 000765 000024 00000003454 12036131453 015773 0ustar00msouthstaff000000 000000 BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..8\n"; } use strict; use Carp; use IPC::Shareable; my $t = 1; my $ok = 1; my $sv; # --- Scalar refs tie($sv, 'IPC::Shareable', { destroy => 'yes' }) or croak "Could not tie scalar"; my $ref = 'ref'; $sv = \$ref; $$sv eq 'ref' or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; # --- Array refs ++$t; $ok = 1; $sv = [ 0 .. 9 ]; for (0 .. 9) { ($sv->[$_] eq $_) or undef $ok; } print $ok ? "ok $t\n" : "not ok $t\n"; # --- Hash refs my %check; ++$t; $ok = 1; my @k = map { ('a' .. 'z')[int(rand(26))] } (0 .. 9); my @v = map { ('A' .. 'Z')[int(rand(26))] } (0 .. 9); @check{@k} = @v; $sv = { %check }; while (my($k, $v) = each %check){ $sv->{$k} eq $v or undef $ok; } print $ok ? "ok $t\n" : "not ok $t\n"; # --- Multiple refs my @av; tie @av => 'IPC::Shareable'; $av[0] = { foo => 'bar', baz => 'bash' }; $av[1] = [ 0 .. 9 ]; ++$t; $ok = ($av[0]->{foo} eq 'bar'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($av[0]->{baz} eq 'bash'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = 1; for (0 .. 9) { $av[1]->[$_] == $_ or undef $ok; } print $ok ? "ok $t\n" : "not ok $t\n"; my %hv; tie %hv => 'IPC::Shareable'; for ('a' .. 'z') { $hv{lower}->{$_} = $_; $hv{upper}->{$_} = uc; } ++$t; $ok = 1; for ('a' .. 'z') { $hv{lower}->{$_} eq $_ or undef $ok; $hv{upper}->{$_} eq uc or undef $ok; } print $ok ? "ok $t\n" : "not ok $t\n"; IPC::Shareable->clean_up_all; tie($sv, 'IPC::Shareable', { destroy => 'yes' }) or croak "Could not tie scalar"; # --- Deeply nested thingies ++$t; $sv->{this}->{is}->{nested}->{deeply}->[0]->[1]->[2] = 'found'; $ok = ($sv->{this}->{is}->{nested}->{deeply}->[0]->[1]->[2] eq 'found'); print $ok ? "ok $t\n" : "not ok $t\n"; IPC::Shareable->clean_up_all; # --- Done! exit; IPC-Shareable-0.61/t/25ipc.t000644 000765 000024 00000001630 12036131453 015771 0ustar00msouthstaff000000 000000 BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..3\n"; } use strict; use Carp; use IPC::Shareable; my $t = 1; my $ok = 1; my $sv; my $awake = 0; local $SIG{ALRM} = sub { $awake = 1 }; my $pid = fork; defined $pid or die "Cannot fork: $!"; if ($pid == 0) { # --- Child sleep unless $awake; tie($sv, 'IPC::Shareable', data => { destroy => 0 }) or undef $ok; $sv eq 'bar' or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = 1; $sv = 'foo'; $sv eq 'foo' or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; exit; } else { # --- Parent tie($sv, 'IPC::Shareable', data => { create => 'yes', destroy => 'yes' }) or undef $ok; $sv = 'bar'; kill ALRM => $pid; waitpid($pid, 0); $sv eq 'foo' or undef $ok; $t += 2; # - Child performed two tests. print $ok ? "ok $t\n" : "not ok $t\n"; } # --- Done! exit; IPC-Shareable-0.61/t/30lock.t000644 000765 000024 00000001704 12036131453 016144 0ustar00msouthstaff000000 000000 BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..1\n"; } use strict; use Carp; use IPC::Shareable; my $t = 1; my $ok = 1; my $sv; my $awake = 0; local $SIG{ALRM} = sub { $awake = 1 }; # --- Test locking my $pid = fork; defined $pid or die "Cannot fork: $!\n"; if ($pid == 0) { # --- Child sleep unless $awake; tie($sv, 'IPC::Shareable', data => { destroy => 0 }) or die "child process can't tie \$sv"; for (0 .. 99) { (tied $sv)->shlock; ++$sv; (tied $sv)->shunlock; } exit; } else { # --- Parent tie($sv, 'IPC::Shareable', data => { create => 'yes', destroy => 'yes' }) or die "parent process can't tie \$sv"; $sv = 0; kill ALRM => $pid; for (0 .. 99) { (tied $sv)->shlock; ++$sv; (tied $sv)->shunlock; } waitpid($pid, 0); $sv == 200 or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; } # --- Done! exit; IPC-Shareable-0.61/t/35clean.t000644 000765 000024 00000004407 12036131453 016306 0ustar00msouthstaff000000 000000 BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..11\n"; } use strict; use Carp; use IPC::Shareable; use IPC::Shareable::SharedMem; my $t = 1; my $ok = 1; sub gonzo { # --- shmread should barf if the segment has really been cleaned my $id = shift; my $data = ''; eval { shmread($id, $data, 0, 6) or die "$!" }; return scalar($@ =~ /Invalid/ or $@ =~ /removed/); } # --- remove() my $sv; (my $s = tie $sv, 'IPC::Shareable', { destroy => 0 }) or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; $sv = 'foobar'; ++$t; # XXX Don't do the following: it's not part of the interface! my $id = $s->{_shm}->id; $s->remove; $ok = gonzo($id); print $ok ? "ok $t\n" : "not ok $t\n"; my $awake = 0; local $SIG{ALRM} = sub { $awake = 1 }; # --- remove(), clean_up(), clean_up_all() ++$t; $ok = 1; my $pid = fork; defined $pid or die "Cannot fork : $!"; if ($pid == 0) { # --- Child sleep unless $awake; my $s = tie($sv, 'IPC::Shareable', 'hash', { destroy => 0 }) or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; $sv = 'foobar'; ++$t; my $data = ''; my $id = $s->{_shm}->id; IPC::Shareable->clean_up(); $ok = shmread($id, $data, 0, length('IPC::Shareable')); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($data eq 'IPC::Shareable'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $s->remove; $ok = gonzo($id); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; tie($sv, 'IPC::Shareable', 'kids', { create => 'yes', destroy => 0 }) or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; $sv = 'the kid was here'; exit; } else { # --- Parent my $s = tie($sv, 'IPC::Shareable', 'hash', { create => 'yes', destroy => 0 }) or undef $ok; kill ALRM => $pid; my $id = $s->{_shm}->id; waitpid($pid, 0); +$t += 5; # - Child performed 4 tests $ok = gonzo($id); print $ok ? "ok $t\n" : "not ok $t\n"; } ++$t; $s = tie($sv, 'IPC::Shareable', 'kids', { destroy => 0 }) or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; $id = $s->{_shm}->id; ++$t; $ok = ($sv eq 'the kid was here'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; IPC::Shareable->clean_up_all; $ok = gonzo($id); print $ok ? "ok $t\n" : "not ok $t\n"; # --- Done! exit; IPC-Shareable-0.61/t/36ipcav.t000644 000765 000024 00000002471 12036131453 016326 0ustar00msouthstaff000000 000000 BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..3\n"; } use strict; use Carp; use IPC::Shareable; my $t = 1; my $ok = 1; my $awake = 0; local $SIG{ALRM} = sub { $awake = 1 }; my $pid = fork; defined $pid or die "Cannot fork: $!"; if ($pid == 0) { sleep unless $awake; $awake = 0; my @av; my $ipch = tie(@av, 'IPC::Shareable', "foco", { create => 1, exclusive => 0, mode => 0666, size => 1024*512, destroy => 0, }) or undef $ok; @av = (); print $ok ? "ok $t\n" : "not ok $t\n"; for (my $i = 1; $i <= 10; $i++) { $ipch->shlock; push(@av, $i); $ipch->shunlock; } sleep unless $awake; ++$t; $ok = 1; @av and undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; exit; } else { my @av; my $ipch = tie(@av, 'IPC::Shareable', "foco", { create => 1, exclusive => 0, mode => 0666, size => 1024*512, destroy => 'yes', }); @av = (); kill ALRM => $pid; my %seen; sleep 1 until @av; while (@av) { $ipch->shlock; my $line = shift @av; if ($seen{$line}) { undef $ok; } ++$seen{$line}; $ipch->shunlock; } kill ALRM => $pid; waitpid($pid, 0); $t += 2; $ok = 1; @av and undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; } # --- Done! exit; IPC-Shareable-0.61/t/38ipchv.t000644 000765 000024 00000003576 12036131453 016346 0ustar00msouthstaff000000 000000 BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..5\n"; } use strict; use Carp; use IPC::Shareable; my $t = 1; my $ok = 1; my %shareOpts = ( create => 'yes', exclusive => 0, mode => 0644, destroy => 'yes', ); my $awake = 0; local $SIG{ALRM} = sub { $awake = 1 }; my $pid = fork; defined $pid or die "Cannot fork: $!"; if ($pid == 0) { # --- Kid sleep unless $awake; $awake = 0; my %hv; my $ipch = tie(%hv, 'IPC::Shareable', "data", { create => 'yes', exclusive => 0, mode => 0644, destroy => 0, }) or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; for (qw(fee fie foe fum)) { $ipch->shlock(); $hv{$_} = $$; $ipch->shunlock(); } sleep unless $awake; $ok = 1; ++$t; for (qw(fee fie foe fum)) { $hv{$_} == $$ or undef $ok; } print $ok ? "ok $t\n" : "not ok $t\n"; $ok = 1; ++$t; my $dad = getppid; $dad == 1 and die "Parent process has unexpectedly gone away"; for (qw(eenie meenie minie moe)) { $hv{$_} == $dad or undef $ok; } print $ok ? "ok $t\n" : "not ok $t\n"; } else { # --- Parent my %hv; my $ipch = tie(%hv, 'IPC::Shareable', "data", { create => 1, exclusive => 0, mode => 0666, size => 1024*512, destroy => 'yes', }); %hv = (); kill ALRM => $pid; sleep 1; # Allow time for child to process the signal before next ALRM comes in for (qw(eenie meenie minie moe)) { $ipch->shlock(); $hv{$_} = $$; $ipch->shunlock(); } kill ALRM => $pid; waitpid($pid, 0); $t += 3; $ok = 1; for (qw(fee fie foe fum)) { $hv{$_} == $pid or undef $ok; } print $ok ? "ok $t\n" : "not ok $t\n"; $ok = 1; ++$t; for (qw(eenie meenie minie moe)) { $hv{$_} == $$ or undef $ok; } print $ok ? "ok $t\n" : "not ok $t\n"; } exit; IPC-Shareable-0.61/t/40ipcref.t000644 000765 000024 00000003711 12036131453 016465 0ustar00msouthstaff000000 000000 BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..11\n"; } use strict; use Carp; use IPC::Shareable; my $t = 1; my $ok = 1; my $awake = 0; local $SIG{ALRM} = sub { $awake = 1 }; my($av, $hv); my $pid = fork; defined $pid or die "Cannot fork : $!"; if ($pid == 0) { # --- Child sleep unless $awake; tie($hv, 'IPC::Shareable', 'hash', { destroy => 0 }) or undef $ok; tie($av, 'IPC::Shareable', 'arry', { destroy => 0 }) or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($hv eq 'baz'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($av eq 'bong'); print $ok ? "ok $t\n" : "not ok $t\n"; $hv = { }; $av = [ ]; $hv->{blip}->{blarp} = 'blurp'; $hv->{flip}->{flop} = 'flurp'; $av->[1]->[2] = 'beep'; $av->[2]->[3] = 'bang'; ++$t; $ok = ($hv->{blip}->{blarp} eq 'blurp'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($hv->{flip}->{flop} eq 'flurp'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($av->[1]->[2] eq 'beep'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($av->[2]->[3] eq 'bang'); print $ok ? "ok $t\n" : "not ok $t\n"; exit; } else { # --- Parent tie($hv, 'IPC::Shareable', 'hash', { create => 'yes', destroy => 'yes' }) or undef $ok; tie($av, 'IPC::Shareable', 'arry', { create => 'yes', destroy => 'yes' }) or undef $ok; $hv = 'baz'; $av = 'bong'; kill ALRM => $pid; waitpid($pid, 0); $t += 7; # - Child performed 7 tests $ok = ($hv->{blip}->{blarp} eq 'blurp'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($hv->{flip}->{flop} eq 'flurp'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($av->[1]->[2] eq 'beep'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($av->[2]->[3] eq 'bang'); print $ok ? "ok $t\n" : "not ok $t\n"; IPC::Shareable->clean_up_all; } # --- Done! exit; IPC-Shareable-0.61/t/45obj.t000644 000765 000024 00000002125 12036131453 015772 0ustar00msouthstaff000000 000000 BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..6\n"; } use strict; use Carp; use IPC::Shareable; my $t = 1; my $ok = 1; { package Dummy; sub new { my $d = { _first => undef, _second => undef, }; return bless $d => shift; } sub first { my $self = shift; $self->{_first} = shift if @_; return $self->{_first}; } sub second { my $self = shift; $self->{_second} = shift if @_; return $self->{_second}; } } my $d; tie $d, 'IPC::Shareable', { destroy => 'yes' } or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $d = Dummy->new or undef $ok; $ok = (ref $d eq 'Dummy'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $d->first('first'); $ok = ($d->first eq 'first'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $d->second('second'); $ok = ($d->second eq 'second'); print $ok ? "ok $t\n" : "not ok $t\n"; $d->first('foo'); $d->second('bar'); ++$t; $ok = ($d->first eq 'foo'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($d->second eq 'bar'); print $ok ? "ok $t\n" : "not ok $t\n"; # --- Done! exit; IPC-Shareable-0.61/t/50ipcobj.t000644 000765 000024 00000003316 12036131453 016465 0ustar00msouthstaff000000 000000 BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..6\n"; } use strict; use Carp; use IPC::Shareable; my $t = 1; my $ok = 1; { package Dummy; sub new { my $d = { _first => undef, _second => undef, }; return bless $d => shift; } sub first { my $self = shift; $self->{_first} = shift if @_; return $self->{_first}; } sub second { my $self = shift; $self->{_second} = shift if @_; return $self->{_second}; } } my $awake = 0; local $SIG{ALRM} = sub { $awake = 1 }; my $pid = fork; defined $pid or die "Cannot fork : $!"; if ($pid == 0) { # --- Child sleep unless $awake; my $d; ++$t; tie($d, 'IPC::Shareable', 'obj', { destroy => 0 }) or undef $ok; $ok = (ref $d eq 'Dummy'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($d->first eq 'foobar'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($d->second eq 'barfoo'); print $ok ? "ok $t\n" : "not ok $t\n"; $d->first('kid did'); $d->second('this'); exit; } else { # --- Parent my $d; my $s = tie($d, 'IPC::Shareable', 'obj', { create => 'yes', destroy => 'yes' }) or undef $ok; my $id = $s->{_shm}->{_id}; print $ok ? "ok $t\n" : "not ok $t\n"; $d = { }; $d->{_first} = 'foobar'; $d->{_second} = 'barfoo'; $d = Dummy->new; $d->first('foobar'); $d->second('barfoo'); kill ALRM => $pid; waitpid($pid, 0); $t += 3; # - Child did 3 test ++$t; $ok = ($d->first eq 'kid did'); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = ($d->second eq 'this'); print $ok ? "ok $t\n" : "not ok $t\n"; IPC::Shareable->clean_up_all; } # --- Done! exit; IPC-Shareable-0.61/t/55lsync.t000644 000765 000024 00000003153 12036131453 016353 0ustar00msouthstaff000000 000000 # Test of asynchronous hash access courtesy of Tim Fries BEGIN { $^W = 1; $| = 1; $SIG{INT} = sub { die }; print "1..5\n"; } use strict; use Carp; use IPC::Shareable; my $t = 1; my $ok = 1; my $awake = 0; local $SIG{ALRM} = sub { $awake = 1 }; my $ppid = $$; my $pid = fork; defined $pid or die "Cannot fork : $!"; if ($pid == 0) { # --- Child sleep unless $awake; $awake = 0; ++$t; my %thash = (); tie(%thash, 'IPC::Shareable', 'hobj', { destroy => 0 }) or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; $thash{'foo'} = "marlinspike"; $thash{'bar'} = "ballyhoo"; $thash{'quux'} = "calvinball"; kill ALRM => $ppid; sleep unless $awake; ++$t; $ok = (defined $thash{'foo'} && $thash{'foo'} eq "marlinspike"); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = (defined $thash{'bar'} && $thash{'bar'} eq "ballyhoo"); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; $ok = (defined $thash{'quux'} && $thash{'quux'} eq "calvinball"); print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; exit; } else { # --- Parent my $awake = 0; local $SIG{ALRM} = sub { $awake = 1 }; my %thash = (); tie(%thash, 'IPC::Shareable', 'hobj', { create => 'yes' }) or undef $ok; print $ok ? "ok $t\n" : "not ok $t\n"; ++$t; kill ALRM => $pid; sleep unless $awake; ++$t; $thash{'intel'} = "expensive"; $thash{'amd'} = "volthungry"; $thash{'cyrix'} = "mia"; kill ALRM => $pid; waitpid($pid, 0); IPC::Shareable->clean_up_all; } # --- Done! exit; IPC-Shareable-0.61/lib/IPC/000755 000765 000024 00000000000 12036131453 015600 5ustar00msouthstaff000000 000000 IPC-Shareable-0.61/lib/IPC/Shareable/000755 000765 000024 00000000000 12036131453 017466 5ustar00msouthstaff000000 000000 IPC-Shareable-0.61/lib/IPC/Shareable.pm000644 000765 000024 00000114702 12036131453 020031 0ustar00msouthstaff000000 000000 package IPC::Shareable; require 5.00503; use strict; use IPC::Semaphore; use IPC::Shareable::SharedMem; use IPC::SysV qw( IPC_PRIVATE IPC_CREAT IPC_EXCL IPC_NOWAIT SEM_UNDO ); use Storable 0.6 qw( freeze thaw ); use Scalar::Util; use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS ); $VERSION = 0.61; use constant LOCK_SH => 1; use constant LOCK_EX => 2; use constant LOCK_NB => 4; use constant LOCK_UN => 8; require Exporter; @ISA = 'Exporter'; @EXPORT = (); @EXPORT_OK = qw(LOCK_EX LOCK_SH LOCK_NB LOCK_UN); %EXPORT_TAGS = ( all => [qw( LOCK_EX LOCK_SH LOCK_NB LOCK_UN )], lock => [qw( LOCK_EX LOCK_SH LOCK_NB LOCK_UN )], 'flock' => [qw( LOCK_EX LOCK_SH LOCK_NB LOCK_UN )], ); Exporter::export_ok_tags('all', 'lock', 'flock'); use constant DEBUGGING => ($ENV{SHAREABLE_DEBUG} or 0); use constant SHM_BUFSIZ => 65536; use constant SEM_MARKER => 0; use constant SHM_EXISTS => 1; # Locking scheme copied from IPC::ShareLite -- ltl my %semop_args = ( (LOCK_EX), [ 1, 0, 0, # wait for readers to finish 2, 0, 0, # wait for writers to finish 2, 1, SEM_UNDO, # assert write lock ], (LOCK_EX|LOCK_NB), [ 1, 0, IPC_NOWAIT, # wait for readers to finish 2, 0, IPC_NOWAIT, # wait for writers to finish 2, 1, (SEM_UNDO | IPC_NOWAIT), # assert write lock ], (LOCK_EX|LOCK_UN), [ 2, -1, (SEM_UNDO | IPC_NOWAIT), ], (LOCK_SH), [ 2, 0, 0, # wait for writers to finish 1, 1, SEM_UNDO, # assert shared read lock ], (LOCK_SH|LOCK_NB), [ 2, 0, IPC_NOWAIT, # wait for writers to finish 1, 1, (SEM_UNDO | IPC_NOWAIT), # assert shared read lock ], (LOCK_SH|LOCK_UN), [ 1, -1, (SEM_UNDO | IPC_NOWAIT), # remove shared read lock ], ); my %Def_Opts = ( key => IPC_PRIVATE, create => '', exclusive => '', destroy => '', mode => 0666, size => SHM_BUFSIZ, ); # XXX Perl seems to garbage collect nested referents before we're done with them # XXX This cache holds a reference to things until END() is called my %Global_Reg; my %Proc_Reg; sub _trace; sub _debug; ############################################################################### # Debug mark # --- Public methods sub shlock { _trace @_ if DEBUGGING; my ($self, $typelock) = @_; ($typelock = LOCK_EX) unless defined $typelock; return $self->shunlock if ($typelock & LOCK_UN); return 1 if ($self->{_lock} & $typelock); # If they have a different lock than they want, release it first $self->shunlock if ($self->{_lock}); my $sem = $self->{_sem}; _debug "Attempting type=", $typelock, " lock on", $self->{_shm}, "via", $sem->id if DEBUGGING; my $return_val = $sem->op(@{ $semop_args{$typelock} }); if ($return_val) { $self->{_lock} = $typelock; _debug "Got lock on", $self->{_shm}, "via", $sem->id if DEBUGGING; $self->{_data} = _thaw($self->{_shm}), } else { _debug "Failed lock on", $self->{_shm}, "via", $sem->id if DEBUGGING; } return $return_val; } sub shunlock { _trace @_ if DEBUGGING; my $self = shift; return 1 unless $self->{_lock}; if ($self->{_was_changed}) { defined _freeze($self->{_shm} => $self->{_data}) or do { require Carp; Carp::croak "Could not write to shared memory: $!\n"; }; $self->{_was_changed} = 0; } my $sem = $self->{_sem}; _debug "Freeing lock on", $self->{_shm}, "via", $sem->id if DEBUGGING; my $typelock = $self->{_lock} | LOCK_UN; $typelock ^= LOCK_NB if ($typelock & LOCK_NB); $sem->op(@{ $semop_args{$typelock} }); $self->{_lock} = 0; _debug "Lock on", $self->{_shm}, "via", $sem->id, "freed" if DEBUGGING; 1; } # --- "Magic" methods sub TIESCALAR { _trace @_ if DEBUGGING; return _tie(SCALAR => @_); } sub TIEARRAY { _trace @_ if DEBUGGING; return _tie(ARRAY => @_); } sub TIEHASH { _trace @_ if DEBUGGING; return _tie(HASH => @_); } sub STORE { _trace @_ if DEBUGGING; my $self = shift; my $sid = $self->{_shm}->{_id}; $Global_Reg{$self->{_shm}->id} ||= $self; $self->{_data} = _thaw($self->{_shm}) unless ($self->{_lock}); TYPE: { if ($self->{_type} eq 'SCALAR') { my $val = shift; _mg_tie($self => $val) if _need_tie($val); $self->{_data} = \$val; last TYPE; } if ($self->{_type} eq 'ARRAY') { my $i = shift; my $val = shift; _mg_tie($self => $val) if _need_tie($val); $self->{_data}->[$i] = $val; last TYPE; } if ($self->{_type} eq 'HASH') { my $key = shift; my $val = shift; _mg_tie($self => $val) if _need_tie($val); $self->{_data}->{$key} = $val; last TYPE; } require Carp; Carp::croak "Variables of type $self->{_type} not supported"; } if ($self->{_lock} & LOCK_EX) { $self->{_was_changed} = 1; } else { defined _freeze($self->{_shm} => $self->{_data}) or do { require Carp; Carp::croak "Could not write to shared memory: $!\n"; }; } return 1; } sub FETCH { _trace @_ if DEBUGGING; my $self = shift; $Global_Reg{$self->{_shm}->id} ||= $self; my $data; if ($self->{_lock} || $self->{_iterating}) { $self->{_iterating} = ''; # In case we break out $data = $self->{_data}; } else { $data = _thaw($self->{_shm}); $self->{_data} = $data; } my $val; TYPE: { if ($self->{_type} eq 'SCALAR') { if (defined $data) { $val = $$data; last TYPE; } else { return; } } if ($self->{_type} eq 'ARRAY') { if (defined $data) { my $i = shift; $val = $data->[$i]; last TYPE; } else { return; } } if ($self->{_type} eq 'HASH') { if (defined $data) { my $key = shift; $val = $data->{$key}; last TYPE; } else { return; } } require Carp; Carp::croak "Variables of type $self->{_type} not supported"; } if (my $inner = _is_kid($val)) { my $s = $inner->{_shm}; $inner->{_data} = _thaw($s); } return $val; } sub CLEAR { _trace @_ if DEBUGGING; my $self = shift; if ($self->{_type} eq 'ARRAY') { $self->{_data} = [ ]; } elsif ($self->{_type} eq 'HASH') { $self->{_data} = { }; } else { require Carp; Carp::croak "Attempt to clear non-aggegrate"; } if ($self->{_lock} & LOCK_EX) { $self->{_was_changed} = 1; } else { defined _freeze($self->{_shm} => $self->{_data}) or do { require Carp; Carp::croak "Could not write to shared memory: $!"; }; } } sub DELETE { _trace @_ if DEBUGGING; my $self = shift; my $key = shift; $self->{_data} = _thaw($self->{_shm}) unless $self->{_lock}; my $val = delete $self->{_data}->{$key}; if ($self->{_lock} & LOCK_EX) { $self->{_was_changed} = 1; } else { defined _freeze($self->{_shm} => $self->{_data}) or do { require Carp; Carp::croak "Could not write to shared memory: $!"; }; } return $val; } sub EXISTS { _trace @_ if DEBUGGING; my $self = shift; my $key = shift; $self->{_data} = _thaw($self->{_shm}) unless $self->{_lock}; return exists $self->{_data}->{$key}; } sub FIRSTKEY { _trace @_ if DEBUGGING; my $self = shift; my $key = shift; _debug "setting hash iterator on", $self->{_shm}->id if DEBUGGING; $self->{_iterating} = 1; $self->{_data} = _thaw($self->{_shm}) unless $self->{_lock}; my $reset = keys %{$self->{_data}}; my $first = each %{$self->{_data}}; return $first; } sub NEXTKEY { _trace @_ if DEBUGGING; my $self = shift; # caveat emptor if hash was changed by another process my $next = each %{$self->{_data}}; if (not defined $next) { _debug "resetting hash iterator on", $self->{_shm}->id if DEBUGGING; $self->{_iterating} = ''; return; } else { $self->{_iterating} = 1; return $next; } } sub EXTEND { _trace @_ if DEBUGGING; #XXX Noop } sub PUSH { _trace @_ if DEBUGGING; my $self = shift; $Global_Reg{$self->{_shm}->id} ||= $self; $self->{_data} = _thaw($self->{_shm}, $self->{_data}) unless $self->{_lock}; push @{$self->{_data}} => @_; if ($self->{_lock} & LOCK_EX) { $self->{_was_changed} = 1; } else { defined _freeze($self->{_shm} => $self->{_data}) or do { require Carp; Carp::croak "Could not write to shared memory: $!"; }; } } sub POP { _trace @_ if DEBUGGING; my $self = shift; $self->{_data} = _thaw($self->{_shm}, $self->{_data}) unless $self->{_lock}; my $val = pop @{$self->{_data}}; if ($self->{_lock} & LOCK_EX) { $self->{_was_changed} = 1; } else { defined _freeze($self->{_shm} => $self->{_data}) or do { require Carp; Carp::croak "Could not write to shared memory: $!"; }; } return $val; } sub SHIFT { _trace @_ if DEBUGGING; my $self = shift; $self->{_data} = _thaw($self->{_shm}, $self->{_data}) unless $self->{_lock}; my $val = shift @{$self->{_data}}; if ($self->{_lock} & LOCK_EX) { $self->{_was_changed} = 1; } else { defined _freeze($self->{_shm} => $self->{_data}) or do { require Carp; Carp::croak "Could not write to shared memory: $!"; }; } return $val; } sub UNSHIFT { _trace @_ if DEBUGGING; my $self = shift; $self->{_data} = _thaw($self->{_shm}, $self->{_data}) unless $self->{_lock}; my $val = unshift @{$self->{_data}} => @_; if ($self->{_lock} & LOCK_EX) { $self->{_was_changed} = 1; } else { defined _freeze($self->{_shm} => $self->{_data}) or do { require Carp; Carp::croak "Could not write to shared memory: $!"; }; } return $val; } sub SPLICE { _trace @_ if DEBUGGING; my($self, $off, $n, @av) = @_; $self->{_data} = _thaw($self->{_shm}, $self->{_data}) unless $self->{_lock}; my @val = splice @{$self->{_data}}, $off, $n => @av; if ($self->{_lock} & LOCK_EX) { $self->{_was_changed} = 1; } else { defined _freeze($self->{_shm} => $self->{_data}) or do { require Carp; Carp::croak "Could not write to shared memory: $!"; }; } return @val; } sub FETCHSIZE { _trace @_ if DEBUGGING; my $self = shift; $self->{_data} = _thaw($self->{_shm}) unless $self->{_lock}; return scalar(@{$self->{_data}}); } sub STORESIZE { _trace @_ if DEBUGGING; my $self = shift; my $n = shift; $self->{_data} = _thaw($self->{_shm}) unless $self->{_lock}; $#{$self->{_data}} = $n - 1; if ($self->{_lock} & LOCK_EX) { $self->{_was_changed} = 1; } else { defined _freeze($self->{_shm} => $self->{_data}) or do { require Carp; Carp::croak "Could not write to shared memory: $!"; }; } return $n; } sub clean_up { _trace @_ if DEBUGGING; my $class = shift; for my $s (values %Proc_Reg) { next unless $s->{_opts}->{_owner} == $$; remove($s); } } sub clean_up_all { _trace @_ if DEBUGGING; my $class = shift; for my $s (values %Global_Reg) { remove($s); } } sub remove { _trace @_ if DEBUGGING; my $self = shift; my $s = $self->{_shm}; my $id = $s->id; $s->remove or do { require Carp; Carp::carp "Couldn't remove shared memory segment $id: $!"; }; $s = $self->{_sem}; $s->remove or do { require Carp; Carp::carp "Couldn't remove semaphore set $id: $!"; }; delete $Proc_Reg{$id}; delete $Global_Reg{$id}; } END { _trace @_ if DEBUGGING; for my $s (values %Proc_Reg) { shunlock($s); next unless $s->{_opts}->{destroy}; next unless $s->{_opts}->{_owner} == $$; remove($s); } } # --- Private methods below sub _freeze { _trace @_ if DEBUGGING; my $s = shift; my $water = shift; my $ice = freeze $water; # Could be a large string. No need to copy it. substr more efficient substr $ice, 0, 0, 'IPC::Shareable'; _debug "writing to shm segment ", $s->id, ": ", $ice if DEBUGGING; if (length($ice) > $s->size) { require Carp; Carp::croak "Length of shared data exceeds shared segment size"; }; $s->shmwrite($ice); } sub _thaw { _trace @_ if DEBUGGING; my $s = shift; my $ice = $s->shmread; _debug "read from shm segment ", $s->id, ": ", $ice if DEBUGGING; my $tag = substr $ice, 0, 14, ''; if ($tag eq 'IPC::Shareable') { my $water = thaw $ice; defined($water) or do { require Carp; Carp::croak "Munged shared memory segment (size exceeded?)"; }; return $water; } else { return; } } sub _tie { _trace @_ if DEBUGGING; my $type = shift; my $class = shift; my $opts = _parse_args(@_); my $key = _shm_key($opts); my $flags = _shm_flags($opts); my $shm_size = $opts->{size}; my $s = IPC::Shareable::SharedMem->new($key, $shm_size, $flags); defined $s or do { require Carp; Carp::croak "Could not create shared memory segment: $!\n"; }; _debug "shared memory id is", $s->id if DEBUGGING; my $sem = IPC::Semaphore->new($key, 3, $flags); defined $sem or do { require Carp; Carp::croak "Could not create semaphore set: $!\n"; }; _debug "semaphore id is", $sem->id if DEBUGGING; unless ( $sem->op(@{ $semop_args{(LOCK_SH)} }) ) { require Carp; Carp::croak "Could not obtain semaphore set lock: $!\n"; } my $sh = { _iterating => '', _key => $key, _lock => 0, _opts => $opts, _shm => $s, _sem => $sem, _type => $type, _was_changed => 0, }; $sh->{_data} = _thaw($s), my $there = $sem->getval(SEM_MARKER); if ($there == SHM_EXISTS) { _debug "binding to existing segment on ", $s->id if DEBUGGING; } else { _debug "brand new segment on ", $s->id if DEBUGGING; $Proc_Reg{$sh->{_shm}->id} ||= $sh; $sem->setval(SEM_MARKER, SHM_EXISTS) or do { require Carp; Carp::croak "Couldn't set semaphore during object creation: $!"; }; } $sem->op(@{ $semop_args{(LOCK_SH|LOCK_UN)} }); _debug "IPC::Shareable instance created:", $sh if DEBUGGING; return bless $sh => $class; } sub _parse_args { _trace @_ if DEBUGGING; my($proto, $opts) = @_; $proto = defined $proto ? $proto : 0; $opts = defined $opts ? $opts : { %Def_Opts }; if (ref $proto eq 'HASH') { $opts = $proto; } else { $opts->{key} = $proto; } for my $k (keys %Def_Opts) { if (not defined $opts->{$k}) { $opts->{$k} = $Def_Opts{$k}; } elsif ($opts->{$k} eq 'no') { if ($^W) { require Carp; Carp::carp("Use of `no' in IPC::Shareable args is obsolete"); } $opts->{$k} = ''; } } $opts->{_owner} = ($opts->{_owner} or $$); $opts->{_magic} = ($opts->{_magic} or ''); _debug "options are", $opts if DEBUGGING; return $opts; } sub _shm_key { _trace @_ if DEBUGGING; my $hv = shift; my $val = ($hv->{key} or ''); if ($val eq '') { return IPC_PRIVATE; } elsif ($val =~ /^\d+$/) { return $val; } else { # XXX This only uses the first four characters $val = pack A4 => $val; $val = unpack i => $val; return $val; } } sub _shm_flags { # --- Parses the anonymous hash passed to constructors; returns a list # --- of args suitable for passing to shmget _trace @_ if DEBUGGING; my $hv = shift; my $flags = 0; $flags |= IPC_CREAT if $hv->{create}; $flags |= IPC_EXCL if $hv->{exclusive}; $flags |= ($hv->{mode} or 0666); return $flags; } sub _mg_tie { _trace @_ if DEBUGGING; my $dad = shift; my $val = shift; # XXX How to generate a unique id ? my $key; if ($dad->{_key} == IPC_PRIVATE) { $key = IPC_PRIVATE; } else { $key = int(rand(1_000_000)); } my %opts = ( %{$dad->{_opts}}, key => $key, exclusive => 'yes', create => 'yes', _magic => 'yes' ); # XXX I wish I didn't have to take a copy of data here and copy it back in # XXX Also, have to peek inside potential objects to see their implementation my $kid; my $type = Scalar::Util::reftype( $val ) || ''; if ($type eq "SCALAR") { my $copy = $$val; $kid = tie $$val => 'IPC::Shareable', $key, { %opts } or do { require Carp; Carp::croak "Could not create inner tie"; }; $$val = $copy; } elsif ($type eq "ARRAY") { my @copy = @$val; $kid = tie @$val => 'IPC::Shareable', $key, { %opts } or do { require Carp; Carp::croak "Could not create inner tie"; }; @$val = @copy; } elsif ($type eq "HASH") { my %copy = %$val; $kid = tie %$val => 'IPC::Shareable', $key, { %opts } or do { require Carp; Carp::croak "Could not create inner tie"; }; %$val = %copy; } else { require Carp; Carp::croak "Variables of type $type not implemented"; } return $kid; } sub _is_kid { my $data = shift or return; my $type = Scalar::Util::reftype( $data ); return unless $type; my $obj; if ($type eq "HASH") { $obj = tied %$data; } elsif ($type eq "ARRAY") { $obj = tied @$data; } elsif ($type eq "SCALAR") { $obj = tied $$data; } if (ref $obj eq 'IPC::Shareable') { return $obj; } else { return; } } sub _need_tie { my $val = shift; my $type = Scalar::Util::reftype( $val ); return unless $type; if ($type eq "SCALAR") { return !(tied $$val); } elsif ($type eq "ARRAY") { return !(tied @$val); } elsif ($type eq "HASH") { return !(tied %$val); } else { return; } } sub _trace { require Carp; require Data::Dumper; my $caller = ' ' . (caller(1))[3] . " called with:\n"; my $i = -1; my @msg = map { ++$i; my $obj; if (ref eq 'IPC::Shareable') { ' ' . "\$_[$i] = $_: shmid: $_->{_shm}->{_id}; " . Data::Dumper->Dump([ $_->{_opts} ], [ 'opts' ]); } else { ' ' . Data::Dumper->Dump( [ $_ ] => [ "\_[$i]" ]); } } @_; Carp::carp "IPC::Shareable ($$) debug:\n", $caller, @msg; } sub _debug { require Carp; require Data::Dumper; local $Data::Dumper::Terse = 1; my $caller = ' ' . (caller(1))[3] . " tells us that:\n"; my @msg = map { my $obj; if (ref eq 'IPC::Shareable') { ' ' . "$_: shmid: $_->{_shm}->{_id}; " . Data::Dumper->Dump([ $_->{_opts} ], [ 'opts' ]); } else { ' ' . Data::Dumper::Dumper($_); } } @_; Carp::carp "IPC::Shareable ($$) debug:\n", $caller, @msg; }; 1; __END__ =head1 NAME IPC::Shareable - share Perl variables between processes =head1 SYNOPSIS use IPC::Shareable (':lock'); tie SCALAR, 'IPC::Shareable', GLUE, OPTIONS; tie ARRAY, 'IPC::Shareable', GLUE, OPTIONS; tie HASH, 'IPC::Shareable', GLUE, OPTIONS; (tied VARIABLE)->shlock; (tied VARIABLE)->shunlock; (tied VARIABLE)->shlock(LOCK_SH|LOCK_NB) or print "resource unavailable\n"; (tied VARIABLE)->remove; IPC::Shareable->clean_up; IPC::Shareable->clean_up_all; =head1 CONVENTIONS The occurrence of a number in square brackets, as in [N], in the text of this document refers to a numbered note in the L. =head1 DESCRIPTION IPC::Shareable allows you to tie a variable to shared memory making it easy to share the contents of that variable with other Perl processes. Scalars, arrays, and hashes can be tied. The variable being tied may contain arbitrarily complex data structures - including references to arrays, hashes of hashes, etc. The association between variables in distinct processes is provided by GLUE. This is an integer number or 4 character string[1] that serves as a common identifier for data across process space. Hence the statement tie $scalar, 'IPC::Shareable', 'data'; in program one and the statement tie $variable, 'IPC::Shareable', 'data'; in program two will bind $scalar in program one and $variable in program two. There is no pre-set limit to the number of processes that can bind to data; nor is there a pre-set limit to the complexity of the underlying data of the tied variables[2]. The amount of data that can be shared within a single bound variable is limited by the system's maximum size for a shared memory segment (the exact value is system-dependent). The bound data structures are all linearized (using Raphael Manfredi's Storable module) before being slurped into shared memory. Upon retrieval, the original format of the data structure is recovered. Semaphore flags can be used for locking data between competing processes. =head1 OPTIONS Options are specified by passing a reference to a hash as the fourth argument to the tie() function that enchants a variable. Alternatively you can pass a reference to a hash as the third argument; IPC::Shareable will then look at the field named B in this hash for the value of GLUE. So, tie $variable, 'IPC::Shareable', 'data', \%options; is equivalent to tie $variable, 'IPC::Shareable', { key => 'data', ... }; Boolean option values can be specified using a value that evaluates to either true or false in the Perl sense. NOTE: Earlier versions allowed you to use the word B for true and the word B for false, but support for this "feature" is being removed. B will still act as true (since it is true, in the Perl sense), but use of the word B now emits an (optional) warning and then converts to a false value. This warning will become mandatory in a future release and then at some later date the use of B will stop working altogether. The following fields are recognized in the options hash. =over 4 =item B The B field is used to determine the GLUE when using the three-argument form of the call to tie(). This argument is then, in turn, used as the KEY argument in subsequent calls to shmget() and semget(). The default value is IPC_PRIVATE, meaning that your variables cannot be shared with other processes. =item B B is used to control whether calls to tie() create new shared memory segments or not. If B is set to a true value, IPC::Shareable will create a new binding associated with GLUE as needed. If B is false, IPC::Shareable will not attempt to create a new shared memory segment associated with GLUE. In this case, a shared memory segment associated with GLUE must already exist or the call to tie() will fail and return undef. The default is false. =item B If B field is set to a true value, calls to tie() will fail (returning undef) if a data binding associated with GLUE already exists. If set to a false value, calls to tie() will succeed even if a shared memory segment associated with GLUE already exists. The default is false =item B The I argument is an octal number specifying the access permissions when a new data binding is being created. These access permission are the same as file access permissions in that 0666 is world readable, 0600 is readable only by the effective UID of the process creating the shared variable, etc. The default is 0666 (world readable and writable). =item B If set to a true value, the shared memory segment underlying the data binding will be removed when the process calling tie() exits (gracefully)[3]. Use this option with care. In particular you should not use this option in a program that will fork after binding the data. On the other hand, shared memory is a finite resource and should be released if it is not needed. The default is false =item B This field may be used to specify the size of the shared memory segment allocated. The default is IPC::Shareable::SHM_BUFSIZ(). =back Default values for options are key => IPC_PRIVATE, create => 0, exclusive => 0, destroy => 0, mode => 0, size => IPC::Shareable::SHM_BUFSIZ(), =head1 LOCKING IPC::Shareable provides methods to implement application-level advisory locking of the shared data structures. These methods are called shlock() and shunlock(). To use them you must first get the object underlying the tied variable, either by saving the return value of the original call to tie() or by using the built-in tied() function. To lock a variable, do this: $knot = tie $sv, 'IPC::Shareable', $glue, { %options }; ... $knot->shlock; or equivalently tie($scalar, 'IPC::Shareable', $glue, { %options }); (tied $scalar)->shlock; This will place an exclusive lock on the data of $scalar. You can also get shared locks or attempt to get a lock without blocking. IPC::Shareable makes the constants LOCK_EX, LOCK_SH, LOCK_UN, and LOCK_NB exportable to your address space with the export tags C<:lock>, C<:flock>, or C<:all>. The values should be the same as the standard C option arguments. if ( (tied $scalar)->shlock(LOCK_SH|LOCK_NB) ) { print "The value is $scalar\n"; (tied $scalar)->shunlock; } else { print "Another process has an exlusive lock.\n"; } If no argument is provided to C, it defaults to LOCK_EX. To unlock a variable do this: $knot->shunlock; or (tied $scalar)->shunlock; or $knot->shlock(LOCK_UN); # Same as calling shunlock There are some pitfalls regarding locking and signals about which you should make yourself aware; these are discussed in L. If you use the advisory locking, IPC::Shareable assumes that you know what you are doing and attempts some optimizations. When you obtain a lock, either exclusive or shared, a fetch and thaw of the data is performed. No additional fetch/thaw operations are performed until you release the lock and access the bound variable again. During the time that the lock is kept, all accesses are perfomed on the copy in program memory. If other processes do not honor the lock, and update the shared memory region unfairly, the process with the lock will not be in sync. In other words, IPC::Shareable does not enforce the lock for you. A similar optimization is done if you obtain an exclusive lock. Updates to the shared memory region will be postponed until you release the lock (or downgrade to a shared lock). Use of locking can significantly improve performance for operations such as iterating over an array, retrieving a list from a slice or doing a slice assignment. =head1 REFERENCES When a reference to a non-tied scalar, hash, or array is assigned to a tie()d variable, IPC::Shareable will attempt to tie() the thingy being referenced[4]. This allows disparate processes to see changes to not only the top-level variable, but also changes to nested data. This feature is intended to be transparent to the application, but there are some caveats to be aware of. First of all, IPC::Shareable does not (yet) guarantee that the ids shared memory segments allocated automagically are unique. The more automagical tie()ing that happens, the greater the chance of a collision. Secondly, since a new shared memory segment is created for each thingy being referenced, the liberal use of references could cause the system to approach its limit for the total number of shared memory segments allowed. =head1 OBJECTS IPC::Shareable implements tie()ing objects to shared memory too. Since an object is just a reference, the same principles (and caveats) apply to tie()ing objects as other reference types. =head1 DESTRUCTION perl(1) will destroy the object underlying a tied variable when then tied variable goes out of scope. Unfortunately for IPC::Shareable, this may not be desirable: other processes may still need a handle on the relevant shared memory segment. IPC::Shareable therefore provides an interface to allow the application to control the timing of removal of shared memory segments. The interface consists of three methods - remove(), clean_up(), and clean_up_all() - and the B option to tie(). =over 4 =item B As described in L, specifying the B option when tie()ing a variable coerces IPC::Shareable to remove the underlying shared memory segment when the process calling tie() exits gracefully. Note that any related shared memory segments created automagically by the use of references will also be removed. =item B (tied $var)->remove; Calling remove() on the object underlying a tie()d variable removes the associated shared memory segment. The segment is removed irrespective of whether it has the B option set or not and irrespective of whether the calling process created the segment. =item B IPC::Shareable->clean_up; This is a class method that provokes IPC::Shareable to remove all shared memory segments created by the process. Segments not created by the calling process are not removed. =item B IPC::Shareable->clean_up_all; This is a class method that provokes IPC::Shareable to remove all shared memory segments encountered by the process. Segments are removed even if they were not created by the calling process. =back =head1 EXAMPLES In a file called B: #!/usr/bin/perl -w use strict; use IPC::Shareable; my $glue = 'data'; my %options = ( create => 'yes', exclusive => 0, mode => 0644, destroy => 'yes', ); my %colours; tie %colours, 'IPC::Shareable', $glue, { %options } or die "server: tie failed\n"; %colours = ( red => [ 'fire truck', 'leaves in the fall', ], blue => [ 'sky', 'police cars', ], ); ((print "server: there are 2 colours\n"), sleep 5) while scalar keys %colours == 2; print "server: here are all my colours:\n"; foreach my $c (keys %colours) { print "server: these are $c: ", join(', ', @{$colours{$c}}), "\n"; } exit; In a file called B #!/usr/bin/perl -w use strict; use IPC::Shareable; my $glue = 'data'; my %options = ( create => 0, exclusive => 0, mode => 0644, destroy => 0, ); my %colours; tie %colours, 'IPC::Shareable', $glue, { %options } or die "client: tie failed\n"; foreach my $c (keys %colours) { print "client: these are $c: ", join(', ', @{$colours{$c}}), "\n"; } delete $colours{'red'}; exit; And here is the output (the sleep commands in the command line prevent the output from being interrupted by shell prompts): bash$ ( ./server & ) ; sleep 10 ; ./client ; sleep 10 server: there are 2 colours server: there are 2 colours server: there are 2 colours client: these are blue: sky, police cars client: these are red: fire truck, leaves in the fall server: here are all my colours: server: these are blue: sky, police cars =head1 RETURN VALUES Calls to tie() that try to implement IPC::Shareable will return true if successful, I otherwise. The value returned is an instance of the IPC::Shareable class. =head1 AUTHOR Benjamin Sugars =head1 NOTES =head2 Footnotes from the above sections =over 4 =item 1 If GLUE is longer than 4 characters, only the 4 most significant characters are used. These characters are turned into integers by unpack()ing them. If GLUE is less than 4 characters, it is space padded. =item 2 IPC::Shareable provides no pre-set limits, but the system does. Namely, there are limits on the number of shared memory segments that can be allocated and the total amount of memory usable by shared memory. =item 3 If the process has been smoked by an untrapped signal, the binding will remain in shared memory. If you're cautious, you might try $SIG{INT} = \&catch_int; sub catch_int { die; } ... tie $variable, IPC::Shareable, 'data', { 'destroy' => 'Yes!' }; which will at least clean up after your user hits CTRL-C because IPC::Shareable's END method will be called. Or, maybe you'd like to leave the binding in shared memory, so subsequent process can recover the data... =item 4 This behaviour is markedly different from previous versions of IPC::Shareable. Older versions would sometimes tie() referenced thingies, and sometimes not. The new approach is more reliable (I think) and predictable (certainly) but uses more shared memory segments. =back =head2 General Notes =over 4 =item o When using shlock() to lock a variable, be careful to guard against signals. Under normal circumstances, IPC::Shareable's END method unlocks any locked variables when the process exits. However, if an untrapped signal is received while a process holds an exclusive lock, DESTROY will not be called and the lock may be maintained even though the process has exited. If this scares you, you might be better off implementing your own locking methods. One advantage of using C on some known file instead of the locking implemented with semaphores in IPC::Shareable is that when a process dies, it automatically releases any locks. This only happens with IPC::Shareable if the process dies gracefully. The alternative is to attempt to account for every possible calamitous ending for your process (robust signal handling in Perl is a source of much debate, though it usually works just fine) or to become familiar with your system's tools for removing shared memory and semaphores. This concern should be balanced against the significant performance improvements you can gain for larger data structures by using the locking mechanism implemented in IPC::Shareable. =item o There is a program called ipcs(1/8) (and ipcrm(1/8)) that is available on at least Solaris and Linux that might be useful for cleaning moribund shared memory segments or semaphore sets produced by bugs in either IPC::Shareable or applications using it. =item o This version of IPC::Shareable does not understand the format of shared memory segments created by versions prior to 0.60. If you try to tie to such segments, you will get an error. The only work around is to clear the shared memory segments and start with a fresh set. =item o Iterating over a hash causes a special optimization if you have not obtained a lock (it is better to obtain a read (or write) lock before iterating over a hash tied to Shareable, but we attempt this optimization if you do not). The fetch/thaw operation is performed when the first key is accessed. Subsequent key and and value accesses are done without accessing shared memory. Doing an assignment to the hash or fetching another value between key accesses causes the hash to be replaced from shared memory. The state of the iterator in this case is not defined by the Perl documentation. Caveat Emptor. =back =head1 CREDITS Thanks to all those with comments or bug fixes, especially Maurice Aubrey Stephane Bortzmeyer Doug MacEachern Robert Emmery Mohammed J. Kabir Terry Ewing Tim Fries Joe Thomas Paul Makepeace Raphael Manfredi Lee Lindley Dave Rolsky =head1 BUGS Certainly; this is beta software. When you discover an anomaly, send an email to me at bsugars@canoe.ca. =head1 SEE ALSO perl(1), perltie(1), Storable(3), shmget(2), ipcs(1), ipcrm(1) and other SysV IPC man pages. =cut IPC-Shareable-0.61/lib/IPC/Shareable/SharedMem.pm000644 000765 000024 00000007252 12036131453 021677 0ustar00msouthstaff000000 000000 package IPC::Shareable::SharedMem; use strict; use constant DEBUGGING => ($ENV{SHM_DEBUG} or 0); use IPC::SysV qw(IPC_RMID); my $Def_Size = 1024; sub _trace { require Carp; require Data::Dumper; my $caller = ' ' . (caller(1))[3] . " called with:\n"; my $i = -1; my @msg = map { ++$i; ' ' . Data::Dumper->Dump( [ $_ ] => [ "\_[$i]" ]); } @_; Carp::carp "IPC::SharedMem debug:\n", $caller, @msg; } sub _debug { require Carp; require Data::Dumper; local $Data::Dumper::Terse = 1; my $caller = ' ' . (caller(1))[3] . " tells us that:\n"; my @msg = map { ' ' . Data::Dumper::Dumper($_) } @_; Carp::carp "IPC::SharedMem debug:\n", $caller, @msg; }; sub default_size { _trace @_ if DEBUGGING; my $class = shift; $Def_Size = shift if @_; return $Def_Size; } sub new { _trace @_ if DEBUGGING; my($class, $key, $size, $flags) = @_; defined $key or do { require Carp; Carp::croak "usage: IPC::SharedMem->new(KEY, [ SIZE, [ FLAGS ] ])"; }; $size ||= $Def_Size; $flags ||= 0; _debug "calling shmget() on ", $key, $size, $flags if DEBUGGING; my $id = shmget($key, $size, $flags); defined $id or do { require Carp; Carp::carp "IPC::Shareable::SharedMem: shmget: $!\n"; return undef; }; my $sh = { _id => $id, _size => $size, _flags => $flags, }; return bless $sh => $class; } sub id { _trace @_ if DEBUGGING; my $self = shift; $self->{_id} = shift if @_; return $self->{_id}; } sub flags { _trace @_ if DEBUGGING; my $self = shift; $self->{_flags} = shift if @_; return $self->{_flags}; } sub size { _trace @_ if DEBUGGING; my $self = shift; $self->{_size} = shift if @_; return $self->{_size}; } sub shmwrite { _trace @_ if DEBUGGING; my($self, $data) = @_; _debug "calling shmwrite() on ", $self->{_id}, $data, 0, $self->{_size} if DEBUGGING; return shmwrite($self->{_id}, $data, 0, $self->{_size}); } sub shmread { _trace @_ if DEBUGGING; my $self = shift; my $data = ''; _debug "calling shread() on ", $self->{_id}, $data, 0, $self->{_size} if DEBUGGING; shmread($self->{_id}, $data, 0, $self->{_size}) or return; _debug "got ", $data, " from shm segment $self->{_id}" if DEBUGGING; return $data; } sub remove { _trace @_ if DEBUGGING; my $self = shift; my $op = shift; my $arg = 0; return shmctl($self->{_id}, IPC_RMID, $arg); } 1; =head1 NAME IPC::Shareable::SharedMem - Object oriented interface to shared memory =head1 SYNOPSIS *** No public interface *** =head1 WARNING This module is not intended for public consumption. It is used internally by IPC::Shareable to access shared memory. It will probably be replaced soon by IPC::ShareLite or IPC::SharedMem (when someone writes it). =head1 DESCRIPTION This module provides and object-oriented framework to access shared memory. Its use is intended to be limited to IPC::Shareable. Therefore I have not documented an interface. =head1 AUTHOR Ben Sugars (bsugars@canoe.ca) =head1 SEE ALSO IPC::Shareable, IPC::SharedLite IPC-Shareable-0.61/eg/client000755 000765 000024 00000000635 12036131453 016222 0ustar00msouthstaff000000 000000 #!/usr/bin/perl -w use strict; use IPC::Shareable; my $glue = 'data'; my %options = ( create => 'no', exclusive => 'no', mode => 0644, destroy => 'no', ); tie %colours, IPC::Shareable, $glue, { %options } or die "client: tie failed\n"; foreach my $c (keys %colours) { print "client: these are $c: ", join(', ', @{$colours{$c}}), "\n"; } delete $colours{'red'}; exit; IPC-Shareable-0.61/eg/get000755 000765 000024 00000001210 12036131453 015511 0ustar00msouthstaff000000 000000 #!/usr/bin/perl -w # # Test of shared arrays courtesy Terry Ewing # See also eg/put use lib "."; use IPC::Shareable; use strict; my @shared; my $ipch = tie @shared, 'IPC::Shareable', "foco", { create => 1, exclusive => 'no', mode => 0666, size => 1024*512 }; while (1) { $ipch->shlock; my $line = shift(@shared); $ipch->shunlock; if ($line) { print $line."\n"; } # sleep(2); } IPC-Shareable-0.61/eg/hvtest1000755 000765 000024 00000001437 12036131453 016343 0ustar00msouthstaff000000 000000 #!/usr/bin/perl -w # # Test of shared hashes courtesy Joe Thomas use strict; use IPC::Shareable; use vars qw($counter %hash); tie %hash, 'IPC::Shareable', undef, {create => 'yes', destroy => 'yes'}; tie $counter, 'IPC::Shareable', undef, {create => 'yes', destroy => 'yes'}; $| = 1; for (my $i = 0; $i < 3; $i++) { sleep 1; next if fork(); hashcount(3, 3); exit; } while (1) { last if wait() == -1; } sub hashcount { my ($loops, $sleeptime) = @_; for (my $i = 0; $i < $loops; $i++) { (tied $counter)->shlock; (tied %hash)->shlock; $hash{++$counter} = $$; print "Process $$ sees:\n"; for my $key (sort keys %hash) { print "\$hash{$key} = $hash{$key}\n"; } (tied %hash)->shunlock; (tied $counter)->shunlock; sleep $sleeptime; } } exit; __END__ IPC-Shareable-0.61/eg/hvtest2000755 000765 000024 00000003154 12036131453 016342 0ustar00msouthstaff000000 000000 #!/usr/bin/perl -w # # Test of shared hashes courtesy Robert Emmery use IPC::Shareable; use Data::Dumper; use strict; my %shareOpts = ( create => 'yes', exclusive => 'no', mode => 0644, destroy => 'yes', ); my %childShareOpts = ( create => 'no', exclusive => 'no', mode => 0644, destroy => 'yes' ); $SIG{'INT'} = sub { die; }; # create shared memory segment my %hashTable = (); print "\n\nPress any key to start.. (Press Ctrl+C to exit)\n\n"; ; tie(%hashTable, 'IPC::Shareable', "glue", {%shareOpts }) || die "Failed to share hashTable"; if (fork() == 0) { # we're in process 1 # tie to hashTable... tie(%hashTable, 'IPC::Shareable', "glue", {%childShareOpts} ) || die "Failed to tie from process 1"; my $count = 0; while (1) { (tied %hashTable)->shlock(); $hashTable{$count++ . " - proc 1"} = "proc 1"; print "proc 1: " . Dumper(\%hashTable); (tied %hashTable)->shunlock(); sleep(2); } } if (fork() == 0) { # we're in proces 2 # tie to hashTable... tie(%hashTable, 'IPC::Shareable', "glue", {%childShareOpts} ) || die "Failed to tie from process 2"; my $count = 0; while (1) { (tied %hashTable)->shlock(); $hashTable{$count++ . " - proc 2"} = "proc 2"; print "proc 2: " . Dumper(\%hashTable); (tied %hashTable)->shunlock(); sleep(2); } } # do not exit as shared memory will get lost while (1) { sleep(9999); } IPC-Shareable-0.61/eg/put000755 000765 000024 00000001176 12036131453 015555 0ustar00msouthstaff000000 000000 #!/usr/bin/perl -w # # Test of shared arrays courtesy Terry Ewing # See also eg/get use lib "."; use IPC::Shareable; use strict; my @shared; my $ipch = tie @shared, 'IPC::Shareable', "foco", { create => 1, exclusive => 'no', mode => 0666, size => 1024*512 }; for (my $i = 1;; $i++) { $ipch->shlock; push(@shared, $i."-----".$i); $ipch->shunlock; sleep(2); } IPC-Shareable-0.61/eg/server000755 000765 000024 00000001234 12036131453 016246 0ustar00msouthstaff000000 000000 #!/usr/bin/perl -w use strict; use IPC::Shareable; my $glue = 'data'; my %options = ( create => 'yes', exclusive => 'no', mode => 0644, destroy => 'yes', ); tie %colours, 'IPC::Shareable', $glue, { %options } or die "server: tie failed\n"; %colours = ( red => [ 'fire truck', 'leaves in the fall', ], blue => [ 'sky', 'police cars', ], ); ((print "server: there are 2 colours\n"), sleep 5) while scalar keys %colours == 2; print "server: here are all my colours:\n"; foreach my $c (keys %colours) { print "server: these are $c: ", join(', ', @{$colours{$c}}), "\n"; } exit;