POE-Component-Server-SimpleHTTP-2.18/000755 001751 001751 00000000000 12164634317 020037 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.18/inc/000755 001751 001751 00000000000 12164634317 020610 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.18/README000644 001751 001751 00000000401 12143730252 020702 0ustar00bingosbingos000000 000000 POE/Component/Server/SimpleHTTP =============================== INSTALLATION To install this module type the following: perl Makefile.PL make make test make install MORE INFO # After installing: perldoc POE::Component::Server::SimpleHTTP POE-Component-Server-SimpleHTTP-2.18/t/000755 001751 001751 00000000000 12164634317 020302 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.18/examples/000755 001751 001751 00000000000 12164634317 021655 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.18/MANIFEST000644 001751 001751 00000001453 12143730252 021163 0ustar00bingosbingos000000 000000 Changes Changes.svn examples/prefork.pl examples/proxy.pl examples/server.pl examples/stream.pl inc/Module/Install.pm inc/Module/Install/AutoLicense.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/GithubMeta.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/POE/Component/Server/SimpleHTTP.pm lib/POE/Component/Server/SimpleHTTP/Connection.pm lib/POE/Component/Server/SimpleHTTP/Response.pm lib/POE/Component/Server/SimpleHTTP/State.pm LICENSE Makefile.PL MANIFEST This list of files META.yml README t/01_load.t t/02_simple.t t/03_bad_handler.t t/03_bad_request.t t/04_run_close.t t/04_run_keepalive.t t/05_post.t t/06_stream.t t/99_pod.t t/99_pod_coverage.t tools/git-log.pl POE-Component-Server-SimpleHTTP-2.18/lib/000755 001751 001751 00000000000 12164634317 020605 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.18/META.yml000644 001751 001751 00000002650 12164634255 021314 0ustar00bingosbingos000000 000000 --- abstract: 'Perl extension to serve HTTP requests in POE.' author: - 'Apocalypse ' build_requires: ExtUtils::MakeMaker: 6.59 POE::Filter::HTTP::Parser: 1.06 Test::More: 0.47 Test::POE::Client::TCP: 0.1 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: POE-Component-Server-SimpleHTTP no_index: directory: - examples - inc - t provides: POE::Component::Server::SimpleHTTP: file: lib/POE/Component/Server/SimpleHTTP.pm version: 2.18 POE::Component::Server::SimpleHTTP::Connection: file: lib/POE/Component/Server/SimpleHTTP/Connection.pm version: 2.18 POE::Component::Server::SimpleHTTP::Response: file: lib/POE/Component/Server/SimpleHTTP/Response.pm version: 2.18 POE::Component::Server::SimpleHTTP::State: file: lib/POE/Component/Server/SimpleHTTP/State.pm version: 2.18 requires: Carp: 0 HTTP::Date: 0 HTTP::Request: 0 HTTP::Response: 0 Moose: 0.9 MooseX::POE: 0.205 POE: 1.0000 Socket: 0 Storable: 0 Sys::Hostname: 0 perl: 5.6.0 resources: homepage: https://github.com/bingos/poe-component-server-simplehttp/tree license: http://dev.perl.org/licenses/ repository: git://github.com/bingos/poe-component-server-simplehttp.git version: 2.18 POE-Component-Server-SimpleHTTP-2.18/tools/000755 001751 001751 00000000000 12164634317 021177 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.18/LICENSE000644 001751 001751 00000044145 12164634252 021052 0ustar00bingosbingos000000 000000 This software is copyright (c) 2013 by Apocalypse, Chris Williams, Eriam Schaffter, Marlon Bailey and Philip Gwyn. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2013 by Apocalypse, Chris Williams, Eriam Schaffter, Marlon Bailey and Philip Gwyn. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2013 by Apocalypse, Chris Williams, Eriam Schaffter, Marlon Bailey and Philip Gwyn. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End POE-Component-Server-SimpleHTTP-2.18/Changes000644 001751 001751 00000101752 12164634323 021335 0ustar00bingosbingos000000 000000 ============================== 2013-07-02 21:30:49 +0100 2.18 ============================== commit b09281bb3701530b072356b94cac20a794ea907b Author: Chris 'BinGOs' Williams Date: Tue Jul 2 21:30:49 2013 +0100 Bump to version 2.18 commit 12c3469f10017d3778a34751fd2f0bc5cd64dd85 Author: Chris 'BinGOs' Williams Date: Tue Jul 2 21:24:04 2013 +0100 Don't use MooseX::AttributeHelpers anymore ============================== 2012-10-22 10:10:15 +0100 2.16 ============================== commit ddd1e079da7f39803ebfae0ced9022987f3f3f83 Author: Chris 'BinGOs' Williams Date: Mon Oct 22 10:10:15 2012 +0100 Bump to version 2.16 to update included Module::Install ============================== 2011-12-28 11:41:15 +0000 2.14 ============================== commit e890e99cdfb6463dd4ddee9c1ce4ff822e540dc4 Author: Chris 'BinGOs' Williams Date: Wed Dec 28 11:41:15 2011 +0000 Bump to version 2.14 commit 7b003a8999684b509522c2fe443e14a38137a789 Author: Thorsten Schwinn Date: Wed Dec 28 11:38:52 2011 +0000 Resolve crash with bad http request Signed-off-by: Chris 'BinGOs' Williams ============================== 2011-05-14 11:13:32 +0100 2.12 ============================== commit b0992bad00d249173ee5ff8b156fcf345156dd61 Author: Chris 'BinGOs' Williams Date: Sat May 14 11:13:32 2011 +0100 Bump version commit 56f65f688bb69c6a222b9d43fff71babd5df683e Author: Adrian Yee Date: Sat May 14 10:59:45 2011 +0100 [RT #67951] Patch: Keep alive connections aren't reset properly after streaming Ticket If keep-alives are enabled and streaming is used, the connection state isn't reset properly causing the wrong output on subsequent requests. Signed-off-by: Chris 'BinGOs' Williams commit abf359178399cbeb32522853690abd797e91dfcd Author: Adrian Yee Date: Sat May 14 10:53:51 2011 +0100 [RT #67949] Patch: Connection closes before last flush while streaming Ticket Since the pod isn't complete for how to properly stream, I'm not 100% sure this patch is correct, but here goes anyways. After you've completed streaming and you call DONE, it always yields got_flush regardless if POE::Wheel::ReadWrite has something left in its buffer to flush. Executing the got_flush event when it has data left in its buffer leads to SimpleHTTP resetting/closing the connection prematurely. This patch fixes it by allowing ReadWrite to flush the last chunk itself. Signed-off-by: Chris 'BinGOs' Williams ============================== 2011-03-08 00:28:07 +0000 2.10 ============================== commit 0425908e6f4c9708ed6649c8ab72c074599d8c14 Author: Chris 'BinGOs' Williams Date: Tue Mar 8 00:28:07 2011 +0000 Update build requirements and dist fixes ============================== 2011-01-12 20:05:05 +0000 2.08 ============================== commit 16849949bbe6b539d549bd7d5713f49441c64471 Author: Chris 'BinGOs' Williams Date: Wed Jan 12 20:05:05 2011 +0000 Bumper version commit eeb9dd8ee9741a6ec363a2d2cdb1667ce2048488 Author: Ed Heil Date: Wed Jan 12 20:03:10 2011 +0000 [PATCH] possible issue with connections RT #64718 In using POE::Component::Server::SimpleHTTP v. 2.06, we've come across a problem with error messages such as: Can't call method "dead" on an undefined value at [...]/POE/Component/Server/SimpleHTTP.pm line 840. The line is: # Mark the client dead $connection->dead(1); This happens when our load balancer makes a check to make sure the port is open where the SimpleHTTP server is listening. We've fixed it with: # Mark the client dead $connection->dead(1) if $connection; I'm afraid at this point I haven't got the ability to do the low-level debugging necessary to determine exactly how $connection comes to be undef, or whether this is the best way to accomplish the fix in the big picture, but I wanted to share the fix in case you found it useful. Signed-off-by: Chris 'BinGOs' Williams ============================== 2010-12-03 23:50:53 +0000 2.06 ============================== commit 022177b74b1baa9af4420583a399faea60489251 Author: Chris 'BinGOs' Williams Date: Fri Dec 3 23:50:53 2010 +0000 Bump version commit 061fb63b793ebef311ed3436878e2886956dfd1a Author: donor.com Date: Fri Dec 3 23:48:26 2010 +0000 RT #63575 Crash in LOG2HANDLER With a LOG2HANDLER, dies is DONE event handler. Fix is to use method call rather than array de-reference. Signed-off-by: Chris 'BinGOs' Williams commit ba403870437ffa02bc16e2b6b357568c752093a7 Author: Chris 'BinGOs' Williams Date: Wed May 19 12:04:08 2010 +0100 Sync changes ============================== 2010-05-19 11:30:49 +0100 2.04 ============================== commit 962ff9855c25fbe08f02579d6021a1f25e764561 Author: Chris 'BinGOs' Williams Date: Wed May 19 11:30:49 2010 +0100 Bump to version 2.04 commit 596632447b8f0450b1cd031af33e7daf78c57c4d Author: Markus Jansen Date: Wed May 19 11:12:10 2010 +0100 Patch applied from Markus Jansen which adds 'sslintermediatecacert' option. commit 5ab8239c11b6093a076eabae9c5be68ecba41a03 Author: Chris 'BinGOs' Williams Date: Fri May 14 13:13:08 2010 +0100 Fix the versions ============================== 2010-05-14 13:07:50 +0100 2.02 ============================== commit 50765bec1584aa54ad59c4202fa5cfc1443875b5 Author: Chris 'BinGOs' Williams Date: Fri May 14 13:07:50 2010 +0100 Applied fixes as per Jeremy Johnson's recommendations in RT #44111 It looks as though this patch has been included in SimpleHTTP 2.0 . however, now it falls to line 813 $connection = $self->_requests->{$id}->response->connection; and dies because $self->_requests->{$id}->response is undefined. I've wrapped that in some defensive code: if(defined $self->_requests->{$id}->response) { $connection = $self->_requests->{$id}->response->connection; } else { warn "response for $id is undefined" if DEBUG; } and also the $connection->dead(1) line below. I'm not sure if this leaves something in a bad state yet.. there isn't a CLOSE_WAIT socket left hanging, at least. I also tried sending a "/\n\n" into the SOAP port and the request fell into the "malformed request" code in SimpleHTTP . this time , the module dies at line 585: $response->connection( $connection ); because connection is defined as "ro" . commit 420aa7d746b08a5e7b51024e2693ab1e275b09e2 Author: Chris 'BinGOs' Williams Date: Fri May 14 12:43:28 2010 +0100 Sync Changes ============================== 2009-09-03 13:26:53 +0100 2.00 ============================== commit 35e4fda218be31f662d6855545f6e17521b3f810 Author: Chris Williams Date: Thu Sep 3 13:26:53 2009 +0100 Bump to a stable release commit e1cc0a8738638731e684cbb72e9fad1e46674fb8 Author: Chris Williams Date: Thu Sep 3 13:20:02 2009 +0100 Update to Changes ================================= 2009-08-21 16:08:58 +0100 1.99_03 ================================= commit e12d35c425eba7866fdc6a96728d74e476531af8 Author: Chris Williams Date: Fri Aug 21 16:08:58 2009 +0100 Prepare for a CPAN development release commit f090b426eaa4e16357507d344b595744e61d44a5 Author: Chris Williams Date: Fri Aug 21 16:03:33 2009 +0100 Removed PreFork subclass and tests. It will have its own distribution from now on. ================================= 2009-07-07 16:11:32 +0100 1.99_02 ================================= commit b42a9a28f21a5f010a372903aaa92fe0a3e56466 Author: Chris Williams Date: Tue Jul 7 16:11:32 2009 +0100 Bump version for a CPAN release commit 85d1e4c81fd4426f0af5168c2a8b91c6090e5d0c Author: Chris Williams Date: Fri Jun 19 16:58:45 2009 +0100 Moved around the event handlers in PreFork commit aa853233329a161c1538009238d10c2a7d945167 Author: Chris Williams Date: Fri Jun 19 14:07:06 2009 +0100 Removed some debugging warnings commit abd283a873b0f7e44f1604a3ceb488b7435637ab Author: Chris Williams Date: Fri Jun 19 14:01:15 2009 +0100 Added no MooseX::POE and make_immutable to PreFork. commit 537fd7c1d803d7fdb8b4c4ba36df21d87ebe63a8 Author: Chris Williams Date: Fri Jun 19 13:25:02 2009 +0100 Added some debug code. commit 5bb1c987daa6ab1b61f06d5c4ca5e3e6713d6a9e Author: Chris Williams Date: Wed Jun 17 11:36:36 2009 +0100 Worked out that START events are called top down. commit 12cf3f7f4fdce841057b8db7a3e48d7b48377095 Author: Chris Williams Date: Wed Jun 17 10:38:28 2009 +0100 Added prefork example commit 0262174071f5b05a6006417d7b7a315d1449074c Author: Chris Williams Date: Wed Jun 17 10:10:37 2009 +0100 Some more PreFork fixes, mainly with the SUPER calls commit c5dee2f3b20150c3db71f36dd1e38de15bba465e Author: Chris Williams Date: Wed Jun 17 09:46:44 2009 +0100 More PreFork fixes. commit 568e31352fcc88ed6ac76f53b90a2d7b9b0aa2e2 Author: Chris Williams Date: Wed Jun 17 09:37:36 2009 +0100 More PreFork refactoring. commit e07e0083f0011e36bb9a6ee5eb18aa09f3428502 Author: Chris Williams Date: Wed Jun 17 00:24:26 2009 +0100 Refactored big chunks of code including PreFork \o/ commit 79c8bc3d039ecdb09a757d25ac951aeb97c46a16 Author: Chris Williams Date: Mon Jun 15 14:50:45 2009 +0100 Getting there with the refactoring, but coming to the conclusion that the internal logic is like a dog's breakfast commit 2687b868eb109ba4c990d29c5414221baf172dfd Author: Chris Williams Date: Mon Jun 15 10:23:01 2009 +0100 Minor changes prior to refactoring the streaming support commit 4315e0aa346043fe6829d2fce4bd714d72de684d Author: Chris Williams Date: Fri Jun 12 11:10:20 2009 +0100 Resolved annoying warnings. commit 693a5e2581eabbd6a6d29fea6ea64245ab5cc90e Author: Chris Williams Date: Fri Jun 12 10:54:22 2009 +0100 Bump version for a development CPAN release commit 9415836496521ef98258adc6cc9d3b00babd5bea Author: Chris Williams Date: Fri Jun 12 10:41:21 2009 +0100 Add meta to Makefile.PL, debug issues with the streaming. commit ac3f3fee754f6275a615f2d4021257335f0c0202 Author: Chris Williams Date: Fri Jun 12 09:09:53 2009 +0100 Minor changes to filters and the streaming code commit 389dc427c3ce393cde2d80f8908f74156a220d84 Author: Chris Williams Date: Thu Jun 11 23:42:44 2009 +0100 Refactored to use MooseX::POE commit a4888173e26c1a80119ad0b9e8500dcc16cfddd9 Author: Chris Williams Date: Tue Jun 9 12:58:41 2009 +0100 Moosified the fake HTTP::Response object. Tracked down usage in main module and fixed. commit 55a252278184b9ce8e1c3980a7ac78f15e5fbe20 Author: Chris Williams Date: Tue Jun 9 00:11:42 2009 +0100 Moosified the connection object commit 452b83f62ed92ffb6cc692529ac8c167db363ea2 Author: Chris Williams Date: Mon Jun 8 22:01:28 2009 +0100 Fixes for running in PROXYMODE commit 0e1767b44efe1af343720589dcaf537d89858ff5 Author: Chris Williams Date: Sat Mar 14 17:01:20 2009 +0000 Blank Changes file ready for git log output commit 87d5ee0186e07fddeb1eb64c12ae7b5dcdfc7338 Author: Chris Williams Date: Sat Mar 14 17:00:28 2009 +0000 Moved old svn Changes file to Changes.svn. Updated dist PREOP to run git log commit 1da3bf7af568eebeccec2b67994cbf726aa544c2 Author: Chris Williams Date: Sat Mar 14 15:53:17 2009 +0000 Removed the svn-log.perl script no longer required now on git commit 93fc97493c6d990e0e1594d191c588f98cee79c7 Author: Chris Williams Date: Sat Mar 14 15:47:08 2009 +0000 Fixed problem with socket closing. Reported by Sean Pieper [RT #44111] but also addresses [RT #27120] ============================== 2009-03-09 23:39:43 +0000 1.58 ============================== commit a6592d1eaf1270e0d91fdb5b85c5c2caed4fa7c4 Author: Chris Williams Date: Mon Mar 9 23:38:21 2009 +0000 Fixed an issue in Prefork with SSLify reported by Hubert Lubaczewski ============================== 2009-02-26 16:24:08 +0000 1.56 ============================== commit c92d30c35c4275970724d5e896d819cbe9ed4262 Author: Chris Williams Date: Thu Feb 26 16:21:41 2009 +0000 ADDRESS was not being passed through to the SocketFactory as an option. It does now ============================== 2009-01-23 07:27:00 +0000 1.54 ============================== commit f520abed8cb248bd990d12343e7b93227d6fc41d Author: Chris Williams Date: Fri Jan 23 07:23:17 2009 +0000 Move testsuite to use POE::Filter::HTTP::Parser, perltidy everything, bump version ================================= 2009-01-22 08:50:54 +0000 1.53_03 ================================= commit c552bab37bd21c9bf6a2fe072878cb6bb9e5572c Author: Chris Williams Date: Thu Jan 22 08:50:31 2009 +0000 Bump development release version commit be9f5bb6aad99f84fe2e022f732512feba786a76 Author: Chris Williams Date: Thu Jan 22 08:49:21 2009 +0000 Ran perltidy against SimpleHTTP.pm, fixed keepalive test ================================= 2009-01-21 14:05:58 +0000 1.53_02 ================================= commit fc4136abb85ce0b737aa9f522cf5ddb369d9063d Author: Chris Williams Date: Wed Jan 21 14:05:18 2009 +0000 Forgot the dependency on Test::POE::Client::TCP for the new tests. doh. ================================= 2009-01-20 16:07:32 +0000 1.53_01 ================================= commit 17e7711217b9a8f8da5fd1426d088e9bffa2d1c1 Author: Chris Williams Date: Tue Jan 20 16:06:43 2009 +0000 Give it a development version and ship for the CPAN Testers to smoke commit baf41178256bebe57744a5903904edfb9beeabbf Author: Chris Williams Date: Tue Jan 20 16:00:37 2009 +0000 Houston we appear to have a refactored testsuite. Yes, it really works. And consistently as well. hurrah commit c2194b002416512b39e5144b438425f94ac0be3f Author: Chris Williams Date: Mon Jan 19 21:23:03 2009 +0000 Hopefully fixed mysteriously failing tests, by making the STDOUT "hot" in the forked process ============================== 2009-01-19 21:23:50 +0000 1.52 ============================== commit 0b061e5e77771d5aaaf8cb78389e5785be6fa59f Author: Chris Williams Date: Mon Jan 19 21:23:50 2009 +0000 CPAN Release 1.52 commit bb59adbff1d857a7608369a9e12b87ed17923552 Author: Chris Williams Date: Mon Jan 19 21:07:42 2009 +0000 Fix [rt.cpan.org #42444] reported by pravus ============================== 2008-12-17 10:42:57 +0000 1.50 ============================== commit 9df9761d1051971c84cb2b17c69c7c554ec9273a Author: Chris Williams Date: Wed Dec 17 10:39:28 2008 +0000 Fix applied for RT #41780 commit ac08764873c02a567177f6f36f50d4588625c6c2 Author: Chris Williams Date: Sat Nov 15 08:53:26 2008 +0000 Some code tidying ============================== 2008-09-05 15:39:31 +0000 1.48 ============================== commit 4062c6488a7c30d7dd739142a2c9761f3c6725fa Author: Chris Williams Date: Fri Sep 5 15:36:56 2008 +0000 Added makemaker_args() directive to Makefile.PL, thanks to Matt Trout for that tip commit 45521dd970d03f8ecc48b2db52afb9f37ed80a7c Author: Chris Williams Date: Fri Sep 5 15:34:46 2008 +0000 Removed the FATAL => 'all' from use warnings. suggested by Andreas Gudmundsson commit 221f0ac7ab2637ae194253b35e81b4dd72e311d5 Author: Chris Williams Date: Fri Sep 5 15:24:08 2008 +0000 Downstream Debian patch applied RT #38743 by Martin Ferrari ============================== 2008-04-14 12:09:28 +0000 1.46 ============================== commit f883d46c7eab5092a6001d2c9a3b47f27dd62709 Author: Chris Williams Date: Mon Apr 14 12:08:42 2008 +0000 Fixed PROXYMODE setting handling ============================== 2008-04-14 11:30:47 +0000 1.44 ============================== commit 55d2ab467d607bee4151d536c57180b5d8e989ca Author: Chris Williams Date: Mon Apr 14 11:27:08 2008 +0000 Added PROXYMODE setting commit 99b81e26da47219eee5e422b4a2fff184a892f44 Author: Eriam Schaffter Date: Thu Apr 3 15:18:15 2008 +0000 Dont flush option added in the Response object and corrected case. commit a93c29b1edba05828ba3b64cb0beed67b86e7ea0 Author: Agaran Date: Fri Feb 22 01:12:35 2008 +0000 - BinGOs, dont kill me, but i like to have todo to consider commit 4e546fe1ffc8d5b5bb39332475bcdc20c5bc0b8c Author: Agaran Date: Fri Feb 22 00:42:03 2008 +0000 - random port used for testing, helped for me in few cases commit 2a24d6295c1147d39af5e2459951ef640e4fa091 Author: Agaran Date: Wed Feb 20 20:49:27 2008 +0000 - missed one letter commit ab42d90330a76f0cc5cadadb4155473341edc9a4 Author: Agaran Date: Wed Feb 20 17:16:43 2008 +0000 - new LOG2HANDLER which is fired after servicing request ============================== 2008-02-13 08:42:59 +0000 1.42 ============================== commit 082169dff1d46e3790624e80d1f2806b51f89d02 Author: Chris Williams Date: Wed Feb 13 08:29:28 2008 +0000 Increased the requirement of PoCo-Client-HTTP to version 0.82 as per RT#33201 ============================== 2008-01-17 15:32:57 +0000 1.40 ============================== commit e6224b13e7eb87ea0db4e06b87a2bf076e48463f Author: Chris Williams Date: Thu Jan 17 15:31:39 2008 +0000 "Fixed" the uppercase options annoyance. Hurrah. ============================== 2008-01-17 14:53:21 +0000 1.38 ============================== commit 6eb8c8c8001619c663d5417acdf9317cc94f937b Author: Chris Williams Date: Thu Jan 17 14:45:39 2008 +0000 Amended the test count in 09_prefork test, reported by UltraDM. ============================== 2008-01-14 21:26:41 +0000 1.36 ============================== commit f276e8952eb2e5672c3345b482ed405c47f375a2 Author: Chris Williams Date: Mon Jan 14 21:25:39 2008 +0000 Applied a patch from Maciej Pijanka (agaran) ============================== 2008-01-09 15:29:51 +0000 1.34 ============================== commit 7901990cbeb12f364935c9e9dbf4261d4f6051a5 Author: Chris Williams Date: Wed Jan 9 09:41:15 2008 +0000 Bumped required version of POE to 0.9999 to fix problem with POE::Filter::HTTPD and bad requests ============================== 2008-01-08 10:13:14 +0000 1.32 ============================== commit 98e6bbc26939177f359d625051a28feedb1b582f Author: Chris Williams Date: Tue Jan 8 10:11:41 2008 +0000 Fixed problem with bad requests, reported by agaran ============================== 2007-12-21 16:59:05 +0000 1.30 ============================== commit a695c415fbbecb8f793a3aa388b42f7e3aa887cd Author: Chris Williams Date: Fri Dec 21 16:56:40 2007 +0000 Minor amendments prior to CPAN Release commit af6463cd518cb4e55c36ac676bca9687120ab1d0 Author: Philip Gwyn Date: Thu Dec 20 02:28:51 2007 +0000 Added build_requires LWP::ConnCache commit 0415728a992c60b0f7802627454c1ac0be63dbc2 Author: Philip Gwyn Date: Thu Dec 20 02:27:49 2007 +0000 Added HTTP/1.1 keep-alive support. - Off by default, turn on with KEEPALIVE=>1 - Added t/11_keepalive.t to test above Created Fix_Headers() which adds default response headers for both stream and normal responses. Responses to HEAD requests shouldn't have Content-Length set! Default content-type is now text/plain commit 7570629693c46096d72ee3e93b9b1738e3ed0510 Author: Philip Gwyn Date: Mon Dec 17 15:26:10 2007 +0000 Changed the on_close interface to 'SETCLOSEHANDLER' which is closer to the normal SimpleHTTP interface. commit e59a8976f938f42b48183d4bd2218f0630a84e8c Author: Philip Gwyn Date: Fri Dec 14 20:41:39 2007 +0000 Added Server::SimpleHTTP::Connection->ID Added Server::SimpleHTTP::Connection->on_close Modified t/05_run.t and t/06_stream.t to test the above Documented the above ============================== 2007-12-13 13:56:17 +0000 1.28 ============================== commit a6014c4ed9ff24dd63ba9898f53bf590a384a7f2 Author: Chris Williams Date: Thu Dec 13 13:55:58 2007 +0000 Bump version for release ================================= 2007-12-13 13:05:37 +0000 1.27_03 ================================= commit d36a6820c1d1efeed992e28018684760405a3aa3 Author: Chris Williams Date: Thu Dec 13 13:05:20 2007 +0000 Made setting an ALIAS optional ================================= 2007-12-13 09:45:04 +0000 1.27_02 ================================= commit 4f6f51bb1e562f2cd517b92a779377cf1a5d765e Author: Chris Williams Date: Thu Dec 13 09:44:15 2007 +0000 Only make PoCo-Client-HTTP a build_prereq if explicitly requested or Prefork support has been requested ================================= 2007-12-13 09:44:52 +0000 1.27_01 ================================= commit c22a4962a6c72c4ab8fe4f4394c58156aaadcad5 Author: Chris Williams Date: Thu Dec 13 09:44:52 2007 +0000 CPAN Release 1.27_02 commit d5f3ca2ff93962edb4aaa4bf51a2121f35cd22da Author: Chris Williams Date: Thu Dec 13 08:22:38 2007 +0000 Adjusted timing of the tests. ============================== 2007-12-11 17:42:57 +0000 1.26 ============================== commit cb24f1e8a5c902f492db7ec8eceab861fa37b8c9 Author: Chris Williams Date: Tue Dec 11 17:42:24 2007 +0000 Bump version for release commit 46a95e895dab659464b82225330b9359a1a4224f Author: Chris Williams Date: Tue Dec 11 17:40:36 2007 +0000 Refactored all tests apart from the Prefork tests to use POE::Wheel::Run or equivalent instead of fork(). commit 15144dbacc50d0319e714a677a800dfbc1ba6047 Author: Chris Williams Date: Tue Dec 11 13:42:26 2007 +0000 Refactored 05_run.t to remove fork() and use POE::Wheel::Run instead. ============================== 2007-11-29 12:11:45 +0000 1.25 ============================== commit 368a664e0d330bd1f1ac54ea5c13424481738dd5 Author: Chris Williams Date: Thu Nov 29 12:10:14 2007 +0000 Fixed one of the test cases for MSWin32 ============================== 2007-11-01 15:08:54 +0000 1.24 ============================== commit 6e4b50ae2dfbed4081628fd814e452ac8967e27e Author: Chris Williams Date: Thu Nov 1 15:07:15 2007 +0000 Changes to skip fork tests on MSWin32 commit 16109d0d2080b6a36d6c7082aae38bb5936ed728 Author: Chris Williams Date: Fri Jul 13 10:27:38 2007 +0000 Fixed the skipall in the tests requiring IPC::Shareable. Renumbered tests commit dafba3b758cce4ca4bc93228902ef4bad13a8646 Author: Chris Williams Date: Thu Jul 12 18:53:12 2007 +0000 Made ADDRESS parameter optional, thanks to Zach Roberts for pointing that out. Updated the documentation. Fixed MANIFEST commit 7c405626b72dc4a71a4e5920c14abad45b13d54c Author: Eriam Schaffter Date: Sun Jul 8 09:09:11 2007 +0000 Added SKIP and tweaked the test that forks childs so I does not mess up with Test::More commit 4bf479ba74cd8f0563c5bf0b56828128b2a4dd2a Author: Marlon Bailey Date: Sat Jul 7 20:58:46 2007 +0000 Merging in PUSH branch, DO NOT push out to CPAN before making sure test cases are Prefork aware and 7_bad_request.t pass. commit c7de3f842b68feab8b312f6005e85a5f3825486c Author: Chris Williams Date: Thu Jun 7 16:42:36 2007 +0000 Added back t/3_pod_coverage.t commit 4639923b1f597c87a02290096b20a5a8aa607a06 Author: Marlon Bailey Date: Mon Apr 30 23:54:04 2007 +0000 Saved bad request test, which cannot be commited til new version of POE is release. commit bb7603e2fae4fadd13267459c037579904aad838 Author: Marlon Bailey Date: Fri Apr 27 22:01:30 2007 +0000 Committing failing test case which illustrates issue with external Wheel which SimpleHTTP uses for handing off HTTP::Requests to it's Got_Input handler. commit 7d2c85168dd3d89f225608583f8f7343d5d0eb2e Merge: 02fa2bd 39d6884 Author: Marlon Bailey Date: Fri Apr 27 18:37:56 2007 +0000 Removing push branch work from trunk. It is now under branches/push. commit 39d688440d25bf53b74e286e1b8224800f52caaa Author: Eriam Schaffter Date: Thu Apr 26 08:40:39 2007 +0000 + new api + dont_flush option + POD !! commit bcbf3c3650aa57ca72d5f83ecd29e57d6fa98d7e Author: Eriam Schaffter Date: Thu Apr 26 08:29:53 2007 +0000 + dont_flush option commit 521b8e1d57442f055375588ebc8450a82f474af9 Author: Eriam Schaffter Date: Thu Apr 26 08:29:12 2007 +0000 ! extension name .. commit 409291ee08e821236ac08b8fb4186814d11ded7c Author: Eriam Schaffter Date: Thu Apr 26 08:28:30 2007 +0000 + new api + option for giving the user the ability to do his callbacks on his own commit 595c61ed8b170846bbf8a8aa857b26a46338fb1c Author: Eriam Schaffter Date: Thu Apr 26 08:27:36 2007 +0000 + new api commit a3d4a6aa3fcf31607793dae0bf548d3011fff5b5 Author: Chris Williams Date: Wed Mar 21 18:20:53 2007 +0000 Forgot to add pod_coverage test to svn ============================== 2007-03-21 18:02:05 +0000 1.23 ============================== commit 6bf9f63c55a3d151919e8a613d2baaa53ac27193 Author: Marlon Bailey Date: Wed Mar 21 17:59:56 2007 +0000 Bumping up version number. commit 47c5a9aaae248bf11999093a8d20d1c0c2c1e3cb Author: Marlon Bailey Date: Wed Mar 21 17:54:25 2007 +0000 Fixing build requirement issues for streaming tests. ============================== 2007-03-21 08:44:13 +0000 1.22 ============================== commit 3e0dd26e3b3a2cd1c7f54566483a1d201229c817 Author: Chris Williams Date: Wed Mar 21 08:42:20 2007 +0000 Added files to MANIFEST. Bumped version number for release. commit 9fedc4f7622c2e2aa77352d2e135d73d3f0053ff Author: Eriam Schaffter Date: Tue Mar 20 18:39:13 2007 +0000 + test for streaming .. commit e0eb583d5c37c6c0af7a0d8c77eb42c9e9bd61c2 Author: Eriam Schaffter Date: Mon Mar 19 19:36:47 2007 +0000 + pod and modified parameters passed to the stream event (everything is contained in a hash) commit 4984abf7b425ea99ac6b43a4103d91b3c8a9545a Author: Eriam Schaffter Date: Mon Mar 19 19:34:41 2007 +0000 sample of the streaming feature commit f092d15e762833a9099bba1353afd927c841658a Author: Eriam Schaffter Date: Fri Mar 16 10:49:44 2007 +0000 + test for streamed wheel + POST stream event to foreign session commit fa6a30011562c12ad34c09c9add3acd58867287a Author: Eriam Schaffter Date: Fri Mar 16 10:48:09 2007 +0000 added STREAM_SESSION to allow other POE session to register the STREAM event ============================== 2007-03-15 19:36:38 +0000 1.21 ============================== commit 163155efea3141ca14e974f956c961a0c642f563 Author: Chris Williams Date: Thu Mar 15 19:35:12 2007 +0000 Bumped the version number for release commit 96101ec8216340485151b01a5f5d2d864e72b27d Author: Marlon Bailey Date: Thu Mar 8 14:27:26 2007 +0000 Updated POD in regards to the Log Handler session and how its arguments changed based on malformed client requests. commit f1559ef4bf655ee39e3df9fcfea39a34874916b4 Author: Marlon Bailey Date: Thu Mar 8 04:29:40 2007 +0000 Server now handles malformed requests better. Will not try to dispatch to a handler when receiving a malformed request. commit fbd09d62e8345d120617f45a86eb0e92386b157d Author: Chris Williams Date: Tue Mar 6 09:25:04 2007 +0000 Changes updated from release. ============================== 2007-03-06 09:17:46 +0000 1.20 ============================== commit f73fb9bef375d6160ccf19dad1adb44e42b71565 Author: Chris Williams Date: Tue Mar 6 09:14:40 2007 +0000 Bumped the version number commit 9f5744c13857ef78b7e220a98dc9e5109ad9b2d9 Author: Marlon Bailey Date: Tue Mar 6 03:56:13 2007 +0000 Server no longer dies if it cannot find a handler for a path, now it returns a response with a 404 code along with the content '404 Not Found' per RFC description. commit 469a45e8f149cb9c0fb9a6af64e0ecef3612feb1 Author: Marlon Bailey Date: Mon Mar 5 00:02:24 2007 +0000 Server will now croak if it has a handler registered for the directory but has a problem posting to it. ============================== 2007-02-15 17:23:44 +0000 1.19 ============================== commit a6391eb3fd6b01f49f205eb5fc448b2b698f749d Author: Chris Williams Date: Thu Feb 15 17:22:33 2007 +0000 Added avinash240's test from branch/push ============================== 2007-02-15 17:22:55 +0000 1.18 ============================== commit 8d507923f1a373b4dc1f3e5145bbd1953a60c716 Author: Chris Williams Date: Thu Feb 15 17:22:55 2007 +0000 CPAN Release 1.19 commit 9d6536ca4b30e26cf94c1aef89e0425ede71a7f1 Author: Chris Williams Date: Thu Feb 15 17:12:36 2007 +0000 Hacked to make the HEAP an object and added some methods ============================== 2007-02-15 14:47:56 +0000 1.17 ============================== commit a7b516e74d8d4e9a456d6890f31b243ae669bfae Author: Chris Williams Date: Thu Feb 15 14:46:02 2007 +0000 Added kwalitee test. commit 1784566986a6d210467186e950ee56222cc9f25e Author: Chris Williams Date: Thu Feb 15 14:45:34 2007 +0000 Added LOGHANDLER directive for general logging duties. Deprecated the Changes to Changes.old, added svn logging for the future Changes file. commit 26b4da32a846a6d98f54e9853a1d149188755e4d Author: Eriam Schaffter Date: Mon Feb 5 21:36:44 2007 +0000 ! is_streaming commit ac070266d44e4c869c01ba58feb15fd580a63f52 Author: Eriam Schaffter Date: Sat Feb 3 19:02:35 2007 +0000 + is_streaming needs a 1 to be initialized commit f0dfd2f653e88fbe57d6688fce666e079a6568bf Author: Eriam Schaffter Date: Sat Feb 3 19:01:03 2007 +0000 ! is_streaming can now be used to test if a response is actually in streaming mode ============== End of Excerpt ============== POE-Component-Server-SimpleHTTP-2.18/Changes.svn000644 001751 001751 00000042313 12143730257 022137 0ustar00bingosbingos000000 000000 ======================== 2009-02-26 16:24:08 1.56 ======================== 2009-02-26 16:21:41 (r140) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M ADDRESS was not being passed through to the SocketFactory as an option. It does now ======================== 2009-01-23 07:27:00 1.54 ======================== 2009-01-23 07:23:17 (r138) by bingos lib/POE/Component/Server/SimpleHTTP/PreFork.pm M; t/05_post.t M; t/04_run_close.t M; t/04_run_keepalive.t M; lib/POE/Component/Server/SimpleHTTP/Response.pm M; lib/POE/Component/Server/SimpleHTTP/Connection.pm M; lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M; Changes M Move testsuite to use POE::Filter::HTTP::Parser, perltidy everything, bump version =========================== 2009-01-22 08:50:54 1.53_03 =========================== 2009-01-22 08:50:31 (r136) by bingos lib/POE/Component/Server/SimpleHTTP.pm M Bump development release version 2009-01-22 08:49:21 (r135) by bingos t/04_run_keepalive.t M; lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M; Changes M Ran perltidy against SimpleHTTP.pm, fixed keepalive test =========================== 2009-01-21 14:05:58 1.53_02 =========================== 2009-01-21 14:05:18 (r133) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M; Changes M Forgot the dependency on Test::POE::Client::TCP for the new tests. doh. =========================== 2009-01-20 16:07:32 1.53_01 =========================== 2009-01-20 16:06:43 (r131) by bingos lib/POE/Component/Server/SimpleHTTP.pm M Give it a development version and ship for the CPAN Testers to smoke 2009-01-20 16:00:37 (r130) by bingos t/05_post.t A; t/02_simple.t A; t/08_post.t D; t/04_run_close.t A; t/04_run_keepalive.t A; t/03_pod_coverage.t D; lib/POE/Component/Server/SimpleHTTP.pm M; t/03_bad_request.t A; MANIFEST M; Changes M; t/99_pod.t A; t/07_bad_request.t D; t/11_keepalive.t D; t/04_test_kwalitee.t D; t/05_run.t D; t/99_pod_coverage.t A; Makefile.PL M; t/02_pod.t D; t/03_bad_handler.t A Houston we appear to have a refactored testsuite. Yes, it really works. And consistently as well. hurrah 2009-01-19 21:23:03 (r128) by bingos t/05_run.t M; t/07_bad_request.t M; t/11_keepalive.t M Hopefully fixed mysteriously failing tests, by making the STDOUT "hot" in the forked process 2009-01-19 21:07:42 (r126) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Fix [rt.cpan.org #42444] reported by pravus ======================== 2008-12-17 10:42:57 1.50 ======================== 2008-12-17 10:39:28 (r124) by bingos lib/POE/Component/Server/SimpleHTTP.pm M Fix applied for RT #41780 2008-11-15 08:53:26 (r123) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M; Changes M Some code tidying ======================== 2008-09-05 15:39:31 1.48 ======================== 2008-09-05 15:36:56 (r121) by bingos; Makefile.PL M Added makemaker_args() directive to Makefile.PL, thanks to Matt Trout for that tip 2008-09-05 15:34:46 (r120) by bingos lib/POE/Component/Server/SimpleHTTP/PreFork.pm M; lib/POE/Component/Server/SimpleHTTP/Response.pm M; lib/POE/Component/Server/SimpleHTTP/Connection.pm M; lib/POE/Component/Server/SimpleHTTP.pm M Removed the FATAL => 'all' from use warnings. suggested by Andreas Gudmundsson 2008-09-05 15:24:08 (r119) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Downstream Debian patch applied RT #38743 by Martin Ferrari ======================== 2008-04-14 12:09:28 1.46 ======================== 2008-04-14 12:08:42 (r117) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Fixed PROXYMODE setting handling ======================== 2008-04-14 11:30:47 1.44 ======================== 2008-04-14 11:27:08 (r115) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M; Changes M Added PROXYMODE setting 2008-04-03 15:18:15 (r114) by eriam lib/POE/Component/Server/SimpleHTTP/Response.pm M; lib/POE/Component/Server/SimpleHTTP.pm M Dont flush option added in the Response object and corrected case. 2008-02-22 01:12:35 (r113) by agaran; todo A - BinGOs, dont kill me, but i like to have todo to consider 2008-02-22 00:42:03 (r112) by agaran; t/11_keepalive.t M - random port used for testing, helped for me in few cases 2008-02-20 20:49:27 (r111) by agaran lib/POE/Component/Server/SimpleHTTP.pm M - missed one letter 2008-02-20 17:16:43 (r110) by agaran lib/POE/Component/Server/SimpleHTTP.pm M - new LOG2HANDLER which is fired after servicing request ======================== 2008-02-13 08:42:59 1.42 ======================== 2008-02-13 08:29:28 (r108) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M Increased the requirement of PoCo-Client-HTTP to version 0.82 as per RT#33201 ======================== 2008-01-17 15:32:57 1.40 ======================== 2008-01-17 15:31:39 (r106) by bingos t/01_load.t M; lib/POE/Component/Server/SimpleHTTP.pm M; Changes M "Fixed" the uppercase options annoyance. Hurrah. ======================== 2008-01-17 14:53:21 1.38 ======================== 2008-01-17 14:45:39 (r104) by bingos t/09_prefork_maxrequestperchild.t M; lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Amended the test count in 09_prefork test, reported by UltraDM. ======================== 2008-01-14 21:26:41 1.36 ======================== 2008-01-14 21:25:39 (r102) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Applied a patch from Maciej Pijanka (agaran) ======================== 2008-01-09 15:29:51 1.34 ======================== 2008-01-09 09:41:15 (r100) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M; Changes M Bumped required version of POE to 0.9999 to fix problem with POE::Filter::HTTPD and bad requests ======================== 2008-01-08 10:13:14 1.32 ======================== 2008-01-08 10:11:41 (r98) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Fixed problem with bad requests, reported by agaran ======================== 2007-12-21 16:59:05 1.30 ======================== 2007-12-21 16:56:40 (r96) by bingos t/09_prefork_maxrequestperchild.t M; lib/POE/Component/Server/SimpleHTTP.pm M; t/06_stream.t M; Makefile.PL M; Changes M; t/10_prefork_stream.t M Minor amendments prior to CPAN Release 2007-12-20 02:28:51 (r95) by leolo; Makefile.PL M Added build_requires LWP::ConnCache 2007-12-20 02:27:49 (r94) by leolo lib/POE/Component/Server/SimpleHTTP.pm M; MANIFEST M; t/11_keepalive.t A Added HTTP/1.1 keep-alive support. - Off by default, turn on with KEEPALIVE=>1 - Added t/11_keepalive.t to test above Created Fix_Headers() which adds default response headers for both stream and normal responses. Responses to HEAD requests shouldn't have Content-Length set! Default content-type is now text/plain 2007-12-17 15:26:10 (r93) by leolo t/05_run.t M; lib/POE/Component/Server/SimpleHTTP/Connection.pm M; lib/POE/Component/Server/SimpleHTTP.pm M; t/06_stream.t M Changed the on_close interface to 'SETCLOSEHANDLER' which is closer to the normal SimpleHTTP interface. 2007-12-14 20:41:39 (r92) by leolo t/05_run.t M; lib/POE/Component/Server/SimpleHTTP/Connection.pm M; lib/POE/Component/Server/SimpleHTTP.pm M; t/06_stream.t M Added Server::SimpleHTTP::Connection->ID Added Server::SimpleHTTP::Connection->on_close Modified t/05_run.t and t/06_stream.t to test the above Documented the above ======================== 2007-12-13 13:56:17 1.28 ======================== 2007-12-13 13:55:58 (r90) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Bump version for release =========================== 2007-12-13 13:05:37 1.27_03 =========================== 2007-12-13 13:05:20 (r88) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Made setting an ALIAS optional =========================== 2007-12-13 09:45:04 1.27_02 =========================== 2007-12-13 09:44:15 (r85) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; t/06_stream.t M; Makefile.PL M Only make PoCo-Client-HTTP a build_prereq if explicitly requested or Prefork support has been requested 2007-12-13 08:22:38 (r83) by bingos t/05_run.t M; t/08_post.t M; lib/POE/Component/Server/SimpleHTTP.pm M; t/07_bad_request.t M Adjusted timing of the tests. ======================== 2007-12-11 17:42:57 1.26 ======================== 2007-12-11 17:42:24 (r81) by bingos lib/POE/Component/Server/SimpleHTTP.pm M Bump version for release 2007-12-11 17:40:36 (r80) by bingos t/05_run.t M; t/08_post.t M; lib/POE/Component/Server/SimpleHTTP.pm M; t/06_stream.t M; t/07_bad_request.t M Refactored all tests apart from the Prefork tests to use POE::Wheel::Run or equivalent instead of fork(). 2007-12-11 13:42:26 (r79) by bingos; t/05_run.t M; Changes M Refactored 05_run.t to remove fork() and use POE::Wheel::Run instead. ======================== 2007-11-29 12:11:45 1.25 ======================== 2007-11-29 12:10:14 (r77) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M; t/07_bad_request.t M Fixed one of the test cases for MSWin32 ======================== 2007-11-01 15:08:54 1.24 ======================== 2007-11-01 15:07:15 (r75) by bingos t/05_run.t M; t/08_post.t M; lib/POE/Component/Server/SimpleHTTP.pm M; t/06_stream.t M; Makefile.PL M; t/07_bad_request.t M Changes to skip fork tests on MSWin32 2007-07-13 10:27:38 (r74) by bingos t/5_run.t D; t/9_prefork_maxrequestperchild.t D; t/08_post.t A; t/03_pod_coverage.t A; t/1_load.t D; t/06_stream.t A; MANIFEST M; t/2_pod.t D; t/07_bad_request.t A; t/04_test_kwalitee.t A; t/05_run.t A; t/09_prefork_maxrequestperchild.t A; t/8_post.t D; t/01_load.t A; t/3_pod_coverage.t D; t/6_stream.t D; t/02_pod.t A; t/10_prefork_stream.t M; t/7_bad_request.t D; t/4_test_kwalitee.t D Fixed the skipall in the tests requiring IPC::Shareable. Renumbered tests 2007-07-12 18:53:12 (r73) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; MANIFEST M Made ADDRESS parameter optional, thanks to Zach Roberts for pointing that out. Updated the documentation. Fixed MANIFEST 2007-07-08 09:09:11 (r72) by eriam t/9_prefork_maxrequestperchild.t M; t/10_prefork_stream.t M Added SKIP and tweaked the test that forks childs so I does not mess up with Test::More 2007-07-07 20:58:46 (r71) by avinash240 lib/POE/Component/Server/SimpleHTTP/PreFork.pm M; t/9_prefork_maxrequestperchild.t A; t/8_post.t A; lib/POE/Component/Server/SimpleHTTP/Response.pm M; lib/POE/Component/Server/SimpleHTTP.pm M; t/6_stream.t M; t/10_prefork_stream.t A Merging in PUSH branch, DO NOT push out to CPAN before making sure test cases are Prefork aware and 7_bad_request.t pass. 2007-06-07 16:42:36 (r60) by bingos; t/3_pod_coverage.t A Added back t/3_pod_coverage.t 2007-04-30 23:54:04 (r51) by avinash240; t/7_bad_request.t M Saved bad request test, which cannot be commited til new version of POE is release. 2007-04-27 22:01:30 (r50) by avinash240 Makefile.PL M; t/7_bad_request.t A Committing failing test case which illustrates issue with external Wheel which SimpleHTTP uses for handing off HTTP::Requests to it's Got_Input handler. 2007-04-27 18:37:56 (r49) by avinash240 t/7_stream_dont_flush.pl D; lib/POE/Component/Server/SimpleHTTP/Response.pm M; t/3_pod_coverage.t D; lib/POE/Component/Server/SimpleHTTP.pm M; t/6_stream.t M; Changes M; t/7_stream_dont_flush.t D Removing push branch work from trunk. It is now under branches/push. 2007-04-26 08:40:39 (r45) by eriam lib/POE/Component/Server/SimpleHTTP.pm M + new api + dont_flush option + POD !! 2007-04-26 08:29:53 (r44) by eriam lib/POE/Component/Server/SimpleHTTP/Response.pm M + dont_flush option 2007-04-26 08:29:12 (r43) by eriam; t/7_stream_dont_flush.t A ! extension name .. 2007-04-26 08:28:30 (r42) by eriam; t/7_stream_dont_flush.pl A + new api + option for giving the user the ability to do his callbacks on his own 2007-04-26 08:27:36 (r41) by eriam; t/6_stream.t M + new api 2007-03-21 18:20:53 (r36) by bingos; t/3_pod_coverage.t A; Changes M Forgot to add pod_coverage test to svn ======================== 2007-03-21 18:02:05 1.23 ======================== 2007-03-21 17:59:56 (r34) by avinash240 lib/POE/Component/Server/SimpleHTTP.pm M Bumping up version number. 2007-03-21 17:54:25 (r33) by avinash240; Makefile.PL M Fixing build requirement issues for streaming tests. ======================== 2007-03-21 08:44:13 1.22 ======================== 2007-03-21 08:42:20 (r31) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; MANIFEST M; Changes M Added files to MANIFEST. Bumped version number for release. 2007-03-20 18:39:13 (r30) by eriam; t/6_stream.t A + test for streaming .. 2007-03-19 19:36:47 (r29) by eriam lib/POE/Component/Server/SimpleHTTP.pm M + pod and modified parameters passed to the stream event (everything is contained in a hash) 2007-03-19 19:34:41 (r28) by eriam; examples/stream.pl A sample of the streaming feature 2007-03-16 10:49:44 (r27) by eriam lib/POE/Component/Server/SimpleHTTP.pm M + test for streamed wheel + POST stream event to foreign session 2007-03-16 10:48:09 (r26) by eriam lib/POE/Component/Server/SimpleHTTP/Response.pm M added STREAM_SESSION to allow other POE session to register the STREAM event ======================== 2007-03-15 19:36:38 1.21 ======================== 2007-03-15 19:35:12 (r24) by bingos lib/POE/Component/Server/SimpleHTTP.pm M Bumped the version number for release 2007-03-08 14:27:26 (r23) by avinash240 lib/POE/Component/Server/SimpleHTTP.pm M Updated POD in regards to the Log Handler session and how its arguments changed based on malformed client requests. 2007-03-08 04:29:40 (r22) by avinash240 lib/POE/Component/Server/SimpleHTTP.pm M Server now handles malformed requests better. Will not try to dispatch to a handler when receiving a malformed request. 2007-03-06 09:25:04 (r21) by bingos; Changes M Changes updated from release. ======================== 2007-03-06 09:17:46 1.20 ======================== 2007-03-06 09:14:40 (r19) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Bumped the version number 2007-03-06 03:56:13 (r18) by avinash240 t/5_run.t M; lib/POE/Component/Server/SimpleHTTP.pm M Server no longer dies if it cannot find a handler for a path, now it returns a response with a 404 code along with the content '404 Not Found' per RFC description. 2007-03-05 00:02:24 (r17) by avinash240 lib/POE/Component/Server/SimpleHTTP.pm M Server will now croak if it has a handler registered for the directory but has a problem posting to it. ======================== 2007-02-15 17:23:44 1.19 ======================== 2007-02-15 17:22:33 (r14) by bingos t/5_run.t A; lib/POE/Component/Server/SimpleHTTP.pm M; MANIFEST M Added avinash240's test from branch/push 2007-02-15 17:12:36 (r12) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Hacked to make the HEAP an object and added some methods ======================== 2007-02-15 14:47:56 1.17 ======================== 2007-02-15 14:46:02 (r10) by bingos; t/4_test_kwalitee.t A Added kwalitee test. 2007-02-15 14:45:34 (r9) by bingos tools A; Changes.old A; lib/POE/Component/Server/SimpleHTTP.pm M; META.yml D; MANIFEST M; tools/svn-log.perl A; Changes R Added LOGHANDLER directive for general logging duties. Deprecated the Changes to Changes.old, added svn logging for the future Changes file. 2007-02-05 21:36:44 (r8) by eriam lib/POE/Component/Server/SimpleHTTP/Response.pm M ! is_streaming 2007-02-03 19:02:35 (r7) by eriam lib/POE/Component/Server/SimpleHTTP.pm M + is_streaming needs a 1 to be initialized 2007-02-03 19:01:03 (r6) by eriam lib/POE/Component/Server/SimpleHTTP/Response.pm M ! is_streaming can now be used to test if a response is actually in streaming mode ======================== 2007-01-29 15:13:13 1.16 ======================== 2007-01-29 15:07:26 (r4) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; MANIFEST M; Changes M; inc D Kwalitee fixes 2007-01-19 16:10:20 (r1) by svn README A; inc/Module A; /trunk A; lib/POE/Component/Server A; inc/Module/Install/WriteAll.pm A; t A; lib/POE/Component/Server/SimpleHTTP/Response.pm A; t/1_load.t A; lib/POE/Component/Server/SimpleHTTP.pm A; t/2_pod.t A; inc A; lib/POE/Component/Server/SimpleHTTP/PreFork.pm A; examples A; inc/Module/Install.pm A; /branches A; lib/POE/Component/Server/SimpleHTTP A; lib/POE/Component A; inc/Module/Install/Makefile.pm A; examples/server.pl A; inc/Module/Install/Metadata.pm A; lib/POE/Component/Server/SimpleHTTP/Connection.pm A; inc/Module/Install A; lib A; MANIFEST A; Changes A; inc/Module/Install/Fetch.pm A; inc/Module/Install/Can.pm A; inc/Module/Install/Win32.pm A; META.yml A; Makefile.PL A; lib/POE A; inc/Module/Install/Base.pm A; /tags A Initial repository layout ============== End of Excerpt ============== POE-Component-Server-SimpleHTTP-2.18/Makefile.PL000644 001751 001751 00000003115 12164632771 022013 0ustar00bingosbingos000000 000000 #use ExtUtils::MakeMaker; use inc::Module::Install; $ENV{PERL_MM_USE_DEFAULT}=1 if $Module::Install::AUTHOR; name 'POE-Component-Server-SimpleHTTP'; author 'Apocalypse '; license 'perl'; auto_license holder => 'Apocalypse, Chris Williams, Eriam Schaffter, Marlon Bailey and Philip Gwyn'; perl_version '5.006'; version_from 'lib/POE/Component/Server/SimpleHTTP.pm'; abstract_from 'lib/POE/Component/Server/SimpleHTTP.pm'; # Build the prerequisite list requires 'HTTP::Date' => 0; requires 'Carp' => 0; requires 'Sys::Hostname' => 0; requires 'POE' => '1.0000'; requires 'Storable' => 0; requires 'Socket' => 0; requires 'HTTP::Request' => 0; requires 'HTTP::Response' => 0; requires 'Moose' => 0.90; requires 'MooseX::POE' => 0.205; build_requires 'Test::More' => 0.47; build_requires 'POE::Filter::HTTP::Parser' => 1.06; build_requires 'Test::POE::Client::TCP' => 0.10; my $value = prompt( 'Do you want to test streaming ( requires POE::Component::Client::HTTP ) [y/N]?', 'N' ); build_requires 'POE::Component::Client::HTTP' => 0.82 if $value =~ /^Y$/i; # Ask users if they want SSL support $value = prompt( 'Do you want SSL support ( requires POE::Component::SSLify ) [y/N]?', 'N' ); # Add to the prereqs PoCo::SSLify? requires 'POE::Component::SSLify' => '0.04' if $value =~ /^Y$/i; # Thanks to Matt Trout for this tip makemaker_args(dist => { PREOP => "$^X tools/git-log.pl > ./Changes" }); auto_provides; githubmeta; WriteAll(); POE-Component-Server-SimpleHTTP-2.18/tools/git-log.pl000755 001751 001751 00000004373 12143730257 023105 0ustar00bingosbingos000000 000000 #!/usr/bin/env perl use warnings; use strict; use Text::Wrap qw(wrap fill $columns $huge); use Getopt::Long; use POSIX qw(strftime); my $days_back = 110365; # Go back a year by default. my $send_help = 0; # Display help and exit. my $tag_pattern = "^\\d"; GetOptions( "age=s" => \$days_back, "help" => \$send_help, "tags=s" => \$tag_pattern, ) or $send_help = 1; # Find the trunk for the current repository if one isn't specified. die( "$0 usage:\n", " [--age DAYS] limit report to DAYS in the past (default: 365)\n", " [--tags REGEXP] report on tags matching REGEXP (default: ^v\\d+_)\n", ) if $send_help; my $earliest_date = strftime( "%FT %T +0000", gmtime(time() - $days_back * 86400) ); $Text::Wrap::huge = "wrap"; $Text::Wrap::columns = 74; chomp(my @tags = `git tag`); { my $i = @tags; while ($i--) { unless ($tags[$i] =~ /$tag_pattern/o) { splice @tags, $i, 1; next; } my $commit = `git show $tags[$i] --pretty='tformat:(((((%ci)))))' | grep '(((((' | head -1`; die $commit unless $commit =~ /\(\(\(\(\((.+?)\)\)\)\)\)/; $tags[$i] = { 'time' => $1, 'tag' => $tags[$i], }; } } push @tags, { 'time' => '9999-99-99 99:99:99 +0000', 'tag' => 'HEAD' }; @tags = sort { $a->{'time'} cmp $b->{'time'} } @tags; { my $i = @tags; while ($i--) { last if $tags[$i]{time} lt $earliest_date; my @commit; open my $commit, "-|", "git log $tags[$i-1]{tag}..$tags[$i]{tag} ." or die $!; local $/ = "\n\n"; while (<$commit>) { if (/^\S/) { s/^/ /mg; push @commit, $_; next; } # Trim off identical leading whitespace. my ($whitespace) = /^(\s*)/; if (length $whitespace) { s/^$whitespace//mg; } # Re-flow the paragraph if it isn't indented from the norm. # This should preserve indented quoted text, wiki-style. unless (/^\s/) { push @commit, fill(" ", " ", $_), "\n\n"; } else { push @commit, $_; } } # Don't display the tag if there's nothing under it. next unless @commit; my $tag_line = "$tags[$i]{time} $tags[$i]{tag}"; print( ("=" x length($tag_line)), "\n", $tag_line, "\n", ("=" x length($tag_line)), "\n", "\n", ); print @commit; } } print( "==============\n", "End of Excerpt\n", "==============\n", ); POE-Component-Server-SimpleHTTP-2.18/lib/POE/000755 001751 001751 00000000000 12164634317 021230 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.18/lib/POE/Component/000755 001751 001751 00000000000 12164634317 023172 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.18/lib/POE/Component/Server/000755 001751 001751 00000000000 12164634317 024440 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.18/lib/POE/Component/Server/SimpleHTTP/000755 001751 001751 00000000000 12164634317 026371 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.18/lib/POE/Component/Server/SimpleHTTP.pm000644 001751 001751 00000135245 12164634146 026741 0ustar00bingosbingos000000 000000 package POE::Component::Server::SimpleHTTP; use strict; use warnings; use vars qw($VERSION); $VERSION = '2.18'; use POE; use POE::Wheel::SocketFactory; use POE::Wheel::ReadWrite; use POE::Filter::HTTPD; use POE::Filter::Stream; use Carp qw( croak ); use Socket; use HTTP::Date qw( time2str ); use POE::Component::Server::SimpleHTTP::Connection; use POE::Component::Server::SimpleHTTP::Response; use POE::Component::Server::SimpleHTTP::State; BEGIN { # Debug fun! if ( !defined &DEBUG ) { eval "sub DEBUG () { 0 }"; } # Our own definition of the max retries if ( !defined &MAX_RETRIES ) { eval "sub MAX_RETRIES () { 5 }"; } } use MooseX::POE; use Moose::Util::TypeConstraints; has 'alias' => ( is => 'ro', ); has 'address' => ( is => 'ro', ); has 'port' => ( is => 'ro', default => sub { 0 }, writer => '_set_port', ); has 'hostname' => ( is => 'ro', default => sub { require Sys::Hostname; return Sys::Hostname::hostname(); }, ); has 'proxymode' => ( is => 'ro', isa => 'Bool', default => sub { 0 }, ); has 'keepalive' => ( is => 'ro', isa => 'Bool', default => sub { 0 }, ); has 'sslkeycert' => ( is => 'ro', isa => subtype 'ArrayRef' => where { scalar @$_ == 2 }, ); has 'sslintermediatecacert' => ( is => 'ro', isa => 'Str', ); has 'headers' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, ); has 'handlers' => ( is => 'ro', isa => 'ArrayRef', required => 1, writer => '_set_handlers', ); has 'errorhandler' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, ); has 'loghandler' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, ); has 'log2handler' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, ); has 'setuphandler' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, ); has 'retries' => ( traits => ['Counter'], is => 'ro', isa => 'Num', default => sub { 0 }, handles => { inc_retry => 'inc', dec_retry => 'dec', reset_retries => 'reset', }, ); has '_requests' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, init_arg => undef, clearer => '_clear_requests', ); has '_connections' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, init_arg => undef, clearer => '_clear_connections', ); has '_chunkcount' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, init_arg => undef, clearer => '_clear_chunkcount', ); has '_responses' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, init_arg => undef, clearer => '_clear_responses', ); has '_factory' => ( is => 'ro', isa => 'POE::Wheel::SocketFactory', init_arg => undef, clearer => '_clear_factory', writer => '_set_factory', ); sub BUILDARGS { my $class = shift; my %args = @_; $args{lc $_} = delete $args{$_} for keys %args; if ( $args{sslkeycert} and ref $args{sslkeycert} eq 'ARRAY' and scalar @{ $args{sslkeycert} } == 2 ) { eval { require POE::Component::SSLify; import POE::Component::SSLify qw( SSLify_Options SSLify_GetSocket Server_SSLify SSLify_GetCipher SSLify_GetCTX ); SSLify_Options( @{ $args{sslkeycert} } ); }; if ($@) { warn "Unable to load PoCo::SSLify -> $@" if DEBUG; delete $args{sslkeycert}; } else { if ( $args{sslintermediatecacert} ) { my $ctx = SSLify_GetCTX(); Net::SSLeay::CTX_load_verify_locations($ctx, $args{sslintermediatecacert}, ''); } } } return $class->SUPER::BUILDARGS(%args); } sub session_id { shift->get_session_id; } sub getsockname { shift->_factory->getsockname; } sub shutdown { my $self = shift; $poe_kernel->call( $self->get_session_id, 'SHUTDOWN', @_ ); } # This subroutine, when SimpleHTTP exits, will search for leaks sub STOP { my $self = $_[OBJECT]; # Loop through all of the requests foreach my $req ( keys %{ $self->_requests } ) { # Bite the programmer! warn 'Did not get DONE/CLOSE event for Wheel ID ' . $req . ' from IP ' . $self->_requests->{$req}->response->connection->remote_ip; } # All done! return 1; } sub START { my ($kernel,$self) = @_[KERNEL,OBJECT]; $kernel->alias_set( $self->alias ) if $self->alias; $kernel->refcount_increment( $self->get_session_id, __PACKAGE__ ) unless $self->alias; MassageHandlers( $self->handlers ); # Start Listener $kernel->yield( 'start_listener' ); return; } # 'SHUTDOWN' # Stops the server! event 'SHUTDOWN' => sub { my ($kernel,$self,$graceful) = @_[KERNEL,OBJECT,ARG0]; # Shutdown the SocketFactory wheel $self->_clear_factory if $self->_factory; # Debug stuff warn 'Stopped listening for new connections!' if DEBUG; # Are we gracefully shutting down or not? if ( $graceful ) { # Check for number of requests if ( keys( %{ $self->_requests } ) == 0 ) { # Alright, shutdown anyway # Delete our alias $kernel->alias_remove( $_ ) for $kernel->alias_list(); $kernel->refcount_decrement( $self->get_session_id, __PACKAGE__ ) unless $self->alias; # Debug stuff warn 'Stopped SimpleHTTP gracefully, no requests left' if DEBUG; } # All done! return 1; } # Forcibly close all sockets that are open foreach my $S ( $self->_requests, $self->_connections ) { foreach my $conn ( keys %$S ) { # Can't call method "shutdown_input" on an undefined value at # /usr/lib/perl5/site_perl/5.8.2/POE/Component/Server/SimpleHTTP.pm line 323. if ( defined $S->{$conn}->wheel and defined $S->{$conn}->wheel->get_input_handle() ) { $S->{$conn}->close_wheel; } # Delete this request delete $S->{$conn}; } } # Delete our alias $kernel->alias_remove( $_ ) for $kernel->alias_list(); $kernel->refcount_decrement( $self->get_session_id, __PACKAGE__ ) unless $self->alias; # Debug stuff warn 'Successfully stopped SimpleHTTP' if DEBUG; # Return success return 1; }; # Sets up the SocketFactory wheel :) event 'start_listener' => sub { my ($kernel,$self,$noinc) = @_[KERNEL,OBJECT,ARG0]; warn "Creating SocketFactory wheel now\n" if DEBUG; # Check if we should set up the wheel if ( $self->retries == MAX_RETRIES ) { die 'POE::Component::Server::SimpleHTTP tried ' . MAX_RETRIES . ' times to create a Wheel and is giving up...'; } else { $self->inc_retry unless $noinc; # Create our own SocketFactory Wheel :) my $factory = POE::Wheel::SocketFactory->new( BindPort => $self->port, ( $self->address ? ( BindAddress => $self->address ) : () ), Reuse => 'yes', SuccessEvent => 'got_connection', FailureEvent => 'listener_error', ); my ( $port, $address ) = sockaddr_in( $factory->getsockname ); $self->_set_port( $port ) if $self->port == 0; $self->_set_factory( $factory ); if ( $self->setuphandler ) { my $setuphandler = $self->setuphandler; if ( $setuphandler->{POSTBACK} and ref $setuphandler->{POSTBACK} eq 'POE::Session::AnonEvent' ) { $setuphandler->{POSTBACK}->( $port, $address ); } else { $kernel->post( $setuphandler->{'SESSION'}, $setuphandler->{'EVENT'}, $port, $address, ) if $setuphandler->{'SESSION'} and $setuphandler->{'EVENT'}; } } } return 1; }; # Got some sort of error from SocketFactory event listener_error => sub { my ($kernel,$self,$operation,$errnum,$errstr,$wheel_id) = @_[KERNEL,OBJECT,ARG0..ARG3]; warn "SocketFactory Wheel $wheel_id generated $operation error $errnum: $errstr\n" if DEBUG; $self->call( 'start_listener' ); return 1; }; # 'STARTLISTEN' # Starts listening on the socket event 'STARTLISTEN' => sub { warn 'STARTLISTEN called, resuming accepts on SocketFactory' if DEBUG; $_[OBJECT]->call( 'start_listener', 'noinc' ); return 1; }; # 'STOPLISTEN' # Stops listening on the socket event 'STOPLISTEN' => sub { my $self = $_[OBJECT]; warn 'STOPLISTEN called, pausing accepts on SocketFactory' if DEBUG; $self->_clear_factory if $self->_factory; return 1; }; # 'SETHANDLERS' # Sets the HANDLERS event 'SETHANDLERS' => sub { my ($self,$handlers) = @_[OBJECT,ARG0]; MassageHandlers($handlers); $self->_set_handlers( $handlers ); return 1; }; # 'GETHANDLERS' # Gets the HANDLERS event 'GETHANDLERS' => sub { my ($kernel,$self,$session,$event ) = @_[KERNEL,OBJECT,ARG0,ARG1]; return unless $session and $event; require Storable; my $handlers = Storable::dclone( $self->handlers ); delete $_->{'RE'} for @{ $handlers }; $kernel->post( $session, $event, $handlers ); return 1; }; # This subroutine massages the HANDLERS for internal use # Should probably support POSTBACK/CALLBACK sub MassageHandlers { my $handler = shift; # Make sure it is ref to array if ( !ref $handler or ref($handler) ne 'ARRAY' ) { croak("HANDLERS is not a ref to an array!"); } # Massage the handlers my $count = 0; while ( $count < scalar(@$handler) ) { # Must be ref to hash if ( ref $handler->[$count] and ref( $handler->[$count] ) eq 'HASH' ) { # Make sure all the keys are uppercase $handler->[$count]->{ uc $_ } = delete $handler->[$count]->{$_} for keys %{ $handler->[$count] }; # Make sure it got the 3 parts necessary if ( !exists $handler->[$count]->{'SESSION'} or !defined $handler->[$count]->{'SESSION'} ) { croak("HANDLER number $count does not have a SESSION argument!"); } if ( !exists $handler->[$count]->{'EVENT'} or !defined $handler->[$count]->{'EVENT'} ) { croak("HANDLER number $count does not have an EVENT argument!"); } if ( !exists $handler->[$count]->{'DIR'} or !defined $handler->[$count]->{'DIR'} ) { croak("HANDLER number $count does not have a DIR argument!"); } # Convert SESSION to ID if ( UNIVERSAL::isa( $handler->[$count]->{'SESSION'}, 'POE::Session' ) ) { $handler->[$count]->{'SESSION'} = $handler->[$count]->{'SESSION'}->ID; } # Convert DIR to qr// format my $regex = undef; eval { $regex = qr/$handler->[ $count ]->{'DIR'}/ }; # Check for errors if ($@) { croak("HANDLER number $count has a malformed DIR -> $@"); } else { # Store it! $handler->[$count]->{'RE'} = $regex; } } else { croak("HANDLER number $count is not a reference to a HASH!"); } # Done with this one! $count++; } # Got here, success! return 1; } # 'Got_Connection' # The actual manager of connections event 'got_connection' => sub { my ($kernel,$self,$socket,$peeraddr,$peerport) = @_[KERNEL,OBJECT,ARG0..ARG2]; # Should we SSLify it? if ( $self->sslkeycert ) { # SSLify it! eval { $socket = Server_SSLify($socket) }; if ($@) { warn "Unable to turn on SSL for connection from " . Socket::inet_ntoa( $peeraddr ) . " -> $@"; close $socket; return 1; } } # Set up the Wheel to read from the socket my $wheel = POE::Wheel::ReadWrite->new( Handle => $socket, Filter => POE::Filter::HTTPD->new(), InputEvent => 'got_input', FlushedEvent => 'got_flush', ErrorEvent => 'got_error', ); if ( DEBUG and keys %{ $self->_connections } ) { # use Data::Dumper; warn "conn id=", $wheel->ID, " [", join( ', ', keys %{ $self->_connections } ), "]"; } # Save this wheel! # 0 = wheel, 1 = Output done?, 2 = SimpleHTTP::Response object, 3 == request, 4 == streaming? $self->_requests->{ $wheel->ID } = POE::Component::Server::SimpleHTTP::State->new( wheel => $wheel ); # Debug stuff if (DEBUG) { warn "Got_Connection completed creation of ReadWrite wheel ( " . $wheel->ID . " )"; } # Success! return 1; }; # 'Got_Input' # Finally got input, set some stuff and send away! event 'got_input' => sub { my ($kernel,$self,$request,$id) = @_[KERNEL,OBJECT,ARG0,ARG1]; my $connection; # This whole thing is a mess. Keep-Alive was bolted on and it # shows. Streaming is unpredictable. There are checks everywhere # because it leaks wheels. *sigh* # Was this request Keep-Alive? if ( $self->_connections->{$id} ) { my $state = delete $self->_connections->{$id}; $state->reset; $connection = $state->connection; $state->clear_connection; $self->_requests->{$id} = $state; warn "Keep-alive id=$id next request..." if DEBUG; } # Quick check to see if the socket died already... # Initially reported by Tim Wood unless ( $self->_requests->{$id}->wheel_alive ) { warn 'Got a request, but socket died already!' if DEBUG; # Destroy this wheel! $self->_requests->{$id}->close_wheel; delete $self->_requests->{$id}; return; } SWITCH: { last SWITCH if $connection; # connection was kept-alive # Directly access POE::Wheel::ReadWrite's HANDLE_INPUT -> to get the socket itself # Hmm, if we are SSL, then have to do an extra step! if ( $self->sslkeycert ) { $connection = POE::Component::Server::SimpleHTTP::Connection->new( SSLify_GetSocket( $self->_requests->{$id}->wheel->get_input_handle() ) ); last SWITCH; } $connection = POE::Component::Server::SimpleHTTP::Connection->new( $self->_requests->{$id}->wheel->get_input_handle() ); } # The HTTP::Response object, the path my ( $response, $path, $malformed_req ); # Check if it is HTTP::Request or Response # Quoting POE::Filter::HTTPD # The HTTPD filter parses the first HTTP 1.0 request from an incoming stream into an # HTTP::Request object (if the request is good) or an HTTP::Response object (if the # request was malformed). if ( $request->isa('HTTP::Response') ) { # Make the request nothing $response = $request; $request = undef; # Mark that this is a malformed request $malformed_req = 1; # Hack it to simulate POE::Component::Server::SimpleHTTP::Response->new( $id, $conn ); bless( $response, 'POE::Component::Server::SimpleHTTP::Response' ); $response->_WHEEL( $id ); $response->set_connection( $connection ); # Set the path to an empty string $path = ''; } else { unless ( $self->proxymode ) { # Add stuff it needs! my $uri = $request->uri; $uri->scheme('http'); $uri->host( $self->hostname ); $uri->port( $self->port ); # Get the path $path = $uri->path(); if ( !defined $path or $path eq '' ) { # Make it the default handler $path = '/'; } } else { # We're in PROXYMODE set the path to the full URI $path = $request->uri->as_string(); } # Get the response $response = POE::Component::Server::SimpleHTTP::Response->new( $id, $connection ); # Stuff the default headers $response->header( %{ $self->headers } ) if keys( %{ $self->headers } ) != 0; } # Check if the SimpleHTTP::Connection object croaked ( happens when sockets just disappear ) unless ( defined $response->connection ) { # Debug stuff warn "could not make connection object" if DEBUG; # Destroy this wheel! $self->_requests->{$id}->close_wheel; delete $self->_requests->{$id}; return; } # If we used SSL, turn on the flag! if ( $self->sslkeycert ) { $response->connection->ssl(1); # Put the cipher type for people who want it $response->connection->sslcipher( SSLify_GetCipher( $self->_requests->{$id}->wheel->get_input_handle() ) ); } if ( !defined( $request ) ) { $self->_requests->{$id}->close_wheel; delete $self->_requests->{$id}; return; } # Add this response to the wheel $self->_requests->{$id}->set_response( $response ); $self->_requests->{$id}->set_request( $request ); $response->connection->ID($id); # If they have a log handler registered, send out the needed information # TODO if we received a malformed request, we will not have a request object # We need to figure out what we're doing because they can't always expect to have # a request object, or should we keep it from being ?undef'd? if ( $self->loghandler and scalar keys %{ $self->loghandler } == 2 ) { $! = undef; $kernel->post( $self->loghandler->{'SESSION'}, $self->loghandler->{'EVENT'}, $request, $response->connection->remote_ip() ); # Warn if we had a problem dispatching to the log handler above warn( "I had a problem posting to event '", $self->loghandler->{'EVENT'}, "' of the log handler alias '", $self->loghandler->{'SESSION'}, "'. As reported by Kernel: '$!', perhaps the alias is spelled incorrectly for this handler?" ) if $!; } # If we received a malformed request then # let's not try to dispatch to a handler if ($malformed_req) { # Just push out the response we got from POE::Filter::HTTPD saying your request was bad $kernel->post( $self->errorhandler->{SESSION}, $self->errorhandler->{EVENT}, 'BadRequest (by POE::Filter::HTTPD)', $response->connection->remote_ip() ) if $self->errorhandler and $self->errorhandler->{SESSION} and $self->errorhandler->{EVENT}; $kernel->yield( 'DONE', $response ); return; } # Find which handler will handle this one foreach my $handler ( @{ $self->handlers } ) { # Check if this matches if ( $path =~ $handler->{'RE'} ) { # Send this off! $kernel->post( $handler->{'SESSION'}, $handler->{'EVENT'}, $request, $response, $handler->{'DIR'}, ); # Make sure we croak if we have an issue posting croak( "I had a problem posting to event $handler->{'EVENT'} of session $handler->{'SESSION'} for DIR handler '$handler->{'DIR'}'", ". As reported by Kernel: '$!', perhaps the session name is spelled incorrectly for this handler?" ) if $!; # All done! return; } } # If we reached here, no handler was able to handle it... # Set response code to 404 and tell the client we didn't find anything $response->code(404); $response->content('404 Not Found'); $kernel->yield( 'DONE', $response ); return; }; # 'Got_Flush' # Finished with a request! event 'got_flush' => sub { my ($kernel,$self,$id) = @_[KERNEL,OBJECT,ARG0]; return unless defined $self->_requests->{$id}; # Debug stuff warn "Got Flush event for wheel ID ( $id )" if DEBUG; if ( $self->_requests->{$id}->streaming ) { # Do the stream ! warn "Streaming in progress ...!" if DEBUG; return; } # Check if we are shutting down if ( $self->_requests->{$id}->done ) { if ( $self->must_keepalive( $id ) ) { warn "Keep-alive id=$id ..." if DEBUG; my $state = delete $self->_requests->{$id}; $state->set_connection( $state->response->connection ); $state->reset; $self->_connections->{$id} = $state; delete $self->_chunkcount->{$id}; delete $self->_responses->{$id}; } else { # Shutdown read/write on the wheel $self->_requests->{$id}->close_wheel; delete $self->_requests->{$id}; } } else { # Ignore this, eh? if (DEBUG) { warn "Got Flush event for socket ( $id ) when we did not send anything!"; } } # Alright, do we have to shutdown? unless ( $self->_factory ) { # Check to see if we have any more requests if ( keys( %{ $self->_requests } ) == 0 and keys( %{ $self->_connections } ) == 0 ) { # Shutdown! $kernel->yield('SHUTDOWN'); } } # Success! return 1; }; # should we keep-alive the connection? sub must_keepalive { my ( $self, $id ) = @_; return unless $self->keepalive; my $resp = $self->_requests->{$id}->response; my $req = $self->_requests->{$id}->request; # error = close return 0 if $resp->is_error; # Connection is a comma-seperated header my $conn = lc $req->header('Connection'); return 0 if ",$conn," =~ /,\s*close\s*,/; $conn = lc $req->header('Proxy-Connection'); return 0 if ",$conn," =~ /,\s*close\s*,/; $conn = lc $resp->header('Connection'); return 0 if ",$conn," =~ /,\s*close\s*,/; # HTTP/1.1 = keep return 1 if $req->protocol eq 'HTTP/1.1'; return 0; } # 'Got_Error' # Got some sort of error from ReadWrite event 'got_error' => sub { my ($kernel,$self,$operation,$errnum,$errstr,$id) = @_[KERNEL,OBJECT,ARG0..ARG3]; # Only do this for non-EOF on read #unless ( $operation eq 'read' and $errnum == 0 ) { { # Debug stuff warn "Wheel $id generated $operation error $errnum: $errstr\n" if DEBUG; my $connection; if ( $self->_connections->{$id} ) { my $c = delete $self->_connections->{$id}; $connection = $c->connection; $c->close_wheel; } else { if( defined $self->_requests->{$id}->response ) { $connection = $self->_requests->{$id}->response->connection; } else { warn "response for $id is undefined" if DEBUG; } # Delete this connection $self->_requests->{$id}->close_wheel; } delete $self->_requests->{$id}; delete $self->_responses->{$id}; # Mark the client dead $connection->dead(1) if $connection; } # Success! return 1; }; # 'DONE' # Output to the client! event 'DONE' => sub { my ($kernel,$self,$response) = @_[KERNEL,OBJECT,ARG0]; # Check if we got it if ( !defined $response or !UNIVERSAL::isa( $response, 'HTTP::Response' ) ) { warn 'Did not get a HTTP::Response object!' if DEBUG; # Abort... return; } # Get the wheel ID my $id = $response->_WHEEL; # Check if the wheel exists ( sometimes it gets closed by the client, but the application doesn't know that... ) unless ( exists $self->_requests->{$id} ) { # Debug stuff warn 'Wheel disappeared, but the application sent us a DONE event, discarding it' if DEBUG; $kernel->post( $self->errorhandler->{SESSION}, $self->errorhandler->{EVENT}, 'Wheel disappeared !' ) if $self->errorhandler and $self->errorhandler->{SESSION} and $self->errorhandler->{EVENT}; # All done! return 1; } # Check if we have already sent the response if ( $self->_requests->{$id}->done ) { # Tried to send twice! die 'Tried to send a response to the same connection twice!'; } # Quick check to see if the wheel/socket died already... # Initially reported by Tim Wood unless ( $self->_requests->{$id}->wheel_alive ) { warn 'Tried to send data over a closed/nonexistant socket!' if DEBUG; $kernel->post( $self->errorhandler->{SESSION}, $self->errorhandler->{EVENT}, 'Socket closed/nonexistant !' ) if $self->errorhandler and $self->errorhandler->{SESSION} and $self->errorhandler->{EVENT}; return; } # Check if we were streaming. if ( $self->_requests->{$id}->streaming ) { $self->_requests->{$id}->set_streaming(0); $self->_requests->{$id}->set_done(1); # Finished streaming # TODO: We might not get a flush, trigger it ourselves. if ( !$self->_requests->{$id}->wheel->get_driver_out_messages ) { $kernel->yield( 'got_flush', $id ); } return; } $self->fix_headers( $response ); # Send it out! $self->_requests->{$id}->wheel->put($response); # Mark this socket done $self->_requests->{$id}->set_done(1); # Log FINALLY If they have a logFinal handler registered, send out the needed information if ( $self->log2handler and scalar keys %{ $self->log2handler } == 2 ) { $! = undef; $kernel->call( $self->log2handler->{'SESSION'}, $self->log2handler->{'EVENT'}, $self->_requests->{$id}->request, $response ); # Warn if we had a problem dispatching to the log handler above warn( "I had a problem posting to event '", $self->log2handler->{'EVENT'}, "' of the log handler alias '", $self->log2handler->{'SESSION'}, "'. As reported by Kernel: '$!', perhaps the alias is spelled incorrectly for this handler?" ) if $!; } # Debug stuff warn "Completed with Wheel ID $id" if DEBUG; # Success! return 1; }; # 'STREAM' # Stream output to the client event 'STREAM' => sub { my ($kernel,$self,$response) = @_[KERNEL,OBJECT,ARG0]; # Check if we got it unless ( defined $response and UNIVERSAL::isa( $response, 'HTTP::Response' ) ) { warn 'Did not get a HTTP::Response object!' if DEBUG; # Abort... return; } # Get the wheel ID my $id = $response->_WHEEL; $self->_chunkcount->{$id}++; if ( defined $response->STREAM ) { # Keep track if we plan to stream ... if ( $self->_responses->{$id} ) { warn "Restoring response from HEAP and id $id " if DEBUG; $response = $self->_responses->{$id}; } else { warn "Saving HEAP response to id $id " if DEBUG; $self->_responses->{$id} = $response; } } else { warn 'Can\'t push on a response that has not been not set as a STREAM!' if DEBUG; # Abort... return; } # Check if the wheel exists ( sometimes it gets closed by the client, but the application doesn't know that... ) unless ( exists $self->_requests->{$id} ) { # Debug stuff warn 'Wheel disappeared, but the application sent us a DONE event, discarding it' if DEBUG; $kernel->post( $self->errorhandler->{SESSION}, $self->errorhandler->{EVENT}, 'Wheel disappeared !' ) if $self->errorhandler and $self->errorhandler->{SESSION} and $self->errorhandler->{EVENT}; # All done! return 1; } # Quick check to see if the wheel/socket died already... # Initially reported by Tim Wood unless ( $self->_requests->{$id}->wheel_alive ) { warn 'Tried to send data over a closed/nonexistant socket!' if DEBUG; $kernel->post( $self->errorhandler->{SESSION}, $self->errorhandler->{EVENT}, 'Socket closed/nonexistant !' ) if $self->errorhandler and $self->errorhandler->{SESSION} and $self->errorhandler->{EVENT}; return; } $self->fix_headers( $response, 1 ); # Sets the correct POE::Filter unless ( defined $response->IS_STREAMING ) { # Mark this socket done $self->_requests->{$id}->set_streaming(1); $response->set_streaming(1); } if (DEBUG) { warn "Sending stream via " . $response->STREAM_SESSION . "/" . $response->STREAM . " with id $id \n"; } if ( $self->_chunkcount->{$id} > 1 ) { my $wheel = $self->_requests->{ $response->_WHEEL }->wheel; $wheel->set_output_filter( POE::Filter::Stream->new() ); $wheel->put( $response->content ); } else { my $wheel = $self->_requests->{ $response->_WHEEL }->wheel; $wheel->set_output_filter( $wheel->get_input_filter() ); $wheel->put($response); } # we send the event to stream with wheels request and response to the session # that has registered the streaming event unless ( $response->DONT_FLUSH ) { $kernel->post( $response->STREAM_SESSION, # callback session $response->STREAM, # callback event $self->_responses->{ $response->_WHEEL } ); } # Success! return 1; }; # Add required headers to a response sub fix_headers { my ( $self, $response, $stream ) = @_; # Set the date if needed if ( !$response->header('Date') ) { $response->header( 'Date', time2str(time) ); } # Set the Content-Length if needed if ( !$stream and !$self->proxymode and !defined $response->header('Content-Length') and my $len = length $response->content ) { use bytes; $response->header( 'Content-Length', $len ); } # Set the Content-Type if needed if ( !$response->header('Content-Type') ) { $response->header( 'Content-Type', 'text/plain' ); } if ( !$response->protocol ) { my $request = $self->_requests->{ $response->_WHEEL }->request; return unless $request and $request->isa('HTTP::Request'); unless ( $request->method eq 'HEAD' ) { $response->protocol( $request->protocol ); } } } # 'CLOSE' # Closes the connection event 'CLOSE' => sub { my ($kernel,$self,$response) = @_[KERNEL,OBJECT,ARG0]; # Check if we got it unless ( defined $response and UNIVERSAL::isa( $response, 'HTTP::Response' ) ) { warn 'Did not get a HTTP::Response object!' if DEBUG; # Abort... return; } # Get the wheel ID my $id = $response->_WHEEL; if ( $self->_connections->{$id} ) { $self->_requests->{$id} = delete $self->_connections->{$id}; } # Check if the wheel exists ( sometimes it gets closed by the client, but the application doesn't know that... ) unless ( exists $self->_requests->{$id} ) { warn 'Wheel disappeared, but the application sent us a CLOSE event, discarding it' if DEBUG; return 1; } # Kill it! $self->_requests->{$id}->close_wheel if $self->_requests->{$id}->wheel_alive; # Delete it! delete $self->_requests->{$id}; delete $self->_responses->{$id}; warn 'Delete references to the connection done.' if DEBUG; # All done! return 1; }; # Registers a POE inline state (primarly for streaming) event 'REGISTER' => sub { my ( $session, $state, $code_ref ) = @_[ SESSION, ARG0 .. ARG1 ]; warn 'Registering state in POE session' if DEBUG; return $session->register_state( $state, $code_ref ); }; # SETCLOSEHANDLER event 'SETCLOSEHANDLER' => sub { my ($self,$sender) = @_[OBJECT,SENDER ]; my ($connection,$state,@params) = @_[ARG0..$#_]; # turn connection ID into the connection object unless ( ref $connection ) { my $id = $connection; if ( $self->_connections->{$id} ) { $connection = $self->_connections->{$id}->connection; } elsif ($self->_requests->{$id} and $self->_requests->{$id}->response ) { $connection = $self->_requests->{$id}->response->connection; } unless ( ref $connection ) { die "Can't find connection object for request $id"; } } if ($state) { $connection->_on_close( $sender->ID, $state, @params ); } else { $connection->_on_close($sender->ID); } }; no MooseX::POE; __PACKAGE__->meta->make_immutable( ); "Simple In'it"; __END__ =head1 NAME POE::Component::Server::SimpleHTTP - Perl extension to serve HTTP requests in POE. =head1 SYNOPSIS use POE; use POE::Component::Server::SimpleHTTP; # Start the server! POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'PORT' => 11111, 'HOSTNAME' => 'MySite.com', 'HANDLERS' => [ { 'DIR' => '^/bar/.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_BAR', }, { 'DIR' => '^/$', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_MAIN', }, { 'DIR' => '^/foo/.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_NULL', }, { 'DIR' => '.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_ERROR', }, ], 'LOGHANDLER' => { 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_LOG', }, 'LOG2HANDLER' => { 'SESSION' => 'HTTP_GET', 'EVENT' => 'POSTLOG', }, # In the testing phase... 'SSLKEYCERT' => [ 'private-key.pem', 'public-cert.pem' ], 'SSLINTERMEDIATECACERT' => 'intermediate-ca-cert.pem', ) or die 'Unable to create the HTTP Server'; # Create our own session to receive events from SimpleHTTP POE::Session->create( inline_states => { '_start' => sub { $_[KERNEL]->alias_set( 'HTTP_GET' ); $_[KERNEL]->post( 'HTTPD', 'GETHANDLERS', $_[SESSION], 'GOT_HANDLERS' ); }, 'GOT_BAR' => \&GOT_REQ, 'GOT_MAIN' => \&GOT_REQ, 'GOT_ERROR' => \&GOT_ERR, 'GOT_NULL' => \&GOT_NULL, 'GOT_HANDLERS' => \&GOT_HANDLERS, 'GOT_LOG' => \&GOT_LOG, }, ); # Start POE! POE::Kernel->run(); sub GOT_HANDLERS { # ARG0 = HANDLERS array my $handlers = $_[ ARG0 ]; # Move the first handler to the last one push( @$handlers, shift( @$handlers ) ); # Send it off! $_[KERNEL]->post( 'HTTPD', 'SETHANDLERS', $handlers ); } sub GOT_NULL { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Kill this! $_[KERNEL]->post( 'HTTPD', 'CLOSE', $response ); } sub GOT_REQ { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Do our stuff to HTTP::Response $response->code( 200 ); $response->content( 'Some funky HTML here' ); # We are done! # For speed, you could use $_[KERNEL]->call( ... ) $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } sub GOT_ERR { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Check for errors if ( ! defined $request ) { $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); return; } # Do our stuff to HTTP::Response $response->code( 404 ); $response->content( "Hi visitor from " . $response->connection->remote_ip . ", Page not found -> '" . $request->uri->path . "'" ); # We are done! # For speed, you could use $_[KERNEL]->call( ... ) $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } sub GOT_LOG { # ARG0 = HTTP::Request object, ARG1 = remote IP my ($request, $remote_ip) = @_[ARG0,ARG1]; # Do some sort of logging activity. # If the request was malformed, $request = undef # CHECK FOR A REQUEST OBJECT BEFORE USING IT. if( $request ) { { warn join(' ', time(), $remote_ip, $request->uri ), "\n"; } else { warn join(' ', time(), $remote_ip, 'Bad request' ), "\n"; } return; } =head1 ABSTRACT An easy to use HTTP daemon for POE-enabled programs =head1 DESCRIPTION This module makes serving up HTTP requests a breeze in POE. The hardest thing to understand in this module is the HANDLERS. That's it! The standard way to use this module is to do this: use POE; use POE::Component::Server::SimpleHTTP; POE::Component::Server::SimpleHTTP->new( ... ); POE::Session->create( ... ); POE::Kernel->run(); =head2 Starting SimpleHTTP To start SimpleHTTP, just call it's new method: POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => '192.168.1.1', 'PORT' => 11111, 'HOSTNAME' => 'MySite.com', 'HEADERS' => {}, 'HANDLERS' => [ ], ); This method will die on error or return success. This constructor accepts only 7 options. =over 4 =item C This will set the alias SimpleHTTP uses in the POE Kernel. This will default to "SimpleHTTP" =item C
This value will be passed to POE::Wheel::SocketFactory to bind to, will use INADDR_ANY if it is nothing is provided. =item C This value will be passed to POE::Wheel::SocketFactory to bind to. =item C This value is for the HTTP::Request's URI to point to. If this is not supplied, SimpleHTTP will use Sys::Hostname to find it. =item C This should be a hashref, that will become the default headers on all HTTP::Response objects. You can override this in individual requests by setting it via $request->header( ... ) For more information, consult the L module. =item C This is the hardest part of SimpleHTTP :) You supply an array, with each element being a hash. All the hashes should contain those 3 keys: DIR -> The regexp that will be used, more later. SESSION -> The session to send the input EVENT -> The event to trigger The DIR key should be a valid regexp. This will be matched against the current request path. Pseudocode is: if ( $path =~ /$DIR/ ) NOTE: The path is UNIX style, not MSWIN style ( /blah/foo not \blah\foo ) Now, if you supply 100 handlers, how will SimpleHTTP know what to do? Simple! By passing in an array in the first place, you have already told SimpleHTTP the order of your handlers. They will be tried in order, and if a match is not found, SimpleHTTP will return a 404 response. This allows some cool things like specifying 3 handlers with DIR of: '^/foo/.*', '^/$', '.*' Now, if the request is not in /foo or not root, your 3rd handler will catch it, becoming the "404 not found" handler! NOTE: You might get weird Session/Events, make sure your handlers are in order, for example: '^/', '^/foo/.*' The 2nd handler will NEVER get any requests, as the first one will match ( no $ in the regex ) Now, here's what a handler receives: ARG0 -> HTTP::Request object ARG1 -> POE::Component::Server::SimpleHTTP::Response object ARG2 -> The exact DIR that matched, so you can see what triggered what NOTE: If ARG0 is undef, that means POE::Filter::HTTPD encountered an error parsing the client request, simply modify the HTTP::Response object and send some sort of generic error. SimpleHTTP will set the path used in matching the DIR regexes to an empty string, so if there is a "catch-all" DIR regex like '.*', it will catch the errors, and only that one. NOTE: The only way SimpleHTTP will leak memory ( hopefully heh ) is if you discard the SimpleHTTP::Response object without sending it back to SimpleHTTP via the DONE/CLOSE events, so never do that! =item C Set to true to enable HTTP keep-alive support. Connections will be kept alive until the client closes the connection. All HTTP/1.1 connections are kept-open, unless you set the response C header to C. $response->header( Connection => 'close' ); If you want more control, use L. =item C Expects a hashref with the following key, values: SESSION -> The session to send the input EVENT -> The event to trigger You will receive an event for each request to the server from clients. Malformed client requests will not be passed into the handler. Instead undef will be passed. Event is called before ANY content handler is called. The event will have the following parameters: ARG0 -> HTTP::Request object/undef if client request was malformed. ARG1 -> the IP address of the client =item C Expect a hashref with the following key, valyes: SESSION -> The session to send the input EVENT -> The event to trigger You will receive an event for each response that hit DONE call. Malformed client requests will not be passed into the handler. Event is after processing all content handlers. The event will have the following parameters: ARG0 -> HTTP::Request object ARG1 -> HTTP::Response object That makes possible following code: my ($login, $password) = $request->authorization_basic(); printf STDERR "%s - %s [%s] \"%s %s %s\" %d %d\n", $response->connection->remote_ip, $login||'-', POSIX::strftime("%d/%b/%Y:%T %z",localtime(time())), $request->method(), $request->uri()->path(), $request->protocol(), $response->code(), length($response->content()); Emulate apache-like logs for PoCo::Server::SimpleHTTP =item C Expects a hashref with the following key, values: SESSION -> The session to send the input EVENT -> The event to trigger You will receive an event when the listener wheel has been setup. Currently there are no parameters returned. =item C This should be an arrayref of only 2 elements - the private key and public certificate locations. Now, this is still in the experimental stage, and testing is greatly welcome! Again, this will automatically turn every incoming connection into a SSL socket. Once enough testing has been done, this option will be augmented with more SSL stuff! =item C This option is needed in case the SSL certificate references an intermediate certification authority certificate. =item C Set this to a true value to enable the server to act as a proxy server, ie. it won't mangle the HTTP::Request URI. =back =head2 Events SimpleHTTP is so simple, there are only 8 events available. =over 4 =item C This event accepts only one argument: the HTTP::Response object we sent to the handler. Calling this event implies that this particular request is done, and will proceed to close the socket. NOTE: This method automatically sets those 3 headers if they are not already set: Date -> Current date stringified via HTTP::Date->time2str Content-Type -> text/html Content-Length -> length( $response->content ) To get greater throughput and response time, do not post() to the DONE event, call() it! However, this will force your program to block while servicing web requests... =item C This event accepts only one argument: the HTTP::Response object we sent to the handler. Calling this event will close the socket, not sending any output =item C This event accepts 2 arguments: The session + event to send the response to This event will send back the current HANDLERS array ( deep-cloned via Storable::dclone ) The resulting array can be played around to your tastes, then once you are done... =item C This event accepts only one argument: pointer to HANDLERS array BEWARE: if there is an error in the HANDLERS, SimpleHTTP will die! =item C $_[KERNEL]->call( $_[SENDER], 'SETCLOSEHANDLER', $connection, $event, @args ); Calls C<$event> in the current session when C<$connection> is closed. You could use for persistent connection handling. Multiple session may register close handlers. Calling SETCLOSEHANDLER without C<$event> to remove the current session's handler: $_[KERNEL]->call( $_[SENDER], 'SETCLOSEHANDLER', $connection ); You B make sure that C<@args> doesn't cause a circular reference. Ideally, use C<$connection->ID> or some other unique value associated with this C<$connection>. =item C Starts the listening socket, if it was shut down =item C Simply a wrapper for SHUTDOWN GRACEFUL, but will not shutdown SimpleHTTP if there is no more requests =item C Without arguments, SimpleHTTP does this: Close the listening socket Kills all pending requests by closing their sockets Removes it's alias With an argument of 'GRACEFUL', SimpleHTTP does this: Close the listening socket Waits for all pending requests to come in via DONE/CLOSE, then removes it's alias =item C With a $response argument it streams the content and calls back the streaming event of the user's session (or with the dont_flush option you're responsible for calling back your session's streaming event). To use the streaming feature see below. =back =head2 Streaming with SimpleHTTP It's possible to send data as a stream to clients (unbuffered and integrated in the POE loop). Just create your session to receive events from SimpleHTTP as usually and add a streaming event, this event will be triggered over and over each time you set the $response to a streaming state and once you trigger it: # sets the response as streamed within our session which alias is HTTP_GET # with the event GOT_STREAM $response->stream( session => 'HTTP_GET', event => 'GOT_STREAM', dont_flush => 1 ); # then you can simply yield your streaming event, once the GOT_STREAM event # has reached its end it will be triggered again and again, until you # send a CLOSE event to the kernel with the appropriate response as parameter $kernel->yield('GOT_STREAM', $response); The optionnal dont_flush option gives the user the ability to control the callback to the streaming event, which means once your stream event has reached its end it won't be called, you have to call it back. You can now send data by chunks and either call yourself back (via POE) or shutdown when your streaming is done (EOF for example). sub GOT_STREAM { my ( $kernel, $heap, $response ) = @_[KERNEL, HEAP, ARG0]; # sets the content of the response $response->content("Hello World\n"); # send it to the client POE::Kernel->post('HTTPD', 'STREAM', $response); # if we have previously set the dont_flush option # we have to trigger our event back until the end of # the stream like this (that can be a yield, of course): # # $kernel->delay('GOT_STREAM', 1, $stream ); # otherwise the GOT_STREAM event is triggered continously until # we call the CLOSE event on the response like that : # if ($heap{'streaming_is_done'}) { # close the socket and end the stream POE::Kernel->post('HTTPD', 'CLOSE', $response ); } } The dont_flush option is there to be able to control the frequency of flushes to the client. =head2 SimpleHTTP Notes You can enable debugging mode by doing this: sub POE::Component::Server::SimpleHTTP::DEBUG () { 1 } use POE::Component::Server::SimpleHTTP; Also, this module will try to keep the Listening socket alive. if it dies, it will open it again for a max of 5 retries. You can override this behavior by doing this: sub POE::Component::Server::SimpleHTTP::MAX_RETRIES () { 10 } use POE::Component::Server::SimpleHTTP; For those who are pondering about basic-authentication, here's a tiny snippet to put in the Event handler # Contributed by Rocco Caputo sub Got_Request { # ARG0 = HTTP::Request, ARG1 = HTTP::Response my( $request, $response ) = @_[ ARG0, ARG1 ]; # Get the login my ( $login, $password ) = $request->authorization_basic(); # Decide what to do if ( ! defined $login or ! defined $password ) { # Set the authorization $response->header( 'WWW-Authenticate' => 'Basic realm="MyRealm"' ); $response->code( 401 ); $response->content( 'FORBIDDEN.' ); # Send it off! $_[KERNEL]->post( 'SimpleHTTP', 'DONE', $response ); } else { # Authenticate the user and move on } } =head2 EXPORT Nothing. =head1 SEE ALSO L L L L L L L L =head1 AUTHOR Apocalypse Eapocal@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright 2006 by Apocalypse This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut POE-Component-Server-SimpleHTTP-2.18/lib/POE/Component/Server/SimpleHTTP/State.pm000644 001751 001751 00000003203 12164634146 030005 0ustar00bingosbingos000000 000000 package POE::Component::Server::SimpleHTTP::State; use strict; use warnings; use POE::Wheel::ReadWrite; our $VERSION = '2.18'; use Moose; has 'wheel' => ( is => 'ro', isa => 'POE::Wheel::ReadWrite', clearer => 'clear_wheel', predicate => 'has_wheel', required => 1, ); has 'response' => ( is => 'ro', isa => 'POE::Component::Server::SimpleHTTP::Response', writer => 'set_response', clearer => 'clear_response', ); has 'request' => ( is => 'ro', isa => 'HTTP::Request', writer => 'set_request', clearer => 'clear_request', ); has 'connection' => ( is => 'ro', isa => 'POE::Component::Server::SimpleHTTP::Connection', writer => 'set_connection', clearer => 'clear_connection', init_arg => undef, ); has 'done' => ( is => 'ro', isa => 'Bool', init_arg => undef, default => sub { 0 }, writer => 'set_done', ); has 'streaming' => ( is => 'ro', isa => 'Bool', init_arg => undef, default => sub { 0 }, writer => 'set_streaming', ); sub reset { my $self = shift; $self->clear_response; $self->clear_request; $self->set_streaming(0); $self->set_done(0); $self->wheel->set_output_filter( $self->wheel->get_input_filter ) if $self->has_wheel; return 1; } sub close_wheel { my $self = shift; return unless $self->has_wheel; $self->wheel->shutdown_input; $self->wheel->shutdown_output; $self->clear_wheel; return 1; } sub wheel_alive { my $self = shift; return unless $self->has_wheel; return unless defined $self->wheel; return unless $self->wheel->get_input_handle(); return 1; } no Moose; __PACKAGE__->meta->make_immutable(); 'This monkey has gone to heaven'; __END__ POE-Component-Server-SimpleHTTP-2.18/lib/POE/Component/Server/SimpleHTTP/Response.pm000644 001751 001751 00000004424 12164634146 030531 0ustar00bingosbingos000000 000000 package POE::Component::Server::SimpleHTTP::Response; use strict; use warnings; our $VERSION = '2.18'; use base qw( HTTP::Response ); use Moose; extends qw(HTTP::Response Moose::Object ); has '_WHEEL' => ( is => 'rw', ); has 'connection' => ( is => 'ro', writer => 'set_connection', ); has 'STREAM_SESSION' => ( is => 'rw', ); has 'STREAM' => ( is => 'rw', ); has 'STREAM_DONE' => ( is => 'ro', default => sub { 0 }, writer => 'set_stream_done', init_arg => undef, ); has 'IS_STREAMING' => ( is => 'ro', writer => 'set_streaming', ); has 'DONT_FLUSH' => ( is => 'rw', isa => 'Bool', ); sub new { my $class = shift; # Get the Wheel ID my $wid = shift; # Get the Connection object my $conn = shift; # Make sure we got the wheel ID! if ( !defined $wid ) { die 'Did not get a Wheel ID!'; } my $self = $class->SUPER::new(@_); return $class->meta->new_object( __INSTANCE__ => $self, _WHEEL => $wid, connection => $conn, ); } sub stream { my $self = shift; my %opt = (@_); no strict 'refs'; if ( $opt{event} ne '' ) { $self->STREAM_SESSION( $opt{'session'} || undef ); $self->STREAM( $opt{'event'} ); $self->DONT_FLUSH( $opt{'dont_flush'} ); } else { $self->STREAM( shift ); } } no Moose; __PACKAGE__->meta->make_immutable( inline_constructor => 0 ); # End of module 1; __END__ =head1 NAME POE::Component::Server::SimpleHTTP::Response - Emulates a HTTP::Response object, used for SimpleHTTP =head1 SYNOPSIS use POE::Component::Server::SimpleHTTP::Response; my $response = POE::Component::Server::SimpleHTTP::Response->new( $wheel_id, $connection ); print $response->connection->remote_ip; =head1 DESCRIPTION This module is used as a drop-in replacement, because we need to store the wheel ID + connection object for the response. Use $response->connection to get the SimpleHTTP::Connection object =head2 EXPORT Nothing. =head1 SEE ALSO L L =head1 AUTHOR Apocalypse Eapocal@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright 2006 by Apocalypse This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut POE-Component-Server-SimpleHTTP-2.18/lib/POE/Component/Server/SimpleHTTP/Connection.pm000644 001751 001751 00000006720 12164634146 031033 0ustar00bingosbingos000000 000000 # Declare our package package POE::Component::Server::SimpleHTTP::Connection; use strict; use warnings; our $VERSION = '2.18'; use Socket qw( inet_ntoa unpack_sockaddr_in ); use POE; use Moose; has dead => ( is => 'rw', isa => 'Bool', default => 0, ); has ssl => ( is => 'rw', isa => 'Bool', default => 0, ); has sslcipher => ( is => 'rw', default => undef, ); has remote_ip => ( is => 'ro', ); has remote_port => ( is => 'ro', ); has remote_addr => ( is => 'ro', ); has local_ip => ( is => 'ro', ); has local_port => ( is => 'ro', ); has local_addr => ( is => 'ro', ); has ID => ( is => 'rw', ); has OnClose => ( is => 'ro', default => sub { { } }, ); sub BUILDARGS { my $class = shift; my $self = { }; my $socket = shift; eval { ( $self->{'remote_port'}, $self->{'remote_addr'} ) = unpack_sockaddr_in( getpeername($socket) ); $self->{'remote_ip'} = inet_ntoa( $self->{'remote_addr'} ); ( $self->{'local_port'}, $self->{'local_addr'} ) = unpack_sockaddr_in( getsockname($socket) ); $self->{'local_ip'} = inet_ntoa( $self->{'local_addr'} ); }; if ($@) { return undef; } return $self; } sub _on_close { my ( $self, $sessionID, $state, @args ) = @_; if ($state) { $self->OnClose->{$sessionID} = [ $state, @args ]; $poe_kernel->refcount_increment( $sessionID, __PACKAGE__ ); } else { my $data = delete $self->OnClose->{$sessionID}; $poe_kernel->refcount_decrement( $sessionID, __PACKAGE__ ) if $data; } } sub DEMOLISH { my ($self) = @_; while ( my ( $sessionID, $data ) = each %{ $self->OnClose || {} } ) { $poe_kernel->call( $sessionID, @$data ); $poe_kernel->refcount_decrement( $sessionID, __PACKAGE__ ); } } no Moose; __PACKAGE__->meta->make_immutable; # End of module 1; __END__ =head1 NAME POE::Component::Server::SimpleHTTP::Connection - Stores connection information for SimpleHTTP =head1 SYNOPSIS use POE::Component::Server::SimpleHTTP::Connection; my $connection = POE::Component::Server::SimpleHTTP::Connection->new( $socket ); # Print some stuff print $connection->remote_port; =head1 DESCRIPTION This module simply holds some information from a SimpleHTTP connection. =head2 METHODS my $connection = POE::Component::Server::SimpleHTTP::Connection->new( $socket ); $connection->remote_ip(); # Returns remote ip in dotted quad format ( 1.1.1.1 ) $connection->remote_port(); # Returns remote port $connection->remote_addr(); # Returns true remote address, consult the L POD $connection->local_addr(); # Returns true local address, same as above $connection->local_ip(); # Returns local ip in dotted quad format ( 1.1.1.1 ) $connection->local_port(); # Returns local port $connection->dead(); # Returns a boolean value whether the socket is closed or not $connection->ssl(); # Returns a boolean value whether the socket is SSLified or not $connection->sslcipher(); # Returns the SSL Cipher type or undef if not SSL $connection->ID(); # unique ID of this connection =head2 EXPORT Nothing. =head1 SEE ALSO L, L =head1 AUTHOR Apocalypse Eapocal@cpan.orgE Chris C Williams =head1 COPYRIGHT AND LICENSE Copyright E Apocalypse and Chris Williams This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut POE-Component-Server-SimpleHTTP-2.18/examples/server.pl000644 001751 001751 00000003356 12143730252 023517 0ustar00bingosbingos000000 000000 use POE; use POE::Component::Server::SimpleHTTP; use Sys::Hostname qw( hostname ); # Start the server! POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => 0, 'PORT' => 8080, 'HANDLERS' => [ { 'DIR' => '^/$', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_MAIN', }, { 'DIR' => '.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_ERR', }, ], 'HEADERS' => { 'Server' => 'My Own Server', }, ) or die 'Unable to create the HTTP Server'; # Create our own session to receive events from SimpleHTTP POE::Session->create( inline_states => { '_start' => sub { $_[KERNEL]->alias_set( 'HTTP_GET' ) }, 'GOT_MAIN' => \&GOT_REQ, 'GOT_ERR' => \&GOT_ERR, }, ); # Start POE! POE::Kernel->run(); # We're done! exit; sub GOT_REQ { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Do our stuff to HTTP::Response $response->code( 200 ); $response->content( 'Hi, you fetched ' . $request->uri ); # We are done! $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } sub GOT_ERR { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Check for errors if ( ! defined $request ) { $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); return; } # Do our stuff to HTTP::Response $response->code( 404 ); $response->content( "Hi visitor from " . $response->connection->remote_ip . ", Page not found -> '" . $request->uri->path . "'" ); # We are done! # For speed, you could use $_[KERNEL]->call( ... ) $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } POE-Component-Server-SimpleHTTP-2.18/examples/proxy.pl000644 001751 001751 00000005714 12143730252 023372 0ustar00bingosbingos000000 000000 use strict; use warnings; sub POE::Component::Server::SimpleHTTP::DEBUG () { 1 } use POE qw(Component::Client::HTTP Component::Server::SimpleHTTP); use POE::Component::Server::SimpleHTTP::Response; # Stolen from POE::Wheel. This is static data, shared by all my $current_id = 0; my %active_identifiers; sub _allocate_identifier { while (1) { last unless exists $active_identifiers{ ++$current_id }; } return $active_identifiers{$current_id} = $current_id; } sub _free_identifier { my $id = shift; delete $active_identifiers{$id}; } my $agent = 'proxy' . $$; my $httpd = 'HTTPD' . $$; POE::Component::Client::HTTP->spawn( Alias => $agent, Streaming => 4096, ); POE::Component::Server::SimpleHTTP->new( KEEPALIVE => 1, ALIAS => $httpd, PORT => 11111, PROXYMODE => 1, HANDLERS => [ { DIR => '.*', SESSION => 'controller', EVENT => 'got_request', }, ], ); POE::Session->create( package_states => [ main => [qw(_start got_request _got_stream _response)], ], ); $poe_kernel->run(); exit 0; sub _start { $poe_kernel->alias_set( 'controller' ); return; } sub got_request { my($kernel,$heap,$request,$response,$dirmatch) = @_[KERNEL,HEAP,ARG0..ARG2]; my $httpd = $_[SENDER]->get_heap(); use Data::Dumper; $Data::Dumper::Indent=1; print Dumper( $response ); # Check for errors if ( ! defined $request ) { $kernel->post( $httpd, 'DONE', $response ); return; } $request->header('Connection', 'Keep-Alive'); $request->remove_header('Accept-Encoding'); # Let's see if it is a CONNECT request warn $request->as_string; warn $request->method, "\n"; if ( $request->method eq 'CONNECT' ) { my $uri = $request->uri; # warn $uri->authority, "\n"; warn $uri->as_string, "\n"; } $response->stream( session => 'controller', event => '_got_stream', dont_flush => 1 ); my $id = _allocate_identifier(); $kernel->post( $agent, 'request', '_response', $request, "$id", ); $heap->{_requests}->{ $id } = $response; return; } sub _response { my ($kernel,$heap,$request_packet,$response_packet) = @_[KERNEL,HEAP,ARG0,ARG1]; my $id = $request_packet->[1]; my $resp = $heap->{_requests}->{ $id }; my $response = _rebless( $resp, $response_packet->[0] ); my $chunk = $response_packet->[1]; warn $response->headers_as_string, "\n"; if ( $chunk ) { $response->content( $chunk ); $kernel->post( $httpd, 'STREAM', $response ); } else { $kernel->post( $httpd, 'DONE', $response ); } return; } sub _got_stream { my ($kernel,$heap,$response) = @_[KERNEL,HEAP,ARG0]; return; } sub _rebless { my ($orig,$new) = @_; $new->{$_} = $orig->{$_} for grep { exists $orig->{$_} } qw(_WHEEL connection STREAM_SESSION STREAM DONT_FLUSH IS_STREAMING); bless $new, 'POE::Component::Server::SimpleHTTP::Response'; return $new; } POE-Component-Server-SimpleHTTP-2.18/examples/stream.pl000644 001751 001751 00000003065 12143730252 023501 0ustar00bingosbingos000000 000000 use POE; use POE::Component::Server::SimpleHTTP; use Sys::Hostname qw( hostname ); # Start the server! POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => 127.0.0.1, 'PORT' => 8080, 'HANDLERS' => [ { 'DIR' => '.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_MAIN', }, ], 'HEADERS' => { 'Server' => 'My Own Server', }, ) or die 'Unable to create the HTTP Server'; # Create our own session to receive events from SimpleHTTP POE::Session->create( inline_states => { '_start' => sub { $_[KERNEL]->alias_set( 'HTTP_GET' ) }, 'GOT_MAIN' => \&GOT_REQ, 'GOT_STREAM' => \&GOT_STREAM, }, ); # Start POE! POE::Kernel->run(); # We're done! exit; sub GOT_REQ { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Do our stuff to HTTP::Response $response->code( 200 ); $response->content_type("text/plain"); # sets the response as streamed within our session with the stream event $response->stream( session => 'HTTP_GET', event => 'GOT_STREAM' ); # We are done! $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } sub GOT_STREAM { my ( $kernel, $heap, $stream ) = @_[KERNEL, HEAP, ARG0]; # the stream hash contains the wheel, the request, the response # and an id associated the the wheel $stream->{'wheel'}->put("Hello World\n"); # lets go on streaming ... POE::Kernel->delay('GOT_STREAM', 1, $stream ); } POE-Component-Server-SimpleHTTP-2.18/examples/prefork.pl000644 001751 001751 00000004132 12143730252 023652 0ustar00bingosbingos000000 000000 use POE; use POE::Component::Server::SimpleHTTP::PreFork; use Sys::Hostname qw( hostname ); # Start the server! POE::Component::Server::SimpleHTTP::PreFork->new( 'ALIAS' => 'HTTPD', 'PORT' => 8080, 'HANDLERS' => [ { 'DIR' => '^/$', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_MAIN', }, { 'DIR' => '.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_ERR', }, ], 'HEADERS' => { 'Server' => 'My Own Server', }, # In the testing phase... 'FORKHANDLERS' => { 'HTTP_GET' => 'FORKED' }, 'MINSPARESERVERS' => 5, 'MAXSPARESERVERS' => 10, 'MAXCLIENTS' => 256, 'STARTSERVERS' => 10, ) or die 'Unable to create the HTTP Server'; # Create our own session to receive events from SimpleHTTP POE::Session->create( inline_states => { '_start' => sub { $_[KERNEL]->alias_set( 'HTTP_GET' ) }, 'GOT_MAIN' => \&GOT_REQ, 'GOT_ERR' => \&GOT_ERR, 'FORKED' => \&GOT_FORKED, }, ); # Start POE! POE::Kernel->run(); # We're done! exit; sub GOT_FORKED { warn "Forked\n"; return; } sub GOT_REQ { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Do our stuff to HTTP::Response $response->code( 200 ); $response->content( 'Hi, you fetched ' . $request->uri ); # We are done! $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } sub GOT_ERR { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Check for errors if ( ! defined $request ) { $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); return; } # Do our stuff to HTTP::Response $response->code( 404 ); $response->content( "Hi visitor from " . $response->connection->remote_ip . ", Page not found -> '" . $request->uri->path . "'" ); # We are done! # For speed, you could use $_[KERNEL]->call( ... ) $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } POE-Component-Server-SimpleHTTP-2.18/t/04_run_keepalive.t000644 001751 001751 00000013366 12143730252 023624 0ustar00bingosbingos000000 000000 use strict; use warnings; #use Test::More tests => 8; use Test::More; #sub POE::Component::Server::SimpleHTTP::DEBUG () { 1 } use POE qw(Component::Server::SimpleHTTP Filter::Stream); use Test::POE::Client::TCP; use HTTP::Request; use HTTP::Response; use POE::Filter::HTTP::Parser; my @tests = ( [ '/', { code => '200', content => 'this is top' } ], [ '/honk/', { code => '200', content => 'this is honk' } ], [ '/bonk/zip.html', { code => '200', content_type => 'text/html', content => 'my friend' } ], [ '/wedonthaveone', { code => '404', } ], ); my $test_count = 0; $test_count += scalar keys %{ $_->[1] } for @tests; plan tests => 6 + $test_count; POE::Session->create( package_states => [ main => [qw(_start _tests _run_tests webc_connected webc_input webc_disconnected TOP HONK BONK BONK2 _stop)], ], heap => { tests => \@tests, }, ); $poe_kernel->run(); exit 0; sub _start { my $session_id = $_[SESSION]->ID(); POE::Component::Server::SimpleHTTP->new( KEEPALIVE=>1, 'ALIAS' => 'HTTPD', 'ADDRESS' => '127.0.0.1', 'PORT' => 0, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '^/honk/', 'SESSION' => $session_id, 'EVENT' => 'HONK', }, { 'DIR' => '^/bonk/zip.html', 'SESSION' => $session_id, 'EVENT' => 'BONK2', }, { 'DIR' => '^/bonk/', 'SESSION' => $session_id, 'EVENT' => 'BONK', }, { 'DIR' => '^/$', 'SESSION' => $session_id, 'EVENT' => 'TOP', }, ], SETUPHANDLER => { SESSION => $session_id, EVENT => '_tests', }, ); return; } sub _stop { pass('Let my people go go'); return; } sub _tests { my ($kernel,$heap,$port) = @_[KERNEL,HEAP,ARG0]; $heap->{webc} = Test::POE::Client::TCP->spawn( address => '127.0.0.1', port => $port, autoconnect => 1, prefix => 'webc', filter => POE::Filter::HTTP::Parser->new(), ); $heap->{port} = $port; return; } sub webc_connected { my ($kernel,$heap) = @_[KERNEL,HEAP]; $kernel->yield( '_run_tests' ); return; } sub _run_tests { my ($kernel,$heap) = @_[KERNEL,HEAP]; $heap->{parser} = HTTP::Parser->new( response => 1 ); my $test = shift @{ $heap->{tests} }; return unless $test; my $path = $test->[0]; $heap->{current_tests} = $test->[1]; my $req = HTTP::Request->new( GET => $path ); $req->protocol( 'HTTP/1.1' ); $req->header( 'Host', "127.0.0.1:$heap->{port}" ); $req->header( 'Keep-Alive', 300 ); $req->header( 'Connection', 'keep-alive' ); # my $keepalive = ''; # $keepalive = "Keep-Alive: 300\x0D\x0AConnection: keep-alive\x0D\x0A"; # $heap->{webc}->send_to_server("GET $path HTTP/1.1\x0D\x0AHost: 127.0.0.1:$heap->{port}\x0D\x0A$keepalive\x0D\x0A"); $heap->{webc}->send_to_server( $req ); return; } sub webc_input { my ($heap,$resp) = @_[HEAP,ARG0]; # my $status = $heap->{parser}->add($input); # if ( $status == 0 ) { # my $resp = $heap->{parser}->object(); isa_ok( $resp, 'HTTP::Response' ); diag($resp->as_string); my $tests = delete $heap->{current_tests}; foreach my $test ( keys %{ $tests } ) { if ( $test eq 'code' ) { ok( $resp->code eq $tests->{$test}, 'Code: ' . $tests->{$test} ); } if ( $test eq 'content_type' ) { ok( $resp->content_type eq $tests->{$test}, 'Content-Type: ' . $tests->{$test} ); } if ( $test eq 'content' ) { like( $resp->content, qr/$tests->{$test}/, 'Content: ' . $tests->{$test} ); } } $poe_kernel->yield( '_run_tests' ); # } # else { # } return; } sub webc_disconnected { my ($heap,$state) = @_[HEAP,STATE]; pass($state); $heap->{webc}->shutdown(); delete $heap->{webc}; $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } ####################################### sub TOP { my ($request, $response) = @_[ARG0, ARG1]; $response->code(200); $response->content_type('text/plain'); $response->content("this is top"); $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } ####################################### sub HONK { my ($request, $response) = @_[ARG0, ARG1]; my $c = $response->connection; $_[KERNEL]->call( $_[SENDER], 'SETCLOSEHANDLER', $c->ID, 'on_close', [ $c->ID, "something" ], "more" ); $response->code(200); $response->content_type('text/plain'); $response->content("this is honk"); $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } ####################################### sub BONK { my ($request, $response) = @_[ARG0, ARG1]; fail( "bonk should never be called" ); $response->code(200); $response->content_type('text/plain'); $response->content("this is bonk"); $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } ####################################### sub BONK2 { my ($request, $response) = @_[ARG0, ARG1]; $response->code(200); $response->content_type('text/html'); $response->content(<<' HTML'); YEAH!

This, my friend, is the page you've been looking for.

HTML $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } POE-Component-Server-SimpleHTTP-2.18/t/99_pod.t000644 001751 001751 00000000201 12143730252 021553 0ustar00bingosbingos000000 000000 use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); POE-Component-Server-SimpleHTTP-2.18/t/99_pod_coverage.t000644 001751 001751 00000000267 12143730252 023442 0ustar00bingosbingos000000 000000 use Test::More; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@ or !$ENV{BINGOS_TEST}; all_pod_coverage_ok(); POE-Component-Server-SimpleHTTP-2.18/t/04_run_close.t000644 001751 001751 00000012077 12143730252 022762 0ustar00bingosbingos000000 000000 use strict; use warnings; #use Test::More tests => 8; use Test::More; use POE qw(Component::Server::SimpleHTTP Filter::Stream); use Test::POE::Client::TCP; use HTTP::Request; use HTTP::Response; use POE::Filter::HTTP::Parser; my @tests = ( [ '/', { code => '200', content => 'this is top' } ], [ '/honk/', { code => '200', content => 'this is honk' } ], [ '/bonk/zip.html', { code => '200', content_type => 'text/html', content => 'my friend' } ], [ '/wedonthaveone', { code => '404', } ], ); my $test_count = 0; $test_count += scalar keys %{ $_->[1] } for @tests; plan tests => 8 + $test_count; POE::Session->create( package_states => [ main => [qw(_start _tests webc_connected webc_input webc_disconnected TOP HONK BONK BONK2)], ], heap => { tests => \@tests, }, ); $poe_kernel->run(); exit 0; sub _start { my $session_id = $_[SESSION]->ID(); POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => '127.0.0.1', 'PORT' => 0, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '^/honk/', 'SESSION' => $session_id, 'EVENT' => 'HONK', }, { 'DIR' => '^/bonk/zip.html', 'SESSION' => $session_id, 'EVENT' => 'BONK2', }, { 'DIR' => '^/bonk/', 'SESSION' => $session_id, 'EVENT' => 'BONK', }, { 'DIR' => '^/$', 'SESSION' => $session_id, 'EVENT' => 'TOP', }, ], SETUPHANDLER => { SESSION => $session_id, EVENT => '_tests', }, ); return; } sub _tests { my ($kernel,$heap,$port) = @_[KERNEL,HEAP,ARG0]; $heap->{webc} = Test::POE::Client::TCP->spawn( address => '127.0.0.1', port => $port, autoconnect => 1, prefix => 'webc', filter => POE::Filter::HTTP::Parser->new(), ); $heap->{port} = $port; return; } sub webc_connected { my ($kernel,$heap) = @_[KERNEL,HEAP]; my $test = shift @{ $heap->{tests} }; my $path = $test->[0]; $heap->{current_tests} = $test->[1]; my $req = HTTP::Request->new( GET => $path ); $req->header( Host => "127.0.0.1:$heap->{port}" ); $req->protocol( 'HTTP/1.1' ); $heap->{webc}->send_to_server( $req ); return; } sub webc_input { my ($heap,$resp) = @_[HEAP,ARG0]; isa_ok( $resp, 'HTTP::Response' ); diag($resp->as_string); my $tests = delete $heap->{current_tests}; foreach my $test ( keys %{ $tests } ) { if ( $test eq 'code' ) { ok( $resp->code eq $tests->{$test}, 'Code: ' . $tests->{$test} ); } if ( $test eq 'content_type' ) { ok( $resp->content_type eq $tests->{$test}, 'Content-Type: ' . $tests->{$test} ); } if ( $test eq 'content' ) { like( $resp->content, qr/$tests->{$test}/, 'Content: ' . $tests->{$test} ); } } return; } sub webc_disconnected { my ($heap,$state) = @_[HEAP,STATE]; pass($state); $heap->{webc}->shutdown(); delete $heap->{webc}; if ( scalar @{ $heap->{tests} } ) { $poe_kernel->yield( '_tests', $heap->{port} ); return; } $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } ####################################### sub TOP { my ($request, $response) = @_[ARG0, ARG1]; $response->code(200); $response->content_type('text/plain'); $response->content("this is top"); $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } ####################################### sub HONK { my ($request, $response) = @_[ARG0, ARG1]; my $c = $response->connection; $_[KERNEL]->call( $_[SENDER], 'SETCLOSEHANDLER', $c->ID, 'on_close', [ $c->ID, "something" ], "more" ); $response->code(200); $response->content_type('text/plain'); $response->content("this is honk"); $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } ####################################### sub BONK { my ($request, $response) = @_[ARG0, ARG1]; fail( "bonk should never be called" ); $response->code(200); $response->content_type('text/plain'); $response->content("this is bonk"); $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } ####################################### sub BONK2 { my ($request, $response) = @_[ARG0, ARG1]; $response->code(200); $response->content_type('text/html'); $response->content(<<' HTML'); YEAH!

This, my friend, is the page you've been looking for.

HTML $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } POE-Component-Server-SimpleHTTP-2.18/t/05_post.t000644 001751 001751 00000006741 12143730252 021760 0ustar00bingosbingos000000 000000 use strict; use warnings; #use Test::More tests => 8; use Test::More; use POE qw(Component::Server::SimpleHTTP Filter::Stream); use Test::POE::Client::TCP; use HTTP::Request; use HTTP::Response; use POE::Filter::HTTP::Parser; my @tests = ( [ '/', { code => '200', content => '^we' } ], ); my $test_count = 0; $test_count += scalar keys %{ $_->[1] } for @tests; plan tests => 2 + $test_count; POE::Session->create( package_states => [ main => [qw(_start _tests webc_connected webc_input webc_disconnected TOP)], ], heap => { tests => \@tests, }, options => { trace => 0 }, ); $poe_kernel->run(); exit 0; sub _start { my $session_id = $_[SESSION]->ID(); POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => '127.0.0.1', 'PORT' => 0, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '^/$', 'SESSION' => $session_id, 'EVENT' => 'TOP', }, ], SETUPHANDLER => { SESSION => $session_id, EVENT => '_tests', }, ); return; } sub _tests { my ($kernel,$heap,$port) = @_[KERNEL,HEAP,ARG0]; $heap->{webc} = Test::POE::Client::TCP->spawn( address => '127.0.0.1', port => $port, autoconnect => 1, prefix => 'webc', filter => POE::Filter::HTTP::Parser->new(), ); $heap->{port} = $port; return; } sub webc_connected { my ($kernel,$heap) = @_[KERNEL,HEAP]; my $test = shift @{ $heap->{tests} }; my $path = $test->[0]; $heap->{current_tests} = $test->[1]; my $req = HTTP::Request->new( POST => $path ); $req->header( Host => "127.0.0.1:$heap->{port}" ); $req->header( 'Content-Length', 40 ); $req->protocol( 'HTTP/1.1' ); $req->content( 'brother !~we need to get off this island' ); # $heap->{webc}->send_to_server("POST $path HTTP/1.1\x0D\x0AHost: 127.0.0.1:$heap->{port}\x0D\x0AContent-Length: 40\x0D\x0A\x0D\x0Abrother !~we need to get off this island"); $heap->{webc}->send_to_server( $req ); return; } sub webc_input { my ($heap,$resp) = @_[HEAP,ARG0]; # my $status = $heap->{parser}->add($input); # if ( $status == 0 ) { # my $resp = $heap->{parser}->object(); isa_ok( $resp, 'HTTP::Response' ); diag($resp->as_string); my $tests = delete $heap->{current_tests}; foreach my $test ( keys %{ $tests } ) { if ( $test eq 'code' ) { ok( $resp->code eq $tests->{$test}, 'Code: ' . $tests->{$test} ); } if ( $test eq 'content_type' ) { ok( $resp->content_type eq $tests->{$test}, 'Content-Type: ' . $tests->{$test} ); } if ( $test eq 'content' ) { like( $resp->content, qr/$tests->{$test}/, 'Content: ' . $tests->{$test} ); } } # } # else { # } return; } sub webc_disconnected { my ($heap,$state) = @_[HEAP,STATE]; pass($state); $heap->{webc}->shutdown(); delete $heap->{webc}; if ( scalar @{ $heap->{tests} } ) { $poe_kernel->yield( '_tests', $heap->{port} ); return; } $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } sub TOP { my ($request, $response) = @_[ARG0, ARG1]; diag($request->as_string); $response->code(200); $response->content_type('text/plain'); $response->content(join ' ', reverse split (/~/, $request->content) ); $poe_kernel->post( 'HTTPD', 'DONE', $response ); return; } POE-Component-Server-SimpleHTTP-2.18/t/02_simple.t000644 001751 001751 00000005663 12143730252 022263 0ustar00bingosbingos000000 000000 use strict; use warnings; use Test::More tests => 2; use POE qw(Component::Server::SimpleHTTP Filter::Stream); use Test::POE::Client::TCP; use HTTP::Request; POE::Session->create( package_states => [ main => [qw(_start _tests webc_connected webc_input webc_disconnected TOP)], ], ); $poe_kernel->run(); exit 0; sub _start { my $session_id = $_[SESSION]->ID(); POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => '127.0.0.1', 'PORT' => 0, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '^/honk/', 'SESSION' => $session_id, 'EVENT' => 'HONK', }, { 'DIR' => '^/bonk/zip.html', 'SESSION' => $session_id, 'EVENT' => 'BONK2', }, { 'DIR' => '^/bonk/', 'SESSION' => $session_id, 'EVENT' => 'BONK', }, { 'DIR' => '^/$', 'SESSION' => $session_id, 'EVENT' => 'TOP', }, ], SETUPHANDLER => { SESSION => $session_id, EVENT => '_tests', }, ); return; } sub _tests { my ($kernel,$heap,$sender,$port) = @_[KERNEL,HEAP,SENDER,ARG0]; $heap->{webc} = Test::POE::Client::TCP->spawn( address => '127.0.0.1', port => $port, autoconnect => 1, prefix => 'webc', filter => POE::Filter::Stream->new(), ); $heap->{port} = $port; return; } sub webc_connected { my ($kernel,$heap) = @_[KERNEL,HEAP]; $heap->{webc}->send_to_server("GET / HTTP/1.1\x0D\x0AHost: 127.0.0.1:$heap->{port}\x0D\x0A\x0D\x0A"); return; } sub TOP { my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; diag($request->as_string); $response->code( 200 ); $response->content('Moo'); $poe_kernel->post( $_[SENDER], 'DONE', $response ); return; } sub webc_input { my ($heap,$input) = @_[HEAP,ARG0]; diag($input); # HTTP/1.1 200 (OK) # Date: Tue, 20 Jan 2009 11:56:35 GMT # Content-Length: 3 # Content-Type: text/plain if ( $input =~ /^HTTP/ ) { like ($input, qr/HTTP\/1.1 200 \(OK\)/, 'HTTP/1.1 200 (OK)' ); return; } return; } sub webc_disconnected { my ($heap,$state) = @_[HEAP,STATE]; pass($state); $heap->{webc}->shutdown(); delete $heap->{webc}; $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } POE-Component-Server-SimpleHTTP-2.18/t/06_stream.t000644 001751 001751 00000012042 12143730252 022256 0ustar00bingosbingos000000 000000 use strict; use Test::More; #plan skip_all => 'MSWin32 does not have a proper fork()' if $^O eq 'MSWin32'; BEGIN { eval { require POE::Component::Client::HTTP; }; plan skip_all => 'POE::Component::Client::HTTP is required for this test' if $@; } plan tests => 6; use HTTP::Request; use POE; use POE::Kernel; #sub POE::Component::Server::SimpleHTTP::DEBUG () { 1 } use POE::Component::Server::SimpleHTTP; my $PORT = 2080; my $IP = "localhost"; our %STREAMS; #################################################################### POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => "$IP", 'PORT' => $PORT, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_MAIN', }, ], SETUPHANDLER => { SESSION => 'HTTP_GET', EVENT => '_tests', }, ); # Create our own session to receive events from SimpleHTTP POE::Component::Client::HTTP->spawn( Agent => 'TestAgent', Alias => 'ua', Protocol => 'HTTP/1.1', From => 'test@tester', Streaming => 100, Proxy => q{}, ); POE::Session->create( inline_states => { '_start' => sub { $_[KERNEL]->alias_set( 'HTTP_GET' ); $_[KERNEL]->yield('keepalive'); return; }, '_tests' => \&_tests, 'GOT_MAIN' => \&GOT_MAIN, 'GOT_STREAM' => \&GOT_STREAM, keepalive => \&keepalive, response => \&response, '_shutdown' => \&_shutdown, 'on_close' => \&on_close, }, ); $poe_kernel->run(); is( 0+keys %STREAMS, 0, "No open streams" ); exit 0; sub GOT_MAIN { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $kernel, $heap, $request, $response, $dirmatch ) = @_[KERNEL, HEAP, ARG0 .. ARG2 ]; # Do our stuff to HTTP::Response $response->code( 200 ); $response->content_type("text/plain"); print "# GOT_MAIN \n"; # sets the response as streamed within our session with the stream event $response->stream( session => 'HTTP_GET', event => 'GOT_STREAM' ); $heap->{'count'} ||= 0; my $c = $response->connection; $STREAMS{ $c->ID }=1; $_[KERNEL]->call( $_[SENDER], 'SETCLOSEHANDLER', $c, 'on_close', $c->ID ); # We are done! $kernel->yield('GOT_STREAM', $response); return; } sub GOT_STREAM { my ( $kernel, $heap, $response ) = @_[KERNEL, HEAP, ARG0]; # lets go on streaming ... if ($heap->{'count'} <= 2) { my $text = "Hello World ".$heap->{'count'}." \n"; #print "send ".$text."\n"; $response->content($text); $heap->{'count'}++; POE::Kernel->post('HTTPD', 'STREAM', $response); } else { $STREAMS{ $response->connection->ID }--; POE::Kernel->post('HTTPD', 'CLOSE', $response ); } return; } sub keepalive { my $heap = $_[HEAP]; $_[KERNEL]->delay_set('keepalive', 1); return; } sub _shutdown { $poe_kernel->alarm_remove_all(); $poe_kernel->alias_remove( 'HTTP_GET' ); $poe_kernel->post( 'ua', 'shutdown' ); $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } sub _tests { my ( $kernel, $heap, $session ) = @_[KERNEL, HEAP, SESSION ]; $heap->{'client_count'} = 0; my $request = HTTP::Request->new(GET => "http://$IP:$PORT/"); diag('Test a stream of 3 helloworlds ..'); POE::Kernel->post('ua', 'request', 'response', $request); return; } sub response { my ( $kernel, $heap, $session, $request_packet, $response_packet ) = @_[KERNEL, HEAP, SESSION, ARG0, ARG1]; my $return; # HTTP::Request my $request = $request_packet->[0]; my $response = $response_packet->[0]; # the PoCoClientHTTP sends the first chunk in the content # of the http response #if ($heap->{'count'} == 1) { # my $data = $response->content; # chomp($data); #print $data."\n"; # ok($data =~ /Hello World 0/, "First one as response content received"); #} # then all streamed data in the second element of the response # array ... my ($resp, $data) = @$response_packet; return unless $data; chomp($data); foreach my $hello ( split /\n/, $data ) { ok($hello =~ /Hello World/, "Received a hello"); $heap->{'client_count'}++; } if ($heap->{'client_count'} == 3) { is($heap->{'client_count'}, 3, "Got 3 streamed helloworlds ... all good :)"); $kernel->yield( '_shutdown' ); return; } return; } sub on_close { my $wid = $_[ARG0]; is( $STREAMS{$wid}, 0, "on_close comes after CLOSE" ); delete $STREAMS{ $wid } if $STREAMS{ $wid } == 0; } POE-Component-Server-SimpleHTTP-2.18/t/03_bad_request.t000644 001751 001751 00000005663 12143730252 023271 0ustar00bingosbingos000000 000000 use strict; use warnings; use Test::More tests => 2; use POE qw(Component::Server::SimpleHTTP Filter::Stream); use Test::POE::Client::TCP; use HTTP::Request; POE::Session->create( package_states => [ main => [qw(_start _tests webc_connected webc_input webc_disconnected TOP)], ], ); $poe_kernel->run(); exit 0; sub _start { my $session_id = $_[SESSION]->ID(); POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => '127.0.0.1', 'PORT' => 0, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '^/honk/', 'SESSION' => $session_id, 'EVENT' => 'HONK', }, { 'DIR' => '^/bonk/zip.html', 'SESSION' => $session_id, 'EVENT' => 'BONK2', }, { 'DIR' => '^/bonk/', 'SESSION' => $session_id, 'EVENT' => 'BONK', }, { 'DIR' => '^/$', 'SESSION' => $session_id, 'EVENT' => 'TOP', }, ], SETUPHANDLER => { SESSION => $session_id, EVENT => '_tests', }, ); return; } sub _tests { my ($kernel,$heap,$sender,$port) = @_[KERNEL,HEAP,SENDER,ARG0]; $heap->{webc} = Test::POE::Client::TCP->spawn( address => '127.0.0.1', port => $port, autoconnect => 1, prefix => 'webc', filter => POE::Filter::Stream->new(), ); $heap->{port} = $port; return; } sub webc_connected { my ($kernel,$heap) = @_[KERNEL,HEAP]; $heap->{webc}->send_to_server("GEt / HTTP/1.1\x0D\x0AHost: 127.0.0.1:$heap->{port}\x0D\x0A\x0D\x0A"); return; } sub TOP { my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; diag($request->as_string); $response->code( 200 ); $response->content('Moo'); $poe_kernel->post( $_[SENDER], 'DONE', $response ); return; } sub webc_input { my ($heap,$input) = @_[HEAP,ARG0]; diag($input); # HTTP/1.1 200 (OK) # Date: Tue, 20 Jan 2009 11:56:35 GMT # Content-Length: 3 # Content-Type: text/plain if ( $input =~ /^HTTP/ ) { like ($input, qr/HTTP\/1.1 200 \(OK\)/, 'HTTP/1.1 200 (OK)' ); return; } return; } sub webc_disconnected { my ($heap,$state) = @_[HEAP,STATE]; pass($state); $heap->{webc}->shutdown(); delete $heap->{webc}; $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } POE-Component-Server-SimpleHTTP-2.18/t/01_load.t000644 001751 001751 00000000574 12143730252 021704 0ustar00bingosbingos000000 000000 use Test::More tests => 4; use_ok( 'POE::Component::Server::SimpleHTTP::State' ); use_ok( 'POE::Component::Server::SimpleHTTP::Connection' ); use_ok( 'POE::Component::Server::SimpleHTTP::Response' ); use_ok( 'POE::Component::Server::SimpleHTTP' ); diag( "Testing POE::Component::Server::SimpleHTTP-$POE::Component::Server::SimpleHTTP::VERSION, POE-$POE::VERSION, Perl $], $^X" ); POE-Component-Server-SimpleHTTP-2.18/t/03_bad_handler.t000644 001751 001751 00000004330 12143730252 023204 0ustar00bingosbingos000000 000000 use strict; use warnings; use Test::More tests => 3; use POE qw(Component::Server::SimpleHTTP Filter::Stream); use Test::POE::Client::TCP; use HTTP::Request; use HTTP::Response; POE::Session->create( package_states => [ main => [qw(_start _tests webc_connected webc_input webc_disconnected TOP)], ], ); $poe_kernel->run(); exit 0; sub _start { my $session_id = $_[SESSION]->ID(); POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => '127.0.0.1', 'PORT' => 0, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '^/$', 'SESSION' => $session_id, 'EVENT' => 'TOP', }, ], SETUPHANDLER => { SESSION => $session_id, EVENT => '_tests', }, ); return; } sub _tests { my ($kernel,$heap,$sender,$port) = @_[KERNEL,HEAP,SENDER,ARG0]; $heap->{webc} = Test::POE::Client::TCP->spawn( address => '127.0.0.1', port => $port, autoconnect => 1, prefix => 'webc', filter => POE::Filter::Stream->new(), ); $heap->{port} = $port; return; } sub webc_connected { my ($kernel,$heap) = @_[KERNEL,HEAP]; $heap->{webc}->send_to_server("GET /rubbish HTTP/1.1\x0D\x0AHost: 127.0.0.1:$heap->{port}\x0D\x0A\x0D\x0A"); return; } sub TOP { my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; diag($request->as_string); $response->code( 200 ); $response->content("Moo\nMoo\nMoo\nMoo\n"); $poe_kernel->post( $_[SENDER], 'DONE', $response ); return; } sub webc_input { my ($heap,$input) = @_[HEAP,ARG0]; $heap->{string} .= $input; return; } sub webc_disconnected { my ($heap,$state) = @_[HEAP,STATE]; pass($state); my $response = HTTP::Response->parse( $heap->{string} ); isa_ok( $response, 'HTTP::Response' ) and diag($response->as_string); ok( $response->code eq '404', 'Got a 404 response from bad handler' ); $heap->{webc}->shutdown(); delete $heap->{webc}; $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } POE-Component-Server-SimpleHTTP-2.18/inc/Module/000755 001751 001751 00000000000 12164634317 022035 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.18/inc/Module/Install/000755 001751 001751 00000000000 12164634317 023443 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.18/inc/Module/Install.pm000644 001751 001751 00000030135 12164634251 024000 0ustar00bingosbingos000000 000000 #line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. POE-Component-Server-SimpleHTTP-2.18/inc/Module/Install/WriteAll.pm000644 001751 001751 00000002376 12164634253 025533 0ustar00bingosbingos000000 000000 #line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; POE-Component-Server-SimpleHTTP-2.18/inc/Module/Install/Can.pm000644 001751 001751 00000006157 12164634253 024512 0ustar00bingosbingos000000 000000 #line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 POE-Component-Server-SimpleHTTP-2.18/inc/Module/Install/Fetch.pm000644 001751 001751 00000004627 12164634253 025042 0ustar00bingosbingos000000 000000 #line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; POE-Component-Server-SimpleHTTP-2.18/inc/Module/Install/GithubMeta.pm000644 001751 001751 00000002105 12164634253 026027 0ustar00bingosbingos000000 000000 #line 1 package Module::Install::GithubMeta; use strict; use warnings; use Cwd; use base qw(Module::Install::Base); use vars qw($VERSION); $VERSION = '0.22'; sub githubmeta { my $self = shift; return unless $Module::Install::AUTHOR; return unless _under_git(); return unless $self->can_run('git'); my $remote = shift || 'origin'; return unless my ($git_url) = `git remote show -n $remote` =~ /URL: (.*)$/m; return unless $git_url =~ /github\.com/; # Not a Github repository my $http_url = $git_url; $git_url =~ s![\w\-]+\@([^:]+):!git://$1/!; $http_url =~ s![\w\-]+\@([^:]+):!https://$1/!; $http_url =~ s!\.git$!/tree!; $self->repository( $git_url ); $self->homepage( $http_url ) unless $self->homepage(); return 1; } sub _under_git { return 1 if -e '.git'; my $cwd = getcwd; my $last = $cwd; my $found = 0; while (1) { chdir '..' or last; my $current = getcwd; last if $last eq $current; $last = $current; if ( -e '.git' ) { $found = 1; last; } } chdir $cwd; return $found; } 'Github'; __END__ #line 111 POE-Component-Server-SimpleHTTP-2.18/inc/Module/Install/Metadata.pm000644 001751 001751 00000043277 12164634252 025534 0ustar00bingosbingos000000 000000 #line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; POE-Component-Server-SimpleHTTP-2.18/inc/Module/Install/Base.pm000644 001751 001751 00000002147 12164634252 024655 0ustar00bingosbingos000000 000000 #line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 POE-Component-Server-SimpleHTTP-2.18/inc/Module/Install/AutoLicense.pm000644 001751 001751 00000003166 12164634252 026220 0ustar00bingosbingos000000 000000 #line 1 package Module::Install::AutoLicense; use strict; use warnings; use base qw(Module::Install::Base); use vars qw($VERSION); $VERSION = '0.08'; my %licenses = ( perl => 'Software::License::Perl_5', apache => 'Software::License::Apache_2_0', artistic => 'Software::License::Artistic_1_0', artistic_2 => 'Software::License::Artistic_2_0', lgpl2 => 'Software::License::LGPL_2_1', lgpl3 => 'Software::License::LGPL_3_0', bsd => 'Software::License::BSD', gpl => 'Software::License::GPL_1', gpl2 => 'Software::License::GPL_2', gpl3 => 'Software::License::GPL_3', mit => 'Software::License::MIT', mozilla => 'Software::License::Mozilla_1_1', ); sub auto_license { my $self = shift; return unless $Module::Install::AUTHOR; my %opts = @_; $opts{lc $_} = delete $opts{$_} for keys %opts; my $holder = $opts{holder} || _get_authors( $self ); #my $holder = $opts{holder} || $self->author; my $license = $self->license(); unless ( defined $licenses{ $license } ) { warn "No license definition for '$license', aborting\n"; return 1; } my $class = $licenses{ $license }; eval "require $class"; my $sl = $class->new( { holder => $holder } ); open LICENSE, '>LICENSE' or die "$!\n"; print LICENSE $sl->fulltext; close LICENSE; $self->postamble(<<"END"); distclean :: license_clean license_clean: \t\$(RM_F) LICENSE END return 1; } sub _get_authors { my $self = shift; my $joined = join ', ', @{ $self->author() || [] }; return $joined; } 'Licensed to auto'; __END__ #line 125 POE-Component-Server-SimpleHTTP-2.18/inc/Module/Install/Win32.pm000644 001751 001751 00000003403 12164634253 024702 0ustar00bingosbingos000000 000000 #line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; POE-Component-Server-SimpleHTTP-2.18/inc/Module/Install/Makefile.pm000644 001751 001751 00000027437 12164634252 025531 0ustar00bingosbingos000000 000000 #line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544