diff --git a/Changes b/Changes index 7da8859..7045af2 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,17 @@ Revision history for Perl extension Catalyst::Plugin::Session + +0.43 - 2022-06-03 + - fix tests when Catalyst::Plugin::Authentication is unavailable + +0.42 - 2022-05-31 + - revised packaging + - correctly specify test prerequisites as test prerequisites + - drop unused Test::Exception prereq + - drop Tie::RefHash prereq that was not used directly + - only run pod tests for authors + - ensure all optional tests are run by authors + - drop use of Test::WWW::Mechanize::PSGI and Test::WWW::Mechanize::Catalyst + in favor of a simpler user agent 0.41 2018-12-05 - Don't let an evil session ID supplier have an easy XSS vector (Michael McClimon++) diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..fe8c9ba --- /dev/null +++ b/LICENSE @@ -0,0 +1,374 @@ +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) 2022 by Yuval Kogman . + +This is free software, licensed under: + + The GNU General Public License, Version 1, February 1989 + + GNU GENERAL PUBLIC LICENSE + Version 1, February 1989 + + Copyright (C) 1989 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The license agreements of most software companies try to keep users +at the mercy of those companies. By contrast, our General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. The +General Public License applies to the Free Software Foundation's +software and to any other program whose authors commit to using it. +You can use it for your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Specifically, the General Public License is designed to make +sure that you have the freedom to give away or sell copies of free +software, that you receive source code or can get it if you want it, +that you can change the software or use pieces of it in new free +programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of a such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must tell them their rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work based +on the Program" means either the Program or any work containing the +Program or a portion of it, either verbatim or with modifications. Each +licensee is addressed as "you". + + 1. You may copy and distribute verbatim copies of the Program's source +code as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice and +disclaimer of warranty; keep intact all the notices that refer to this +General Public License and to the absence of any warranty; and give any +other recipients of the Program a copy of this General Public License +along with the Program. You may charge a fee for the physical act of +transferring a copy. + + 2. You may modify your copy or copies of the Program or any portion of +it, and copy and distribute such modifications under the terms of Paragraph +1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating that + you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, that + in whole or in part contains the Program or any part thereof, either + with or without modifications, to be licensed at no charge to all + third parties under the terms of this General Public License (except + that you may choose to grant warranty protection to some or all + third parties, at your option). + + c) If the modified program normally reads commands interactively when + run, you must cause it, when started running for such interactive use + in the simplest and most usual way, to print or display an + announcement including an appropriate copyright notice and a notice + that there is no warranty (or else, saying that you provide a + warranty) and that users may redistribute the program under these + conditions, and telling the user how to view a copy of this General + Public License. + + d) You may charge a fee for the physical act of transferring a + copy, and you may at your option offer warranty protection in + exchange for a fee. + +Mere aggregation of another independent work with the Program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other work under the scope of these terms. + + 3. You may copy and distribute the Program (or a portion or derivative of +it, under Paragraph 2) in object code or executable form under the terms of +Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal charge + for the cost of distribution) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +Source code for a work means the preferred form of the work for making +modifications to it. For an executable file, complete source code means +all the source code for all modules it contains; but, as a special +exception, it need not include source code for modules which are standard +libraries that accompany the operating system on which the executable +file runs, or for standard header files or definitions files that +accompany that operating system. + + 4. You may not copy, modify, sublicense, distribute or transfer the +Program except as expressly provided under this General Public License. +Any attempt otherwise to copy, modify, sublicense, distribute or transfer +the Program is void, and will automatically terminate your rights to use +the Program under this License. However, parties who have received +copies, or rights to use copies, from you under this General Public +License will not have their licenses terminated so long as such parties +remain in full compliance. + + 5. By copying, distributing or modifying the Program (or any work based +on the Program) you indicate your acceptance of this license to do so, +and all its terms and conditions. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the original +licensor to copy, distribute or modify the Program subject to these +terms and conditions. You may not impose any further restrictions on the +recipients' exercise of the rights granted herein. + + 7. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of the license which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +the license, you may choose any version ever published by the Free Software +Foundation. + + 8. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to humanity, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively convey +the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19xx name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than `show w' and `show +c'; they could even be mouse-clicks or menu items--whatever suits your +program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + program `Gnomovision' (a program to direct compilers to make passes + at assemblers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +That's all there is to it! + + +--- The Artistic License 1.0 --- + +This software is Copyright (c) 2022 by Yuval Kogman . + +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 +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. + +The End + diff --git a/MANIFEST b/MANIFEST index 252c5d5..2ee60d7 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,32 +1,21 @@ Changes -inc/Module/Install.pm -inc/Module/Install/AuthorTests.pm -inc/Module/Install/Base.pm -inc/Module/Install/Can.pm -inc/Module/Install/Fetch.pm -inc/Module/Install/Makefile.pm -inc/Module/Install/Metadata.pm -inc/Module/Install/Win32.pm -inc/Module/Install/WriteAll.pm lib/Catalyst/Plugin/Session.pm lib/Catalyst/Plugin/Session/State.pm lib/Catalyst/Plugin/Session/Store.pm lib/Catalyst/Plugin/Session/Store/Dummy.pm lib/Catalyst/Plugin/Session/Test/Store.pm lib/Catalyst/Plugin/Session/Tutorial.pod +maint/Makefile.PL.include Makefile.PL MANIFEST This list of files -META.yml -README t/00_basic_sanity.t t/01_setup.t t/03_flash.t t/05_semi_persistent_flash.t -t/author/pod.t -t/author/podcoverage.t t/cat_test.t t/lib/FlashTestApp.pm t/lib/FlashTestApp/Controller/Root.pm +t/lib/MiniUA.pm t/lib/SessionExpiry.pm t/lib/SessionExpiry/Controller/Root.pm t/lib/SessionTestApp.pm @@ -40,3 +29,9 @@ t/live_verify_address.t t/live_verify_user_agent.t t/session_valid.t +xt/pod.t +xt/podcoverage.t +META.yml Module YAML meta-data (added by MakeMaker) +META.json Module JSON meta-data (added by MakeMaker) +README README file (added by Distar) +LICENSE LICENSE file (added by Distar) diff --git a/META.json b/META.json new file mode 100644 index 0000000..ddca0ee --- /dev/null +++ b/META.json @@ -0,0 +1,81 @@ +{ + "abstract" : "Generic Session plugin - ties together server side storage and client side state required to maintain session data.", + "author" : [ + "Yuval Kogman " + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : 2 + }, + "name" : "Catalyst-Plugin-Session", + "no_index" : { + "directory" : [ + "t", + "xt" + ] + }, + "prereqs" : { + "build" : {}, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "develop" : { + "requires" : { + "Test::Pod" : "0", + "Test::Pod::Coverage" : "0" + } + }, + "runtime" : { + "requires" : { + "Catalyst::Runtime" : "5.71001", + "Digest" : "0", + "File::Spec" : "0", + "File::Temp" : "0", + "HTML::Entities" : "0", + "List::Util" : "0", + "MRO::Compat" : "0", + "Moose" : "0.76", + "MooseX::Emulate::Class::Accessor::Fast" : "0.00801", + "Object::Signature" : "0", + "Test::More" : "0.88", + "namespace::clean" : "0.10", + "perl" : "5.008" + } + }, + "test" : { + "requires" : { + "Plack::Test" : "0", + "Test::Deep" : "0", + "Test::Needs" : "0" + } + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "mailto" : "bug-Catalyst-Plugin-Session@rt.cpan.org", + "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Catalyst-Plugin-Session" + }, + "license" : [ + "http://dev.perl.org/licenses/" + ], + "repository" : { + "type" : "git", + "url" : "https://github.com/perl-catalyst/Catalyst-Plugin-Session.git", + "web" : "https://github.com/perl-catalyst/Catalyst-Plugin-Session" + } + }, + "version" : "0.43", + "x_breaks" : { + "Catalyst::Plugin::Session::State::Cookie" : "< 0.03", + "Catalyst::Plugin::Session::State::URI" : "< 0.02" + }, + "x_serialization_backend" : "JSON::PP version 4.07" +} diff --git a/META.yml b/META.yml index 9bb7b5b..65d023d 100644 --- a/META.yml +++ b/META.yml @@ -1,42 +1,44 @@ --- abstract: 'Generic Session plugin - ties together server side storage and client side state required to maintain session data.' author: - - 'Andy Grundman' + - 'Yuval Kogman ' build_requires: - ExtUtils::MakeMaker: 6.59 - Test::Deep: 0 - Test::Exception: 0 - Test::WWW::Mechanize::PSGI: 0 + Plack::Test: '0' + Test::Deep: '0' + Test::Needs: '0' configure_requires: - ExtUtils::MakeMaker: 6.59 -distribution_type: module + ExtUtils::MakeMaker: '0' dynamic_config: 1 -generated_by: 'Module::Install version 1.18' +generated_by: 'ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: 1.4 + version: '1.4' name: Catalyst-Plugin-Session no_index: directory: - - inc - t + - xt requires: Catalyst::Runtime: '5.71001' - Digest: 0 - File::Spec: 0 - File::Temp: 0 - HTML::Entities: 0 - List::Util: 0 - MRO::Compat: 0 + Digest: '0' + File::Spec: '0' + File::Temp: '0' + HTML::Entities: '0' + List::Util: '0' + MRO::Compat: '0' Moose: '0.76' MooseX::Emulate::Class::Accessor::Fast: '0.00801' - Object::Signature: 0 + Object::Signature: '0' Test::More: '0.88' - Tie::RefHash: '1.34' namespace::clean: '0.10' - perl: 5.8.0 + perl: '5.008' resources: + bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Catalyst-Plugin-Session license: http://dev.perl.org/licenses/ - repository: git://git.shadowcat.co.uk/catagits/Catalyst-Plugin-Session.git -version: '0.41' + repository: https://github.com/perl-catalyst/Catalyst-Plugin-Session.git +version: '0.43' +x_breaks: + Catalyst::Plugin::Session::State::Cookie: '< 0.03' + Catalyst::Plugin::Session::State::URI: '< 0.02' +x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/Makefile.PL b/Makefile.PL index 3700c20..0d4a2c4 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,61 +1,77 @@ -use inc::Module::Install 0.87; -use Module::Install::AuthorTests; +use strict; +use warnings; +use 5.008; -if ( -e 'MANIFEST.SKIP' ) { - system( 'pod2text lib/Catalyst/Plugin/Session.pm > README' ) - and die("Could not run pod2text on lib/Catalyst/Plugin/Session.pm"); -} +my %META = ( + name => 'Catalyst-Plugin-Session', + license => 'perl_5', + prereqs => { + configure => { requires => { + 'ExtUtils::MakeMaker' => 0, + } }, + test => { + requires => { + 'Plack::Test' => 0, + 'Test::Deep' => 0, + 'Test::Needs' => 0, + }, + }, + runtime => { + requires => { + 'Catalyst::Runtime' => '5.71001', + 'namespace::clean' => '0.10', + 'Digest' => 0, + 'File::Spec' => 0, + 'File::Temp' => 0, + 'List::Util' => 0, + 'Object::Signature' => 0, + 'MRO::Compat' => 0, + 'MooseX::Emulate::Class::Accessor::Fast' => '0.00801', + 'Moose' => '0.76', + 'HTML::Entities' => 0, + 'Test::More' => '0.88', + 'perl' => '5.008', + }, + }, + develop => { + requires => { + 'Test::Pod' => 0, + 'Test::Pod::Coverage' => 0, + }, + }, + }, + x_breaks => { + 'Catalyst::Plugin::Session::State::Cookie' => '< 0.03', + 'Catalyst::Plugin::Session::State::URI' => '< 0.02', + }, + resources => { + repository => { + url => 'https://github.com/perl-catalyst/Catalyst-Plugin-Session.git', + web => 'https://github.com/perl-catalyst/Catalyst-Plugin-Session', + type => 'git', + }, + bugtracker => { + web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Catalyst-Plugin-Session', + mailto => 'bug-Catalyst-Plugin-Session@rt.cpan.org', + }, + license => [ 'http://dev.perl.org/licenses/' ], + }, + no_index => { + directory => [ 't', 'xt' ] + }, +); -is_upgrading_needed(); +my %MM_ARGS = (); -perl_version '5.008'; - -name 'Catalyst-Plugin-Session'; -all_from 'lib/Catalyst/Plugin/Session.pm'; - -requires 'Catalyst::Runtime' => '5.71001'; -requires 'namespace::clean' => '0.10'; -requires 'Digest'; -requires 'File::Spec'; -requires 'File::Temp'; -requires 'List::Util'; -requires 'Object::Signature'; -requires 'MRO::Compat'; -requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00801'; -requires 'Moose' => '0.76'; -requires 'HTML::Entities'; - -# an indirect dep. needs a certain version. -requires 'Tie::RefHash' => '1.34'; - -# for Test::Store -requires 'Test::More' => '0.88'; - -test_requires 'Test::Deep'; -test_requires 'Test::Exception'; -test_requires 'Test::WWW::Mechanize::PSGI'; -resources repository => 'git://git.shadowcat.co.uk/catagits/Catalyst-Plugin-Session.git'; - -author_tests 't/author'; - -WriteAll; - -sub is_upgrading_needed { - my %state = ( - Cookie => 0.03, - URI => 0.02, - ); - - foreach my $module (keys %state) { - my $package = 'Catalyst::Plugin::Session::State::' . $module; - - next if not eval "require $package;"; - - if( not eval { $package->VERSION( $state{ $module } ); } ) { - warn <VERSION($version) }) { + warn <= 6.57_02; +my $mymeta_broken = $mymeta && $eumm_version < 6.57_07; + +($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g; +($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g; +$META{license} = [ $META{license} ] + if $META{license} && !ref $META{license}; +$MM_ARGS{LICENSE} = $META{license}[0] + if $META{license} && $eumm_version >= 6.30; +$MM_ARGS{NO_MYMETA} = 1 + if $mymeta_broken; +$MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META } + unless -f 'META.yml'; +$MM_ARGS{PL_FILES} ||= {}; +$MM_ARGS{NORECURS} = 1 + if not exists $MM_ARGS{NORECURS}; + +for (qw(configure build test runtime)) { + my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; + my $r = $MM_ARGS{$key} = { + %{$META{prereqs}{$_}{requires} || {}}, + %{delete $MM_ARGS{$key} || {}}, + }; + defined $r->{$_} or delete $r->{$_} for keys %$r; +} + +$MM_ARGS{MIN_PERL_VERSION} = delete $MM_ARGS{PREREQ_PM}{perl} || 0; + +delete $MM_ARGS{MIN_PERL_VERSION} + if $eumm_version < 6.47_01; +$MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}} + if $eumm_version < 6.63_03; +$MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}} + if $eumm_version < 6.55_01; +delete $MM_ARGS{CONFIGURE_REQUIRES} + if $eumm_version < 6.51_03; + +ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS); +## END BOILERPLATE ########################################################### diff --git a/inc/Module/Install/AuthorTests.pm b/inc/Module/Install/AuthorTests.pm deleted file mode 100644 index c44931b..0000000 --- a/inc/Module/Install/AuthorTests.pm +++ /dev/null @@ -1,59 +0,0 @@ -#line 1 -package Module::Install::AuthorTests; - -use 5.005; -use strict; -use Module::Install::Base; -use Carp (); - -#line 16 - -use vars qw{$VERSION $ISCORE @ISA}; -BEGIN { - $VERSION = '0.002'; - $ISCORE = 1; - @ISA = qw{Module::Install::Base}; -} - -#line 42 - -sub author_tests { - my ($self, @dirs) = @_; - _add_author_tests($self, \@dirs, 0); -} - -#line 56 - -sub recursive_author_tests { - my ($self, @dirs) = @_; - _add_author_tests($self, \@dirs, 1); -} - -sub _wanted { - my $href = shift; - sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 } -} - -sub _add_author_tests { - my ($self, $dirs, $recurse) = @_; - return unless $Module::Install::AUTHOR; - - my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t'; - - # XXX: pick a default, later -- rjbs, 2008-02-24 - my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests"; - @dirs = grep { -d } @dirs; - - if ($recurse) { - require File::Find; - my %test_dir; - File::Find::find(_wanted(\%test_dir), @dirs); - $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir ); - } else { - $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs ); - } -} - -#line 107 - -1; diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm deleted file mode 100644 index b61d424..0000000 --- a/inc/Module/Install/Base.pm +++ /dev/null @@ -1,83 +0,0 @@ -#line 1 -package Module::Install::Base; - -use strict 'vars'; -use vars qw{$VERSION}; -BEGIN { - $VERSION = '1.18'; -} - -# 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 diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm deleted file mode 100644 index 1de368c..0000000 --- a/inc/Module/Install/Can.pm +++ /dev/null @@ -1,163 +0,0 @@ -#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.18'; - @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; - - if ($^O eq 'VMS') { - require ExtUtils::CBuilder; - my $builder = ExtUtils::CBuilder->new( - quiet => 1, - ); - return $builder->have_compiler; - } - - 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 245 diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm deleted file mode 100644 index 54b52cb..0000000 --- a/inc/Module/Install/Fetch.pm +++ /dev/null @@ -1,93 +0,0 @@ -#line 1 -package Module::Install::Fetch; - -use strict; -use Module::Install::Base (); - -use vars qw{$VERSION @ISA $ISCORE}; -BEGIN { - $VERSION = '1.18'; - @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; diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm deleted file mode 100644 index 8ba3d88..0000000 --- a/inc/Module/Install/Makefile.pm +++ /dev/null @@ -1,418 +0,0 @@ -#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.18'; - @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-separated 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 diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm deleted file mode 100644 index 692ce71..0000000 --- a/inc/Module/Install/Metadata.pm +++ /dev/null @@ -1,722 +0,0 @@ -#line 1 -package Module::Install::Metadata; - -use strict 'vars'; -use Module::Install::Base (); - -use vars qw{$VERSION @ISA $ISCORE}; -BEGIN { - $VERSION = '1.18'; - @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 hashes - 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; diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm deleted file mode 100644 index b80c900..0000000 --- a/inc/Module/Install/Win32.pm +++ /dev/null @@ -1,64 +0,0 @@ -#line 1 -package Module::Install::Win32; - -use strict; -use Module::Install::Base (); - -use vars qw{$VERSION @ISA $ISCORE}; -BEGIN { - $VERSION = '1.18'; - @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; diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm deleted file mode 100644 index da279c7..0000000 --- a/inc/Module/Install/WriteAll.pm +++ /dev/null @@ -1,63 +0,0 @@ -#line 1 -package Module::Install::WriteAll; - -use strict; -use Module::Install::Base (); - -use vars qw{$VERSION @ISA $ISCORE}; -BEGIN { - $VERSION = '1.18'; - @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; diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm deleted file mode 100644 index 07525c5..0000000 --- a/inc/Module/Install.pm +++ /dev/null @@ -1,451 +0,0 @@ -#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.006; -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.18'; - - # 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::getcwd(); - my $sym = "${who}::AUTOLOAD"; - $sym->{$cwd} = sub { - my $pwd = Cwd::getcwd(); - 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::getcwd()) eq $base_path ) { - delete $args{prefix}; - } - return $args{_self} if $args{_self}; - - $base_path = VMS::Filespec::unixify($base_path) if $^O eq 'VMS'; - - $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( {no_chdir => 1, wanted => 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($File::Find::name); - my $in_pod = 0; - foreach ( split /\n/, $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; -} - -sub _read { - local *FH; - open( FH, '<', $_[0] ) or die "open($_[0]): $!"; - binmode FH; - my $string = do { local $/; }; - close FH or die "close($_[0]): $!"; - return $string; -} - -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; -} - -sub _write { - local *FH; - open( FH, '>', $_[0] ) or die "open($_[0]): $!"; - binmode FH; - foreach ( 1 .. $#_ ) { - print FH $_[$_] or die "print($_[0]): $!"; - } - close FH or die "close($_[0]): $!"; -} - -# _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. diff --git a/lib/Catalyst/Plugin/Session/State.pm b/lib/Catalyst/Plugin/Session/State.pm index 3b8cbe9..67520b4 100644 --- a/lib/Catalyst/Plugin/Session/State.pm +++ b/lib/Catalyst/Plugin/Session/State.pm @@ -1,9 +1,10 @@ -#!/usr/bin/perl - package Catalyst::Plugin::Session::State; use strict; use warnings; + +our $VERSION = '0.43'; +$VERSION =~ tr/_//d; __PACKAGE__; @@ -47,7 +48,7 @@ =item finalize Modify the response at to include the session ID if C is defined, -using whatever scheme you use. For example, set a cookie, +using whatever scheme you use. For example, set a cookie. =back diff --git a/lib/Catalyst/Plugin/Session/Store/Dummy.pm b/lib/Catalyst/Plugin/Session/Store/Dummy.pm index ebf8133..8ccb614 100644 --- a/lib/Catalyst/Plugin/Session/Store/Dummy.pm +++ b/lib/Catalyst/Plugin/Session/Store/Dummy.pm @@ -1,10 +1,11 @@ -#!/usr/bin/perl - package Catalyst::Plugin::Session::Store::Dummy; use base qw/Catalyst::Plugin::Session::Store/; use strict; use warnings; + +our $VERSION = '0.43'; +$VERSION =~ tr/_//d; my %store; diff --git a/lib/Catalyst/Plugin/Session/Store.pm b/lib/Catalyst/Plugin/Session/Store.pm index 8b8e908..f53d505 100644 --- a/lib/Catalyst/Plugin/Session/Store.pm +++ b/lib/Catalyst/Plugin/Session/Store.pm @@ -1,9 +1,10 @@ -#!/usr/bin/perl - package Catalyst::Plugin::Session::Store; use strict; use warnings; + +our $VERSION = '0.43'; +$VERSION =~ tr/_//d; __PACKAGE__; @@ -27,7 +28,7 @@ C module sets up it will check to see that C<< YourApp->isa("Catalyst::Plugin::Session::Store") >>. When you write a session storage plugin you should subclass this module for this -reason. This documentation is intended for authors of session storage +reason. This documentation is intended for authors of session storage plugins, not for end users. =head1 WRITING STORE PLUGINS @@ -66,7 +67,7 @@ $c->store_session_data( $x, $y ); -for any $x, +for any $x, $y == $c->get_session_data( $x ) diff --git a/lib/Catalyst/Plugin/Session/Test/Store.pm b/lib/Catalyst/Plugin/Session/Test/Store.pm index 0f3984d..006379b 100644 --- a/lib/Catalyst/Plugin/Session/Test/Store.pm +++ b/lib/Catalyst/Plugin/Session/Test/Store.pm @@ -1,9 +1,10 @@ -#!/usr/bin/perl - package Catalyst::Plugin::Session::Test::Store; use strict; use warnings; + +our $VERSION = '0.43'; +$VERSION =~ tr/_//d; use utf8; @@ -57,7 +58,8 @@ use Catalyst qw/Session SessionStateTest/; push our (@ISA), $m; - our $VERSION = "123"; # Do not remove + our $VERSION # make unparseable + = "123"; # Do not remove use strict; use warnings; @@ -105,7 +107,8 @@ use Catalyst qw/Session SessionStateTest/; push our (@ISA), $m; - our $VERSION = "123"; + our $VERSION # make unparseable + = "123"; use Test::More; @@ -150,7 +153,7 @@ use Catalyst::Test "SessionStoreTest"; # idiotic void context warning workaround - + my $x = get("/create_session"); $x = get("/recover_session"); $x = get("/after_session"); diff --git a/lib/Catalyst/Plugin/Session.pm b/lib/Catalyst/Plugin/Session.pm index 345297f..343a55e 100644 --- a/lib/Catalyst/Plugin/Session.pm +++ b/lib/Catalyst/Plugin/Session.pm @@ -1,5 +1,3 @@ -#!/usr/bin/perl - package Catalyst::Plugin::Session; use Moose; @@ -15,8 +13,8 @@ use namespace::clean -except => 'meta'; -our $VERSION = '0.41'; -$VERSION = eval $VERSION; +our $VERSION = '0.43'; +$VERSION =~ tr/_//d; my @session_data_accessors; # used in delete_session diff --git a/maint/Makefile.PL.include b/maint/Makefile.PL.include new file mode 100644 index 0000000..828781a --- /dev/null +++ b/maint/Makefile.PL.include @@ -0,0 +1,7 @@ +BEGIN { -e 'Distar' or system qw(git clone https://github.com/p5sagit/Distar.git) } +use lib 'Distar/lib'; +use Distar 0.001; + +author 'Yuval Kogman '; + +1; diff --git a/t/00_basic_sanity.t b/t/00_basic_sanity.t index 055d3c6..791afca 100644 --- a/t/00_basic_sanity.t +++ b/t/00_basic_sanity.t @@ -1,13 +1,10 @@ -#!/usr/bin/perl - use strict; use warnings; -use Test::More tests => 4; +use Test::More; +use Catalyst::Plugin::Session; -my $m; BEGIN { use_ok($m = "Catalyst::Plugin::Session") } +can_ok('Catalyst::Plugin::Session', qw/sessionid session session_delete_reason/); -can_ok($m, $_) for qw/sessionid session session_delete_reason/; - - +done_testing; diff --git a/t/01_setup.t b/t/01_setup.t index a75ea93..f52dd51 100644 --- a/t/01_setup.t +++ b/t/01_setup.t @@ -1,14 +1,11 @@ -#!/usr/bin/perl - use strict; use warnings; -use Test::More tests => 10; +use Test::More; use Class::MOP; use Test::Deep; -my $m; -BEGIN { use_ok( $m = "Catalyst::Plugin::Session" ) } +use Catalyst::Plugin::Session; my %config; my $log_meta = Class::MOP::Class->create_anon_class(superclasses => ['Moose::Object']); @@ -22,7 +19,7 @@ package MockCxt; use MRO::Compat; - use base $m; + use base qw(Catalyst::Plugin::Session); sub new { bless {}, $_[0] } sub config { \%config } sub log { $log } @@ -34,7 +31,7 @@ } } -can_ok( $m, "setup" ); +can_ok( 'Catalyst::Plugin::Session', "setup" ); eval { MockCxt->new->setup }; # throws OK is not working with NEXT like( @@ -74,3 +71,4 @@ is( $config{session}{expires}, 1234, "user values are not overwritten in config" ); +done_testing; diff --git a/t/03_flash.t b/t/03_flash.t index 0ead785..cc0ea4e 100644 --- a/t/03_flash.t +++ b/t/03_flash.t @@ -1,17 +1,13 @@ -#!/usr/bin/perl - use strict; use warnings; -use Test::More tests => 12; -use Test::Exception; +use Test::More; use Test::Deep; -my $m; -BEGIN { use_ok( $m = "Catalyst::Plugin::Session" ) } +use Catalyst::Plugin::Session; my $c_meta = Class::MOP::Class->create_anon_class( - superclasses => [ $m, 'Moose::Object', ], + superclasses => [ 'Catalyst::Plugin::Session', 'Moose::Object', ], ); my $c = $c_meta->name->new; @@ -77,3 +73,5 @@ $c->prepare_action; is_deeply( $c->stash, { bar => "gorch" }, "flash copied to stash" ); + +done_testing; diff --git a/t/05_semi_persistent_flash.t b/t/05_semi_persistent_flash.t index 249be7f..5fcd76e 100644 --- a/t/05_semi_persistent_flash.t +++ b/t/05_semi_persistent_flash.t @@ -1,47 +1,43 @@ -#!/usr/bin/perl -w use strict; +use warnings; + +use Test::Needs { + 'Catalyst::Plugin::Session::State::Cookie' => '0.03', +}; use Test::More; -BEGIN { - eval { require Catalyst::Plugin::Session::State::Cookie; Catalyst::Plugin::Session::State::Cookie->VERSION(0.03) } - or plan skip_all => - "Catalyst::Plugin::Session::State::Cookie version 0.03 or higher is required for this test"; +use lib "t/lib"; - eval { - require Test::WWW::Mechanize::Catalyst; - Test::WWW::Mechanize::Catalyst->VERSION(0.51); - } - or plan skip_all => - 'Test::WWW::Mechanize::Catalyst >= 0.51 is required for this test'; +use MiniUA; - plan tests => '10'; +my $ua = MiniUA->new('FlashTestApp'); -} - -use lib "t/lib"; -use Test::WWW::Mechanize::Catalyst 'FlashTestApp'; - -my $ua = Test::WWW::Mechanize::Catalyst->new; +my $res; # flash absent for initial request -$ua->get_ok( "http://localhost/first"); -$ua->content_contains( "flash is not set", "not set"); +$res = $ua->get( "http://localhost/first" ); +ok +$res->is_success; +like +$res->content, qr{flash is not set}, "not set"; # present for 1st req. -$ua->get_ok( "http://localhost/second"); -$ua->content_contains( "flash set first time", "set first"); +$res = $ua->get( "http://localhost/second"); +ok +$res->is_success; +like +$res->content, qr{flash set first time}, "set first"; # should be the same 2nd req. -$ua->get_ok( "http://localhost/third"); -$ua->content_contains( "flash set second time", "set second"); +$res = $ua->get( "http://localhost/third"); +ok +$res->is_success; +like +$res->content, qr{flash set second time}, "set second"; # and the third request, flash->{is_set} has the same value as 2nd. -$ua->get_ok( "http://localhost/fourth"); -$ua->content_contains( "flash set 3rd time, same val as prev.", "set third"); - +$res = $ua->get( "http://localhost/fourth"); +ok +$res->is_success; +like +$res->content, qr{flash set 3rd time, same val as prev.}, "set third"; # and should be absent again for the 4th req. -$ua->get_ok( "http://localhost/fifth"); -$ua->content_contains( "flash is not", "flash has gone"); +$res = $ua->get( "http://localhost/fifth"); +ok +$res->is_success; +like +$res->content, qr{flash is not}, "flash has gone"; +done_testing; diff --git a/t/author/pod.t b/t/author/pod.t deleted file mode 100644 index 1647794..0000000 --- a/t/author/pod.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; - -eval "use Test::Pod 1.14"; -plan skip_all => 'Test::Pod 1.14 required' if $@; -plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD}; - -all_pod_files_ok(); diff --git a/t/author/podcoverage.t b/t/author/podcoverage.t deleted file mode 100644 index d91be5e..0000000 --- a/t/author/podcoverage.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; - -eval "use Test::Pod::Coverage 1.04"; -plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@; -plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD}; - -all_pod_coverage_ok(); diff --git a/t/cat_test.t b/t/cat_test.t index 8fedd89..1190a8b 100644 --- a/t/cat_test.t +++ b/t/cat_test.t @@ -1,52 +1,46 @@ -#!/usr/bin/env perl - use strict; use warnings; + +use Test::Needs { + 'Catalyst::Plugin::Authentication' => '0', + 'Catalyst::Plugin::Session::State::Cookie' => '0.03', +}; + use Test::More; + use HTTP::Request::Common; -# setup library path -use FindBin qw($Bin); -use lib "$Bin/lib"; - -# this test was copied from CatalystX::SimpleLogin - -BEGIN { - plan skip_all => "Need Catalyst::Plugin::Session::State::Cookie" - unless do { local $@; eval { require Catalyst::Plugin::Session::State::Cookie; } }; - plan skip_all => "Need Catalyst::Plugin::Authentication" - unless do { local $@; eval { require Catalyst::Plugin::Authentication; } }; -} +use lib "t/lib"; use Catalyst::Test 'SessionTestApp'; -my ($res, $c); +my $res; -($res, $c) = ctx_request(POST 'http://localhost/login', [username => 'bob', password => 's00p3r', remember => 1]); +$res = request(POST 'http://localhost/login', [username => 'bob', password => 's00p3r', remember => 1]); is($res->code, 200, 'succeeded'); my $cookie = $res->header('Set-Cookie'); ok($cookie, 'Have a cookie'); # cookie is changed by the get sleep(1); -($res, $c) = ctx_request(GET 'http://localhost/page', Cookie => $cookie); -like($c->res->body, qr/logged in/, 'logged in'); +$res = request(GET 'http://localhost/page', Cookie => $cookie); +like($res->content, qr/logged in/, 'logged in'); my $new_cookie = $res->header('Set-Cookie'); isnt( $cookie, $new_cookie, 'cookie expires has been updated' ); # request with no cookie -($res, $c) = ctx_request(GET 'http://localhost/page' ); -like($c->res->body, qr/please login/, 'not logged in'); +$res = request(GET 'http://localhost/page' ); +like($res->content, qr/please login/, 'not logged in'); $new_cookie = $res->header('Set-Cookie'); ok( ! defined $new_cookie, 'no cookie created' ); # check that cookie is reset by reset_session_expires -($res, $c) = ctx_request(GET 'http://localhost/reset_session_expires', Cookie => $cookie); +$res = request(GET 'http://localhost/reset_session_expires', Cookie => $cookie); my $reset_cookie = $res->header('Set-Cookie'); isnt( $cookie, $reset_cookie, 'Cookie has been changed by reset_session' ); # this checks that cookie exists after a logout and redirect # Catalyst::Plugin::Authentication removes the user session (remove_persisted_user) -($res, $c) = ctx_request(GET 'http://localhost/logout_redirect', Cookie => $cookie); +$res = request(GET 'http://localhost/logout_redirect', Cookie => $cookie); is($res->code, 302, 'redirected'); is($res->header('Location'), 'http://localhost/from_logout_redirect', 'Redirected after logout_redirect'); ok($res->header('Set-Cookie'), 'Cookie is there after redirect'); diff --git a/t/lib/FlashTestApp/Controller/Root.pm b/t/lib/FlashTestApp/Controller/Root.pm index 11243f2..3c49edf 100644 --- a/t/lib/FlashTestApp/Controller/Root.pm +++ b/t/lib/FlashTestApp/Controller/Root.pm @@ -13,7 +13,7 @@ my ($self, $c) = @_; $c->session; } - + sub first : Global { my ( $self, $c ) = @_; if ( ! $c->flash->{is_set}) { diff --git a/t/lib/FlashTestApp.pm b/t/lib/FlashTestApp.pm index c67561b..b2c1052 100644 --- a/t/lib/FlashTestApp.pm +++ b/t/lib/FlashTestApp.pm @@ -1,5 +1,3 @@ -#!/usr/bin/env perl - package FlashTestApp; use Catalyst qw/Session Session::Store::Dummy Session::State::Cookie/; diff --git a/t/lib/MiniUA.pm b/t/lib/MiniUA.pm new file mode 100644 index 0000000..b37fdc8 --- /dev/null +++ b/t/lib/MiniUA.pm @@ -0,0 +1,66 @@ +package MiniUA; +use strict; +use warnings; +use Plack::Test (); +use HTTP::Cookies; +use HTTP::Request::Common; + +sub new { + my ($class, $app, $opts) = @_; + my $psgi + = ref $app eq 'CODE' ? $app + : do { + eval "require $app;" or die $@; + $app->psgi_app; + }; + $opts ||= {}; + + my $self = bless { + psgi => $psgi, + plack_test => Plack::Test->create($psgi), + cookie_jar => HTTP::Cookies->new(hide_cookie2 => 1), + headers => $opts, + }, $class; + return $self; +} + +sub agent { + my $self = shift; + if (@_) { + return $self->{headers}{'User-Agent'} = shift; + } + return $self->{headers}{'User-Agent'}; +} + +sub cookie_jar { + my $self = shift; + return $self->{cookie_jar}; +} + +sub request { + my ($self, $req) = @_; + my $pt = $self->{plack_test}; + my $jar = $self->cookie_jar; + my $headers = $self->{headers}; + + my $uri = $req->uri; + $uri->scheme('http') unless defined $uri->scheme; + $uri->host('localhost') unless defined $uri->host; + + $req->header(%$headers) + if %$headers; + + $jar->add_cookie_header($req); + + my $res = $pt->request($req); + $jar->extract_cookies($res); + + return $res; +} + +sub get { + my ($self, $url) = @_; + $self->request(GET $url); +} + +1; diff --git a/t/lib/SessionTestApp.pm b/t/lib/SessionTestApp.pm index d2a0f77..f5c4c71 100644 --- a/t/lib/SessionTestApp.pm +++ b/t/lib/SessionTestApp.pm @@ -1,5 +1,3 @@ -#!/usr/bin/env perl - package SessionTestApp; use Catalyst qw/Session Session::Store::Dummy Session::State::Cookie Authentication/; diff --git a/t/live_accessor.t b/t/live_accessor.t index 62e522b..3ffafc2 100644 --- a/t/live_accessor.t +++ b/t/live_accessor.t @@ -1,35 +1,26 @@ -#!/usr/bin/perl -# use strict; use warnings; +use Test::Needs { + 'Catalyst::Plugin::Authentication' => '0', + 'Catalyst::Plugin::Session::State::Cookie' => '0.03', +}; + use Test::More; -BEGIN { - eval { require Catalyst::Plugin::Session::State::Cookie; Catalyst::Plugin::Session::State::Cookie->VERSION(0.03) } - or plan skip_all => - "Catalyst::Plugin::Session::State::Cookie 0.03 or higher is required for this test"; +use lib "t/lib"; - eval { - require Test::WWW::Mechanize::Catalyst; - Test::WWW::Mechanize::Catalyst->VERSION(0.51); - } - or plan skip_all => - 'Test::WWW::Mechanize::Catalyst >= 0.51 is required for this test'; +use MiniUA; - plan tests => 4; -} +my $ua = MiniUA->new('SessionTestApp'); -use lib "t/lib"; -use Test::WWW::Mechanize::Catalyst "SessionTestApp"; +my $res = $ua->get( '/accessor_test'); +ok +$res->is_success, 'Set session vars okay'; -my $ua = Test::WWW::Mechanize::Catalyst->new; +like +$res->content, qr{two: 2}, 'k/v list setter works okay'; -$ua->get_ok("http://localhost/accessor_test", "Set session vars okay"); +like +$res->content, qr{four: 4}, 'hashref setter works okay'; -$ua->content_contains("two: 2", "k/v list setter works okay"); +like +$res->content, qr{five: 5}, 'direct access works okay'; -$ua->content_contains("four: 4", "hashref setter works okay"); - -$ua->content_contains("five: 5", "direct access works okay"); - +done_testing; diff --git a/t/live_app.t b/t/live_app.t index 6b9c3ad..e4f4005 100644 --- a/t/live_app.t +++ b/t/live_app.t @@ -1,111 +1,122 @@ -#!/usr/bin/perl - use strict; use warnings; +use Test::Needs { + 'Catalyst::Plugin::Authentication' => '0', + 'Catalyst::Plugin::Session::State::Cookie' => '0.03', +}; + use Test::More; -BEGIN { - eval { require Catalyst::Plugin::Session::State::Cookie; Catalyst::Plugin::Session::State::Cookie->VERSION(0.03) } - or plan skip_all => - "Catalyst::Plugin::Session::State::Cookie 0.03 or higher is required for this test"; +use lib "t/lib"; - eval { - require Test::WWW::Mechanize::Catalyst; - Test::WWW::Mechanize::Catalyst->VERSION(0.51); - } - or plan skip_all => - 'Test::WWW::Mechanize::Catalyst >= 0.51 is required for this test'; -} +use MiniUA; -use lib "t/lib"; -use Test::WWW::Mechanize::Catalyst "SessionTestApp"; +my $ua1 = MiniUA->new('SessionTestApp'); +my $ua2 = MiniUA->new('SessionTestApp'); -my $ua1 = Test::WWW::Mechanize::Catalyst->new; -my $ua2 = Test::WWW::Mechanize::Catalyst->new; +my $res1 = $ua1->get( 'http://localhost/page'); +my $res2 = $ua2->get( 'http://localhost/page'); +ok $_->is_success, 'initial get' for $res1, $res2; -$_->get_ok( "http://localhost/page", "initial get" ) for $ua1, $ua2; +like $res1->content, qr/please login/, 'ua1 not logged in'; +like $res2->content, qr/please login/, 'ua2 not logged in'; -$ua1->content_contains( "please login", "ua1 not logged in" ); -$ua2->content_contains( "please login", "ua2 not logged in" ); +$res1 = $ua1->get( 'http://localhost/login'); +ok $res1->is_success, 'log ua1 in'; +like $res1->content, qr/logged in/, 'ua1 logged in'; -$ua1->get_ok( "http://localhost/login", "log ua1 in" ); -$ua1->content_contains( "logged in", "ua1 logged in" ); +$res1 = $ua1->get( 'http://localhost/page'); +$res2 = $ua2->get( 'http://localhost/page'); +ok $_->is_success, 'get main page' for $res1, $res2; -$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2; +like $res1->content, qr/you are logged in/, 'ua1 logged in'; +like $res2->content, qr/please login/, 'ua2 not logged in'; -$ua1->content_contains( "you are logged in", "ua1 logged in" ); -$ua2->content_contains( "please login", "ua2 not logged in" ); +$res2 = $ua2->get( 'http://localhost/login'); +ok $res2->is_success, 'log ua2 in'; +like $res2->content, qr/logged in/, 'ua2 logged in'; -$ua2->get_ok( "http://localhost/login", "get main page" ); -$ua2->content_contains( "logged in", "log ua2 in" ); +$res1 = $ua1->get( 'http://localhost/page'); +$res2 = $ua2->get( 'http://localhost/page'); +ok $_->is_success, 'get main page' for $res1, $res2; -$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2; +like $res1->content, qr/you are logged in/, 'ua1 logged in'; +like $res2->content, qr/you are logged in/, 'ua2 logged in'; -$ua1->content_contains( "you are logged in", "ua1 logged in" ); -$ua2->content_contains( "you are logged in", "ua2 logged in" ); - -my ( $u1_expires ) = ($ua1->content =~ /(\d+)$/); -my ( $u2_expires ) = ($ua2->content =~ /(\d+)$/); +my ( $u1_expires ) = ($res1->content =~ /(\d+)$/); +my ( $u2_expires ) = ($res2->content =~ /(\d+)$/); sleep 1; -$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2; +$res1 = $ua1->get( 'http://localhost/page'); +$res2 = $ua2->get( 'http://localhost/page'); +ok $_->is_success, 'get main page' for $res1, $res2; -$ua1->content_contains( "you are logged in", "ua1 logged in" ); -$ua2->content_contains( "you are logged in", "ua2 logged in" ); +like $res1->content, qr/you are logged in/, 'ua1 logged in'; +like $res2->content, qr/you are logged in/, 'ua2 logged in'; -my ( $u1_expires_updated ) = ($ua1->content =~ /(\d+)$/); -my ( $u2_expires_updated ) = ($ua2->content =~ /(\d+)$/); +my ( $u1_expires_updated ) = ($res1->content =~ /(\d+)$/); +my ( $u2_expires_updated ) = ($res2->content =~ /(\d+)$/); cmp_ok( $u1_expires, "<", $u1_expires_updated, "expiry time updated"); cmp_ok( $u2_expires, "<", $u2_expires_updated, "expiry time updated"); -$ua2->get_ok( "http://localhost/logout", "log ua2 out" ); -$ua2->content_like( qr/logged out/, "ua2 logged out" ); -$ua2->content_like( qr/after 2 request/, - "ua2 made 2 requests for page in the session" ); +$res2 = $ua2->get( 'http://localhost/logout'); +ok $res2->is_success, 'log ua2 out'; +like $res2->content, qr/logged out/, 'ua2 logged out'; +like $res2->content, qr/after 2 requests/, + 'ua2 made 2 requests for page in the session'; -$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2; +$res1 = $ua1->get( 'http://localhost/page'); +$res2 = $ua2->get( 'http://localhost/page'); +ok $_->is_success, 'get main page' for $res1, $res2; -$ua1->content_contains( "you are logged in", "ua1 logged in" ); -$ua2->content_contains( "please login", "ua2 not logged in" ); +like $res1->content, qr/you are logged in/, 'ua1 logged in'; +like $res2->content, qr/please login/, 'ua2 not logged in'; -$ua1->get_ok( "http://localhost/logout", "log ua1 out" ); -$ua1->content_like( qr/logged out/, "ua1 logged out" ); -$ua1->content_like( qr/after 4 requests/, - "ua1 made 4 request for page in the session" ); +$res1 = $ua1->get( 'http://localhost/logout'); +ok $res1->is_success, 'log ua1 out'; +like $res1->content, qr/logged out/, 'ua1 logged out'; +like $res1->content, qr/after 4 requests/, + 'ua1 made 4 requests for page in the session'; -$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2; +$res1 = $ua1->get( 'http://localhost/page'); +$res2 = $ua2->get( 'http://localhost/page'); +ok $_->is_success, 'get main page' for $res1, $res2; -$ua1->content_contains( "please login", "ua1 not logged in" ); -$ua2->content_contains( "please login", "ua2 not logged in" ); +like $res1->content, qr/please login/, 'ua1 not logged in'; +like $res2->content, qr/please login/, 'ua2 not logged in'; -my $ua3 = Test::WWW::Mechanize::Catalyst->new; -$ua3->get_ok( "http://localhost/login", "log ua3 in" ); -$ua3->get_ok( "http://localhost/dump_these_loads_session"); -$ua3->content_contains('NOT'); - -my $ua4 = Test::WWW::Mechanize::Catalyst->new; -$ua4->get_ok( "http://localhost/page", "initial get" ); -$ua4->content_contains( "please login", "ua4 not logged in" ); - -$ua4->get_ok( "http://localhost/login", "log ua4 in" ); -$ua4->content_contains( "logged in", "ua4 logged in" ); +my $ua3 = MiniUA->new('SessionTestApp'); +my $res3 = $ua3->get( 'http://localhost/login'); +ok $res3->is_success, 'log ua3 in'; +$res3 = $ua3->get( 'http://localhost/dump_these_loads_session'); +ok $res3->is_success; +like $res3->content, qr/NOT/; -$ua4->get( "http://localhost/page", "get page" ); -my ( $ua4_expires1 ) = ($ua4->content =~ /(\d+)$/); -$ua4->get( "http://localhost/page", "get page" ); -my ( $ua4_expires2 ) = ($ua4->content =~ /(\d+)$/); +my $ua4 = MiniUA->new('SessionTestApp'); +my $res4 = $ua4->get( 'http://localhost/page'); +ok $res4->is_success, 'initial get'; +like $res4->content, qr/please login/, 'ua4 not logged in'; +$res4 = $ua4->get( 'http://localhost/login'); +ok $res4->is_success, 'log ua4 in'; +like $res4->content, qr/logged in/, 'ua4 logged in'; + +$res4 = $ua4->get( "http://localhost/page"); +ok +$res4->is_success, "get page"; +my ( $ua4_expires1 ) = ($res4->content =~ /(\d+)$/); +$res4 = $ua4->get( "http://localhost/page"); +ok +$res4->is_success, "get page"; +my ( $ua4_expires2 ) = ($res4->content =~ /(\d+)$/); is( $ua4_expires1, $ua4_expires2, 'expires has not changed' ); -$ua4->get( "http://localhost/change_session_expires", "get page" ); -$ua4->get( "http://localhost/page", "get page" ); -my ( $ua4_expires3 ) = ($ua4->content =~ /(\d+)$/); +$res4 = $ua4->get( "http://localhost/change_session_expires"); +ok +$res4->is_success, "get page"; +$res4 = $ua4->get( "http://localhost/page" ); +ok +$res4->is_success, "get page"; +my ( $ua4_expires3 ) = ($res4->content =~ /(\d+)$/); ok( $ua4_expires3 > ( $ua4_expires1 + 30000000), 'expires has been extended' ); -diag("Testing against Catalyst $Catalyst::VERSION"); -diag("Testing Catalyst::Plugin::Session $Catalyst::Plugin::Session::VERSION"); - done_testing; diff --git a/t/live_expiry_threshold.t b/t/live_expiry_threshold.t index 75beb64..a223f9d 100644 --- a/t/live_expiry_threshold.t +++ b/t/live_expiry_threshold.t @@ -1,27 +1,18 @@ -#!/usr/bin/perl - use strict; use warnings; +use Test::Needs { + 'Catalyst::Plugin::Authentication' => '0', + 'Catalyst::Plugin::Session::State::Cookie' => '0.03', +}; + use Test::More; -BEGIN { - eval { require Catalyst::Plugin::Session::State::Cookie; Catalyst::Plugin::Session::State::Cookie->VERSION(0.03) } - or plan skip_all => - "Catalyst::Plugin::Session::State::Cookie 0.03 or higher is required for this test"; +use lib "t/lib"; - eval { - require Test::WWW::Mechanize::Catalyst; - Test::WWW::Mechanize::Catalyst->VERSION(0.51); - } - or plan skip_all => - 'Test::WWW::Mechanize::Catalyst >= 0.51 is required for this test'; -} +use MiniUA; -use lib "t/lib"; -use Test::WWW::Mechanize::Catalyst "SessionExpiry"; - -my $ua = Test::WWW::Mechanize::Catalyst->new; +my $ua = MiniUA->new('SessionExpiry'); my $res = $ua->get( "http://localhost/session_data_expires" ); ok($res->is_success, "session_data_expires"); @@ -77,5 +68,4 @@ ok($res->is_success, "session_expires"); is($res->decoded_content, $updated, "session_expires == session_data_expires"); - done_testing; diff --git a/t/live_session_fixation.t b/t/live_session_fixation.t index cda60c9..505a48a 100644 --- a/t/live_session_fixation.t +++ b/t/live_session_fixation.t @@ -1,28 +1,16 @@ -#!/usr/bin/perl - use strict; use warnings; +use Test::Needs { + 'Catalyst::Plugin::Authentication' => '0', + 'Catalyst::Plugin::Session::State::Cookie' => '0.03', +}; + use Test::More; -use Data::Dumper; - -BEGIN { - eval { require Catalyst::Plugin::Session::State::Cookie; Catalyst::Plugin::Session::State::Cookie->VERSION(0.03) } - or plan skip_all => - "Catalyst::Plugin::Session::State::Cookie 0.03 or higher is required for this test"; - - eval { - require Test::WWW::Mechanize::Catalyst; - Test::WWW::Mechanize::Catalyst->VERSION(0.51); - } - or plan skip_all => - 'Test::WWW::Mechanize::Catalyst >= 0.51 is required for this test'; - - plan tests => 10; -} use lib "t/lib"; -use Test::WWW::Mechanize::Catalyst "SessionTestApp"; + +use MiniUA; #try completely random cookie unknown for our application; should be rejected my $cookie_name = 'sessiontestapp_session'; @@ -30,7 +18,7 @@ my ( @injected_cookie ) = ( 1, $cookie_name , $cookie_value ,'/', undef, 0, undef, undef, undef, {} ); my $injected_cookie_str = "${cookie_name}=${cookie_value}"; -my $ua1 = Test::WWW::Mechanize::Catalyst->new; +my $ua1 = MiniUA->new('SessionTestApp'); $ua1->cookie_jar->set_cookie( @injected_cookie ); my $res = $ua1->get( "http://localhost/login" ); @@ -39,56 +27,54 @@ ok $cookie1, "Set-Cookie 1"; isnt $cookie1, qr/$injected_cookie_str/, "Logging in generates us a new cookie"; -$ua1->get( "http://localhost/get_sessid" ); -my $sid1 = $ua1->content; +$res = $ua1->get( "http://localhost/get_sessid" ); +my $sid1 = $res->content; #set session variable var1 before session id change $ua1->get( "http://localhost/set_session_variable/var1/set_before_change"); -$ua1->get( "http://localhost/get_session_variable/var1"); -$ua1->content_is("VAR_var1=set_before_change"); +$res = $ua1->get( "http://localhost/get_session_variable/var1"); +is +$res->content, 'VAR_var1=set_before_change'; #just diagnostic dump -$ua1->get( "http://localhost/dump_session" ); -#diag "Before-change:".$ua1->content; +#diag "Before-change:".$ua1->get( "http://localhost/dump_session" )->content; #change session id; all session data should be kept; old session id invalidated -my $res2 = $ua1->get( "http://localhost/change_sessid" ); -my $cookie2 = $res2->header('Set-Cookie'); +$res = $ua1->get( "http://localhost/change_sessid" ); +my $cookie2 = $res->header('Set-Cookie'); ok $cookie2, "Set-Cookie 2"; isnt $cookie2, $cookie1, "Cookie changed"; -$ua1->get( "http://localhost/get_sessid" ); -my $sid2 = $ua1->content; +$res = $ua1->get( "http://localhost/get_sessid" ); +my $sid2 = $res->content; isnt $sid2, $sid1, 'SID changed'; #just diagnostic dump -$ua1->get( "http://localhost/dump_session" ); -#diag "After-change:".$ua1->content; +#diag "After-change:".$ua1->get( "http://localhost/dump_session" )->content; #set session variable var2 after session id change $ua1->get( "http://localhost/set_session_variable/var2/set_after_change"); #check if var1 and var2 contain expected values -$ua1->get( "http://localhost/get_session_variable/var1"); -$ua1->content_is("VAR_var1=set_before_change"); -$ua1->get( "http://localhost/get_session_variable/var2"); -$ua1->content_is("VAR_var2=set_after_change"); +$res = $ua1->get( "http://localhost/get_session_variable/var1"); +is +$res->content, 'VAR_var1=set_before_change'; +$res = $ua1->get( "http://localhost/get_session_variable/var2"); +is +$res->content, 'VAR_var2=set_after_change'; #just diagnostic dump -$ua1->get( "http://localhost/dump_session" ); -#diag "End1:".$ua1->content; +#diag "End1".$ua1->get( "http://localhost/dump_session" )->content; #try to use old cookie value (before session_id_change) -my $ua2 = Test::WWW::Mechanize::Catalyst->new; +my $ua2 = MiniUA->new('SessionTestApp'); $ua2->cookie_jar->set_cookie( @injected_cookie ); #if we take old cookie we should not be able to get any old session data -$ua2->get( "http://localhost/get_session_variable/var1"); -$ua2->content_is("VAR_var1=n.a."); -$ua2->get( "http://localhost/get_session_variable/var2"); -$ua2->content_is("VAR_var2=n.a."); +$res = $ua2->get( "http://localhost/get_session_variable/var1"); +is +$res->content, 'VAR_var1=n.a.'; +$res = $ua2->get( "http://localhost/get_session_variable/var2"); +is +$res->content, 'VAR_var2=n.a.'; #just diagnostic dump -$ua2->get( "http://localhost/dump_session" ); -#diag "End2:".$ua2->content; +#diag "End2".$ua1->get( "http://localhost/dump_session" )->content; + +done_testing; diff --git a/t/live_verify_address.t b/t/live_verify_address.t index e18ca91..b6f6d84 100644 --- a/t/live_verify_address.t +++ b/t/live_verify_address.t @@ -1,69 +1,55 @@ -#!/usr/bin/perl - use strict; use warnings; +use Test::Needs { + 'Catalyst::Plugin::Authentication' => '0', + 'Catalyst::Plugin::Session::State::Cookie' => '0.03', +}; + use Test::More; -BEGIN { - eval { require Catalyst::Plugin::Session::State::Cookie; Catalyst::Plugin::Session::State::Cookie->VERSION(0.03) } - or plan skip_all => - "Catalyst::Plugin::Session::State::Cookie 0.03 or higher is required for this test"; - - eval { - require Test::WWW::Mechanize::PSGI; - #Test::WWW::Mechanize::Catalyst->VERSION(0.51); - } - or plan skip_all => - 'Test::WWW::Mechanize::PSGI is required for this test'; - - eval { require Catalyst::Plugin::Authentication; 1 } - or plan skip_all => "Catalyst::Plugin::Authentication is required for this test"; - - plan tests => 12; -} use lib "t/lib"; -use Test::WWW::Mechanize::PSGI; -use SessionTestApp; -my $ua = Test::WWW::Mechanize::PSGI->new( - app => SessionTestApp->psgi_app(@_), - cookie_jar => {} -); + +use MiniUA; + +my $ua = MiniUA->new('SessionTestApp'); # Test without delete __address local $ENV{REMOTE_ADDR} = "192.168.1.1"; -$ua->get_ok( "http://localhost/login" ); -$ua->content_contains('logged in'); +my $res; -$ua->get_ok( "http://localhost/set_session_variable/logged/in" ); -$ua->content_contains('session variable set'); +$res = $ua->get( "http://localhost/login" ); +ok +$res->is_success; +like +$res->content, qr{logged in}; + +$res = $ua->get( "http://localhost/set_session_variable/logged/in" ); +ok +$res->is_success; +like +$res->content, qr{session variable set}; # Change Client -use Plack::Builder; -my $app = SessionTestApp->psgi_app(@_); -my $ua2 = Test::WWW::Mechanize::PSGI->new( - app => $app, - cookie_jar => {} -); -$ua2->get_ok( "http://localhost/get_session_variable/logged"); -$ua2->content_contains('VAR_logged=n.a.'); +my $ua2 = MiniUA->new('SessionTestApp'); +$res = $ua2->get( "http://localhost/get_session_variable/logged" ); +ok +$res->is_success; +like +$res->content, qr{VAR_logged=n\.a\.}; # Inital Client local $ENV{REMOTE_ADDR} = "192.168.1.1"; -$ua->get_ok( "http://localhost/login_without_address" ); -$ua->content_contains('logged in (without address)'); +$res = $ua->get( "http://localhost/login_without_address" ); +ok +$res->is_success; +like +$res->content, qr{logged in \(without address\)}; -$ua->get_ok( "http://localhost/set_session_variable/logged/in" ); -$ua->content_contains('session variable set'); +$res = $ua->get( "http://localhost/set_session_variable/logged/in" ); +ok +$res->is_success; +like +$res->content, qr{session variable set}; # Change Client local $ENV{REMOTE_ADDR} = "192.168.1.2"; -$ua->get_ok( "http://localhost/get_session_variable/logged" ); -$ua->content_contains('VAR_logged=in'); +$res = $ua->get( "http://localhost/get_session_variable/logged" ); +ok +$res->is_success; +like +$res->content, qr{VAR_logged=in}; - - +done_testing; diff --git a/t/live_verify_user_agent.t b/t/live_verify_user_agent.t index 310d51b..3379f06 100644 --- a/t/live_verify_user_agent.t +++ b/t/live_verify_user_agent.t @@ -1,44 +1,46 @@ -#!/usr/bin/perl - use strict; use warnings; +use Test::Needs { + 'Catalyst::Plugin::Authentication' => '0', + 'Catalyst::Plugin::Session::State::Cookie' => '0.03', +}; + use Test::More; -BEGIN { - eval { require Catalyst::Plugin::Session::State::Cookie; Catalyst::Plugin::Session::State::Cookie->VERSION(0.03) } - or plan skip_all => - "Catalyst::Plugin::Session::State::Cookie 0.03 or higher is required for this test"; +use lib "t/lib"; - eval { - require Test::WWW::Mechanize::Catalyst; - Test::WWW::Mechanize::Catalyst->VERSION(0.51); - } - or plan skip_all => - 'Test::WWW::Mechanize::Catalyst >= 0.51 is required for this test'; +use MiniUA; - plan tests => 12; -} +my $ua = MiniUA->new('SessionTestApp'); +$ua->agent('Initial user_agent'); -use lib "t/lib"; -use Test::WWW::Mechanize::Catalyst "SessionTestApp"; +my $res; -my $ua = Test::WWW::Mechanize::Catalyst->new( { agent => 'Initial user_agent'} ); -$ua->get_ok( "http://localhost/user_agent", "get initial user_agent" ); -$ua->content_contains( "UA=Initial user_agent", "test initial user_agent" ); +$res = $ua->get( "http://localhost/user_agent" ); +ok +$res->is_success, "get initial user_agent"; +like +$res->content, qr{UA=Initial user_agent}, "test initial user_agent"; -$ua->get_ok( "http://localhost/page", "initial get main page" ); -$ua->content_contains( "please login", "ua not logged in" ); +$res = $ua->get( "http://localhost/page" ); +ok +$res->is_success, "initial get main page"; +like +$res->content, qr{please login}, "ua not logged in"; -$ua->get_ok( "http://localhost/login", "log ua in" ); -$ua->content_contains( "logged in", "ua logged in" ); +$res = $ua->get( "http://localhost/login" ); +ok +$res->is_success, "log ua in"; +like +$res->content, qr{logged in}, "ua logged in"; -$ua->get_ok( "http://localhost/page", "get main page" ); -$ua->content_contains( "you are logged in", "ua logged in" ); +$res = $ua->get( "http://localhost/page" ); +ok +$res->is_success, "get main page"; +like +$res->content, qr{you are logged in}, "ua logged in"; $ua->agent('Changed user_agent'); -$ua->get_ok( "http://localhost/user_agent", "get changed user_agent" ); -$ua->content_contains( "UA=Changed user_agent", "test changed user_agent" ); -$ua->get_ok( "http://localhost/page", "test deleted session" ); -$ua->content_contains( "please login", "ua not logged in" ); +$res = $ua->get( "http://localhost/user_agent" ); +ok +$res->is_success, "get changed user_agent"; +like +$res->content, qr{UA=Changed user_agent}, "test changed user_agent"; + +$res = $ua->get( "http://localhost/page" ); +ok +$res->is_success, "test deleted session"; +like +$res->content, qr{please login}, "ua not logged in"; + +done_testing; diff --git a/t/session_valid.t b/t/session_valid.t index 2d64493..581b261 100644 --- a/t/session_valid.t +++ b/t/session_valid.t @@ -1,35 +1,28 @@ -#!/usr/bin/perl - use strict; use warnings; +use Test::Needs { + 'Catalyst::Plugin::Session::State::Cookie' => '0.03', +}; + use Test::More; -BEGIN { - eval { require Catalyst::Plugin::Session::State::Cookie; Catalyst::Plugin::Session::State::Cookie->VERSION(0.03) } - or plan skip_all => - "Catalyst::Plugin::Session::State::Cookie 0.03 or higher is required for this test"; +use lib "t/lib"; - eval { - require Test::WWW::Mechanize::Catalyst; - Test::WWW::Mechanize::Catalyst->VERSION(0.51); - } - or plan skip_all => - 'Test::WWW::Mechanize::Catalyst >= 0.51 is required for this test'; +use MiniUA; - plan tests => 4; -} -use FindBin qw/$Bin/; -use lib "$Bin/lib"; -use Test::WWW::Mechanize::Catalyst "SessionValid"; +my $ua = MiniUA->new('SessionValid'); -my $ua = Test::WWW::Mechanize::Catalyst->new; +my $res; -$ua->get_ok( "http://localhost/", "initial get" ); -$ua->content_contains( "value set", "page contains expected value" ); +$res = $ua->get( "http://localhost/" ); +ok +$res->is_success, "initial get"; +like +$res->content, qr{value set}, "page contains expected value"; sleep 2; -$ua->get_ok( "http://localhost/", "grab the page again, after the session has expired" ); -$ua->content_contains( "value set", "page contains expected value" ); +$res = $ua->get( "http://localhost/" ); +ok +$res->is_success, "grab the page again, after the session has expired"; +like +$res->content, qr{value set}, "page contains expected value"; +done_testing; diff --git a/xt/pod.t b/xt/pod.t new file mode 100644 index 0000000..922959c --- /dev/null +++ b/xt/pod.t @@ -0,0 +1,4 @@ +use Test::More; + +use Test::Pod 1.14; +all_pod_files_ok(); diff --git a/xt/podcoverage.t b/xt/podcoverage.t new file mode 100644 index 0000000..7911330 --- /dev/null +++ b/xt/podcoverage.t @@ -0,0 +1,4 @@ +use Test::More; + +use Test::Pod::Coverage 1.04; +all_pod_coverage_ok();