Codebase list libchi-driver-redis-perl / da19fde
Import original source of CHI-Driver-Redis 0.09 Christopher Hoskin 8 years ago
17 changed file(s) with 2906 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
+45
-0
Changes less more
0 Revision history for CHI-Driver-Redis
1
2 0.09 February 24, 2015
3 * Change how parameters are stored and passed to the Redis constructor
4 * Migrate to Moo
5 * Jettison _verify_redis_connection
6
7 0.08 August 13, 2014
8 * Use Test::Mock::Redis for tests when CHI_REDIS_SERVER not set
9
10 0.07 August 11, 2014
11 * Add prefix option to prefix all keys
12
13 0.06 August 4, 2014
14 * Set Redis encoding option to undef to disable encoding
15 * Fix store to use expires_in (RT#78120)
16 * Revert "Use hashes."
17 * Change maintainer
18 * Add support for password option to Redis (RT#97382)
19
20 0.05
21 * Use hashes to store info rather than crazy sets and keys.
22 * Indiscriminately turn off the UTF-8 flag on data coming out of
23 Redis.pm so CHI can handle it.
24 * Bump dependency versions.
25
26 0.04 March 17, 2010
27 * Separate ping check from reconnection exceptions so that being disconnected
28 doesn't become a permanent problem. We now reconnect when Redis comes back.
29
30 0.03 March 17, 2010
31 * PODed implementation details
32 * Conditional tests
33
34 0.02 December 22nd, 2009
35 * POD updates
36 * Rename _redis attribute to redis
37 * Lazily set redis attribute so that it is not populated until the first
38 use. This – plus some new error handling – prevent crazy explosions when
39 Redis isn't available at instantiation time.
40 * Add warning for when ->ping fails
41
42 0.01 Date/time
43 First version, released on an unsuspecting world.
44
+378
-0
LICENSE less more
0
1 Terms of Perl itself
2
3 a) the GNU General Public License as published by the Free
4 Software Foundation; either version 1, or (at your option) any
5 later version, or
6 b) the "Artistic License"
7
8 ----------------------------------------------------------------------------
9
10 The General Public License (GPL)
11 Version 2, June 1991
12
13 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave,
14 Cambridge, MA 02139, USA. Everyone is permitted to copy and distribute
15 verbatim copies of this license document, but changing it is not allowed.
16
17 Preamble
18
19 The licenses for most software are designed to take away your freedom to share
20 and change it. By contrast, the GNU General Public License is intended to
21 guarantee your freedom to share and change free software--to make sure the
22 software is free for all its users. This General Public License applies to most of
23 the Free Software Foundation's software and to any other program whose
24 authors commit to using it. (Some other Free Software Foundation software is
25 covered by the GNU Library General Public License instead.) You can apply it to
26 your programs, too.
27
28 When we speak of free software, we are referring to freedom, not price. Our
29 General Public Licenses are designed to make sure that you have the freedom
30 to distribute copies of free software (and charge for this service if you wish), that
31 you receive source code or can get it if you want it, that you can change the
32 software or use pieces of it in new free programs; and that you know you can do
33 these things.
34
35 To protect your rights, we need to make restrictions that forbid anyone to deny
36 you these rights or to ask you to surrender the rights. These restrictions
37 translate to certain responsibilities for you if you distribute copies of the
38 software, or if you modify it.
39
40 For example, if you distribute copies of such a program, whether gratis or for a
41 fee, you must give the recipients all the rights that you have. You must make
42 sure that they, too, receive or can get the source code. And you must show
43 them these terms so they know their rights.
44
45 We protect your rights with two steps: (1) copyright the software, and (2) offer
46 you this license which gives you legal permission to copy, distribute and/or
47 modify the software.
48
49 Also, for each author's protection and ours, we want to make certain that
50 everyone understands that there is no warranty for this free software. If the
51 software is modified by someone else and passed on, we want its recipients to
52 know that what they have is not the original, so that any problems introduced by
53 others will not reflect on the original authors' reputations.
54
55 Finally, any free program is threatened constantly by software patents. We wish
56 to avoid the danger that redistributors of a free program will individually obtain
57 patent licenses, in effect making the program proprietary. To prevent this, we
58 have made it clear that any patent must be licensed for everyone's free use or
59 not licensed at all.
60
61 The precise terms and conditions for copying, distribution and modification
62 follow.
63
64 GNU GENERAL PUBLIC LICENSE
65 TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND
66 MODIFICATION
67
68 0. This License applies to any program or other work which contains a notice
69 placed by the copyright holder saying it may be distributed under the terms of
70 this General Public License. The "Program", below, refers to any such program
71 or work, and a "work based on the Program" means either the Program or any
72 derivative work under copyright law: that is to say, a work containing the
73 Program or a portion of it, either verbatim or with modifications and/or translated
74 into another language. (Hereinafter, translation is included without limitation in
75 the term "modification".) Each licensee is addressed as "you".
76
77 Activities other than copying, distribution and modification are not covered by
78 this License; they are outside its scope. The act of running the Program is not
79 restricted, and the output from the Program is covered only if its contents
80 constitute a work based on the Program (independent of having been made by
81 running the Program). Whether that is true depends on what the Program does.
82
83 1. You may copy and distribute verbatim copies of the Program's source code as
84 you receive it, in any medium, provided that you conspicuously and appropriately
85 publish on each copy an appropriate copyright notice and disclaimer of warranty;
86 keep intact all the notices that refer to this License and to the absence of any
87 warranty; and give any other recipients of the Program a copy of this License
88 along with the Program.
89
90 You may charge a fee for the physical act of transferring a copy, and you may at
91 your option offer warranty protection in exchange for a fee.
92
93 2. You may modify your copy or copies of the Program or any portion of it, thus
94 forming a work based on the Program, and copy and distribute such
95 modifications or work under the terms of Section 1 above, provided that you also
96 meet all of these conditions:
97
98 a) You must cause the modified files to carry prominent notices stating that you
99 changed the files and the date of any change.
100
101 b) You must cause any work that you distribute or publish, that in whole or in
102 part contains or is derived from the Program or any part thereof, to be licensed
103 as a whole at no charge to all third parties under the terms of this License.
104
105 c) If the modified program normally reads commands interactively when run, you
106 must cause it, when started running for such interactive use in the most ordinary
107 way, to print or display an announcement including an appropriate copyright
108 notice and a notice that there is no warranty (or else, saying that you provide a
109 warranty) and that users may redistribute the program under these conditions,
110 and telling the user how to view a copy of this License. (Exception: if the
111 Program itself is interactive but does not normally print such an announcement,
112 your work based on the Program is not required to print an announcement.)
113
114 These requirements apply to the modified work as a whole. If identifiable
115 sections of that work are not derived from the Program, and can be reasonably
116 considered independent and separate works in themselves, then this License,
117 and its terms, do not apply to those sections when you distribute them as
118 separate works. But when you distribute the same sections as part of a whole
119 which is a work based on the Program, the distribution of the whole must be on
120 the terms of this License, whose permissions for other licensees extend to the
121 entire whole, and thus to each and every part regardless of who wrote it.
122
123 Thus, it is not the intent of this section to claim rights or contest your rights to
124 work written entirely by you; rather, the intent is to exercise the right to control
125 the distribution of derivative or collective works based on the Program.
126
127 In addition, mere aggregation of another work not based on the Program with the
128 Program (or with a work based on the Program) on a volume of a storage or
129 distribution medium does not bring the other work under the scope of this
130 License.
131
132 3. You may copy and distribute the Program (or a work based on it, under
133 Section 2) in object code or executable form under the terms of Sections 1 and 2
134 above provided that you also do one of the following:
135
136 a) Accompany it with the complete corresponding machine-readable source
137 code, which must be distributed under the terms of Sections 1 and 2 above on a
138 medium customarily used for software interchange; or,
139
140 b) Accompany it with a written offer, valid for at least three years, to give any
141 third party, for a charge no more than your cost of physically performing source
142 distribution, a complete machine-readable copy of the corresponding source
143 code, to be distributed under the terms of Sections 1 and 2 above on a medium
144 customarily used for software interchange; or,
145
146 c) Accompany it with the information you received as to the offer to distribute
147 corresponding source code. (This alternative is allowed only for noncommercial
148 distribution and only if you received the program in object code or executable
149 form with such an offer, in accord with Subsection b above.)
150
151 The source code for a work means the preferred form of the work for making
152 modifications to it. For an executable work, complete source code means all the
153 source code for all modules it contains, plus any associated interface definition
154 files, plus the scripts used to control compilation and installation of the
155 executable. However, as a special exception, the source code distributed need
156 not include anything that is normally distributed (in either source or binary form)
157 with the major components (compiler, kernel, and so on) of the operating system
158 on which the executable runs, unless that component itself accompanies the
159 executable.
160
161 If distribution of executable or object code is made by offering access to copy
162 from a designated place, then offering equivalent access to copy the source
163 code from the same place counts as distribution of the source code, even though
164 third parties are not compelled to copy the source along with the object code.
165
166 4. You may not copy, modify, sublicense, or distribute the Program except as
167 expressly provided under this License. Any attempt otherwise to copy, modify,
168 sublicense or distribute the Program is void, and will automatically terminate
169 your rights under this License. However, parties who have received copies, or
170 rights, from you under this License will not have their licenses terminated so long
171 as such parties remain in full compliance.
172
173 5. You are not required to accept this License, since you have not signed it.
174 However, nothing else grants you permission to modify or distribute the Program
175 or its derivative works. These actions are prohibited by law if you do not accept
176 this License. Therefore, by modifying or distributing the Program (or any work
177 based on the Program), you indicate your acceptance of this License to do so,
178 and all its terms and conditions for copying, distributing or modifying the
179 Program or works based on it.
180
181 6. Each time you redistribute the Program (or any work based on the Program),
182 the recipient automatically receives a license from the original licensor to copy,
183 distribute or modify the Program subject to these terms and conditions. You
184 may not impose any further restrictions on the recipients' exercise of the rights
185 granted herein. You are not responsible for enforcing compliance by third parties
186 to this License.
187
188 7. If, as a consequence of a court judgment or allegation of patent infringement
189 or for any other reason (not limited to patent issues), conditions are imposed on
190 you (whether by court order, agreement or otherwise) that contradict the
191 conditions of this License, they do not excuse you from the conditions of this
192 License. If you cannot distribute so as to satisfy simultaneously your obligations
193 under this License and any other pertinent obligations, then as a consequence
194 you may not distribute the Program at all. For example, if a patent license would
195 not permit royalty-free redistribution of the Program by all those who receive
196 copies directly or indirectly through you, then the only way you could satisfy
197 both it and this License would be to refrain entirely from distribution of the
198 Program.
199
200 If any portion of this section is held invalid or unenforceable under any particular
201 circumstance, the balance of the section is intended to apply and the section as
202 a whole is intended to apply in other circumstances.
203
204 It is not the purpose of this section to induce you to infringe any patents or other
205 property right claims or to contest validity of any such claims; this section has
206 the sole purpose of protecting the integrity of the free software distribution
207 system, which is implemented by public license practices. Many people have
208 made generous contributions to the wide range of software distributed through
209 that system in reliance on consistent application of that system; it is up to the
210 author/donor to decide if he or she is willing to distribute software through any
211 other system and a licensee cannot impose that choice.
212
213 This section is intended to make thoroughly clear what is believed to be a
214 consequence of the rest of this License.
215
216 8. If the distribution and/or use of the Program is restricted in certain countries
217 either by patents or by copyrighted interfaces, the original copyright holder who
218 places the Program under this License may add an explicit geographical
219 distribution limitation excluding those countries, so that distribution is permitted
220 only in or among countries not thus excluded. In such case, this License
221 incorporates the limitation as if written in the body of this License.
222
223 9. The Free Software Foundation may publish revised and/or new versions of the
224 General Public License from time to time. Such new versions will be similar in
225 spirit to the present version, but may differ in detail to address new problems or
226 concerns.
227
228 Each version is given a distinguishing version number. If the Program specifies a
229 version number of this License which applies to it and "any later version", you
230 have the option of following the terms and conditions either of that version or of
231 any later version published by the Free Software Foundation. If the Program does
232 not specify a version number of this License, you may choose any version ever
233 published by the Free Software Foundation.
234
235 10. If you wish to incorporate parts of the Program into other free programs
236 whose distribution conditions are different, write to the author to ask for
237 permission. For software which is copyrighted by the Free Software Foundation,
238 write to the Free Software Foundation; we sometimes make exceptions for this.
239 Our decision will be guided by the two goals of preserving the free status of all
240 derivatives of our free software and of promoting the sharing and reuse of
241 software generally.
242
243 NO WARRANTY
244
245 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS
246 NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
247 APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE
248 COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM
249 "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR
250 IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
251 MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
252 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
253 PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE,
254 YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
255 CORRECTION.
256
257 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED
258 TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY
259 WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS
260 PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
261 GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES
262 ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM
263 (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
264 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
265 PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY
266 OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS
267 BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
268
269 END OF TERMS AND CONDITIONS
270
271
272 ----------------------------------------------------------------------------
273
274 The Artistic License
275
276 Preamble
277
278 The intent of this document is to state the conditions under which a Package
279 may be copied, such that the Copyright Holder maintains some semblance of
280 artistic control over the development of the package, while giving the users of the
281 package the right to use and distribute the Package in a more-or-less customary
282 fashion, plus the right to make reasonable modifications.
283
284 Definitions:
285
286 - "Package" refers to the collection of files distributed by the Copyright
287 Holder, and derivatives of that collection of files created through textual
288 modification.
289 - "Standard Version" refers to such a Package if it has not been modified,
290 or has been modified in accordance with the wishes of the Copyright
291 Holder.
292 - "Copyright Holder" is whoever is named in the copyright or copyrights for
293 the package.
294 - "You" is you, if you're thinking about copying or distributing this Package.
295 - "Reasonable copying fee" is whatever you can justify on the basis of
296 media cost, duplication charges, time of people involved, and so on. (You
297 will not be required to justify it to the Copyright Holder, but only to the
298 computing community at large as a market that must bear the fee.)
299 - "Freely Available" means that no fee is charged for the item itself, though
300 there may be fees involved in handling the item. It also means that
301 recipients of the item may redistribute it under the same conditions they
302 received it.
303
304 1. You may make and give away verbatim copies of the source form of the
305 Standard Version of this Package without restriction, provided that you duplicate
306 all of the original copyright notices and associated disclaimers.
307
308 2. You may apply bug fixes, portability fixes and other modifications derived from
309 the Public Domain or from the Copyright Holder. A Package modified in such a
310 way shall still be considered the Standard Version.
311
312 3. You may otherwise modify your copy of this Package in any way, provided
313 that you insert a prominent notice in each changed file stating how and when
314 you changed that file, and provided that you do at least ONE of the following:
315
316 a) place your modifications in the Public Domain or otherwise
317 make them Freely Available, such as by posting said modifications
318 to Usenet or an equivalent medium, or placing the modifications on
319 a major archive site such as ftp.uu.net, or by allowing the
320 Copyright Holder to include your modifications in the Standard
321 Version of the Package.
322
323 b) use the modified Package only within your corporation or
324 organization.
325
326 c) rename any non-standard executables so the names do not
327 conflict with standard executables, which must also be provided,
328 and provide a separate manual page for each non-standard
329 executable that clearly documents how it differs from the Standard
330 Version.
331
332 d) make other distribution arrangements with the Copyright Holder.
333
334 4. You may distribute the programs of this Package in object code or executable
335 form, provided that you do at least ONE of the following:
336
337 a) distribute a Standard Version of the executables and library
338 files, together with instructions (in the manual page or equivalent)
339 on where to get the Standard Version.
340
341 b) accompany the distribution with the machine-readable source of
342 the Package with your modifications.
343
344 c) accompany any non-standard executables with their
345 corresponding Standard Version executables, giving the
346 non-standard executables non-standard names, and clearly
347 documenting the differences in manual pages (or equivalent),
348 together with instructions on where to get the Standard Version.
349
350 d) make other distribution arrangements with the Copyright Holder.
351
352 5. You may charge a reasonable copying fee for any distribution of this Package.
353 You may charge any fee you choose for support of this Package. You may not
354 charge a fee for this Package itself. However, you may distribute this Package in
355 aggregate with other (possibly commercial) programs as part of a larger
356 (possibly commercial) software distribution provided that you do not advertise
357 this Package as a product of your own.
358
359 6. The scripts and library files supplied as input to or produced as output from
360 the programs of this Package do not automatically fall under the copyright of this
361 Package, but belong to whomever generated them, and may be sold
362 commercially, and may be aggregated with this Package.
363
364 7. C or perl subroutines supplied by you and linked into this Package shall not
365 be considered part of this Package.
366
367 8. The name of the Copyright Holder may not be used to endorse or promote
368 products derived from this software without specific prior written permission.
369
370 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
371 IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
372 WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR
373 PURPOSE.
374
375 The End
376
377
+17
-0
MANIFEST less more
0 Changes
1 inc/Module/Install.pm
2 inc/Module/Install/Base.pm
3 inc/Module/Install/Can.pm
4 inc/Module/Install/Fetch.pm
5 inc/Module/Install/Makefile.pm
6 inc/Module/Install/Metadata.pm
7 inc/Module/Install/Win32.pm
8 inc/Module/Install/WriteAll.pm
9 lib/CHI/Driver/Redis.pm
10 lib/CHI/Driver/Redis/t/CHIDriverTests.pm
11 LICENSE
12 Makefile.PL
13 MANIFEST This list of files
14 META.yml
15 README
16 t/CHI-driver-tests.t
+32
-0
META.yml less more
0 ---
1 author:
2 - 'Cory G Watson <gphat@cpan.org>'
3 build_requires:
4 ExtUtils::MakeMaker: 6.59
5 Test::Class: 0
6 Test::Mock::Redis: 0
7 Test::More: 0
8 configure_requires:
9 ExtUtils::MakeMaker: 6.59
10 distribution_type: module
11 dynamic_config: 1
12 generated_by: 'Module::Install version 1.14'
13 license: perl
14 meta-spec:
15 url: http://module-build.sourceforge.net/META-spec-v1.4.html
16 version: 1.4
17 name: CHI-Driver-Redis
18 no_index:
19 directory:
20 - inc
21 - t
22 requires:
23 CHI: '0.36'
24 Moo: 0
25 Redis: '1.901'
26 URI: 0
27 perl: 5.6.0
28 resources:
29 license: http://dev.perl.org/licenses/
30 repository: https://github.com/rentrak/chi-driver-redis
31 version: '0.09'
+21
-0
Makefile.PL less more
0 use inc::Module::Install;
1
2 name 'CHI-Driver-Redis';
3 version_from 'lib/CHI/Driver/Redis.pm';
4 author q{Cory G Watson <gphat@cpan.org>};
5 license 'perl';
6 repository 'https://github.com/rentrak/chi-driver-redis';
7
8 perl_version '5.006';
9
10 build_requires 'Test::Class';
11 build_requires 'Test::More';
12 build_requires 'Test::Mock::Redis';
13
14 requires 'CHI' => '0.36';
15 requires 'Moo';
16 requires 'Redis' => '1.901';
17 requires 'URI';
18
19 WriteAll;
20
+55
-0
README less more
0 CHI-Driver-Redis
1
2 The README is used to introduce the module and provide instructions on
3 how to install the module, any machine dependencies it may have (for
4 example C compilers and installed libraries) and any other information
5 that should be provided before the module is installed.
6
7 A README file is required for CPAN modules since CPAN extracts the README
8 file from a module distribution so that people browsing the archive
9 can use it to get an idea of the module's uses. It is usually a good idea
10 to provide version information here so that people can decide whether
11 fixes for the module are worth downloading.
12
13
14 INSTALLATION
15
16 To install this module, run the following commands:
17
18 perl Makefile.PL
19 make
20 make test
21 make install
22
23 SUPPORT AND DOCUMENTATION
24
25 After installing, you can find documentation for this module with the
26 perldoc command.
27
28 perldoc CHI::Driver::Redis
29
30 You can also look for information at:
31
32 RT, CPAN's request tracker
33 http://rt.cpan.org/NoAuth/Bugs.html?Dist=CHI-Driver-Redis
34
35 AnnoCPAN, Annotated CPAN documentation
36 http://annocpan.org/dist/CHI-Driver-Redis
37
38 CPAN Ratings
39 http://cpanratings.perl.org/d/CHI-Driver-Redis
40
41 Search CPAN
42 http://search.cpan.org/dist/CHI-Driver-Redis/
43
44
45 COPYRIGHT AND LICENCE
46
47 Copyright (C) 2009 Cory G Watson
48
49 This program is free software; you can redistribute it and/or modify it
50 under the terms of either: the GNU General Public License as published
51 by the Free Software Foundation; or the Artistic License.
52
53 See http://dev.perl.org/licenses/ for more information.
54
+83
-0
inc/Module/Install/Base.pm less more
0 #line 1
1 package Module::Install::Base;
2
3 use strict 'vars';
4 use vars qw{$VERSION};
5 BEGIN {
6 $VERSION = '1.14';
7 }
8
9 # Suspend handler for "redefined" warnings
10 BEGIN {
11 my $w = $SIG{__WARN__};
12 $SIG{__WARN__} = sub { $w };
13 }
14
15 #line 42
16
17 sub new {
18 my $class = shift;
19 unless ( defined &{"${class}::call"} ) {
20 *{"${class}::call"} = sub { shift->_top->call(@_) };
21 }
22 unless ( defined &{"${class}::load"} ) {
23 *{"${class}::load"} = sub { shift->_top->load(@_) };
24 }
25 bless { @_ }, $class;
26 }
27
28 #line 61
29
30 sub AUTOLOAD {
31 local $@;
32 my $func = eval { shift->_top->autoload } or return;
33 goto &$func;
34 }
35
36 #line 75
37
38 sub _top {
39 $_[0]->{_top};
40 }
41
42 #line 90
43
44 sub admin {
45 $_[0]->_top->{admin}
46 or
47 Module::Install::Base::FakeAdmin->new;
48 }
49
50 #line 106
51
52 sub is_admin {
53 ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
54 }
55
56 sub DESTROY {}
57
58 package Module::Install::Base::FakeAdmin;
59
60 use vars qw{$VERSION};
61 BEGIN {
62 $VERSION = $Module::Install::Base::VERSION;
63 }
64
65 my $fake;
66
67 sub new {
68 $fake ||= bless(\@_, $_[0]);
69 }
70
71 sub AUTOLOAD {}
72
73 sub DESTROY {}
74
75 # Restore warning handler
76 BEGIN {
77 $SIG{__WARN__} = $SIG{__WARN__}->();
78 }
79
80 1;
81
82 #line 159
+154
-0
inc/Module/Install/Can.pm less more
0 #line 1
1 package Module::Install::Can;
2
3 use strict;
4 use Config ();
5 use ExtUtils::MakeMaker ();
6 use Module::Install::Base ();
7
8 use vars qw{$VERSION @ISA $ISCORE};
9 BEGIN {
10 $VERSION = '1.14';
11 @ISA = 'Module::Install::Base';
12 $ISCORE = 1;
13 }
14
15 # check if we can load some module
16 ### Upgrade this to not have to load the module if possible
17 sub can_use {
18 my ($self, $mod, $ver) = @_;
19 $mod =~ s{::|\\}{/}g;
20 $mod .= '.pm' unless $mod =~ /\.pm$/i;
21
22 my $pkg = $mod;
23 $pkg =~ s{/}{::}g;
24 $pkg =~ s{\.pm$}{}i;
25
26 local $@;
27 eval { require $mod; $pkg->VERSION($ver || 0); 1 };
28 }
29
30 # Check if we can run some command
31 sub can_run {
32 my ($self, $cmd) = @_;
33
34 my $_cmd = $cmd;
35 return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
36
37 for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
38 next if $dir eq '';
39 require File::Spec;
40 my $abs = File::Spec->catfile($dir, $cmd);
41 return $abs if (-x $abs or $abs = MM->maybe_command($abs));
42 }
43
44 return;
45 }
46
47 # Can our C compiler environment build XS files
48 sub can_xs {
49 my $self = shift;
50
51 # Ensure we have the CBuilder module
52 $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
53
54 # Do we have the configure_requires checker?
55 local $@;
56 eval "require ExtUtils::CBuilder;";
57 if ( $@ ) {
58 # They don't obey configure_requires, so it is
59 # someone old and delicate. Try to avoid hurting
60 # them by falling back to an older simpler test.
61 return $self->can_cc();
62 }
63
64 # Do we have a working C compiler
65 my $builder = ExtUtils::CBuilder->new(
66 quiet => 1,
67 );
68 unless ( $builder->have_compiler ) {
69 # No working C compiler
70 return 0;
71 }
72
73 # Write a C file representative of what XS becomes
74 require File::Temp;
75 my ( $FH, $tmpfile ) = File::Temp::tempfile(
76 "compilexs-XXXXX",
77 SUFFIX => '.c',
78 );
79 binmode $FH;
80 print $FH <<'END_C';
81 #include "EXTERN.h"
82 #include "perl.h"
83 #include "XSUB.h"
84
85 int main(int argc, char **argv) {
86 return 0;
87 }
88
89 int boot_sanexs() {
90 return 1;
91 }
92
93 END_C
94 close $FH;
95
96 # Can the C compiler access the same headers XS does
97 my @libs = ();
98 my $object = undef;
99 eval {
100 local $^W = 0;
101 $object = $builder->compile(
102 source => $tmpfile,
103 );
104 @libs = $builder->link(
105 objects => $object,
106 module_name => 'sanexs',
107 );
108 };
109 my $result = $@ ? 0 : 1;
110
111 # Clean up all the build files
112 foreach ( $tmpfile, $object, @libs ) {
113 next unless defined $_;
114 1 while unlink;
115 }
116
117 return $result;
118 }
119
120 # Can we locate a (the) C compiler
121 sub can_cc {
122 my $self = shift;
123 my @chunks = split(/ /, $Config::Config{cc}) or return;
124
125 # $Config{cc} may contain args; try to find out the program part
126 while (@chunks) {
127 return $self->can_run("@chunks") || (pop(@chunks), next);
128 }
129
130 return;
131 }
132
133 # Fix Cygwin bug on maybe_command();
134 if ( $^O eq 'cygwin' ) {
135 require ExtUtils::MM_Cygwin;
136 require ExtUtils::MM_Win32;
137 if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
138 *ExtUtils::MM_Cygwin::maybe_command = sub {
139 my ($self, $file) = @_;
140 if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
141 ExtUtils::MM_Win32->maybe_command($file);
142 } else {
143 ExtUtils::MM_Unix->maybe_command($file);
144 }
145 }
146 }
147 }
148
149 1;
150
151 __END__
152
153 #line 236
+93
-0
inc/Module/Install/Fetch.pm less more
0 #line 1
1 package Module::Install::Fetch;
2
3 use strict;
4 use Module::Install::Base ();
5
6 use vars qw{$VERSION @ISA $ISCORE};
7 BEGIN {
8 $VERSION = '1.14';
9 @ISA = 'Module::Install::Base';
10 $ISCORE = 1;
11 }
12
13 sub get_file {
14 my ($self, %args) = @_;
15 my ($scheme, $host, $path, $file) =
16 $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
17
18 if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
19 $args{url} = $args{ftp_url}
20 or (warn("LWP support unavailable!\n"), return);
21 ($scheme, $host, $path, $file) =
22 $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
23 }
24
25 $|++;
26 print "Fetching '$file' from $host... ";
27
28 unless (eval { require Socket; Socket::inet_aton($host) }) {
29 warn "'$host' resolve failed!\n";
30 return;
31 }
32
33 return unless $scheme eq 'ftp' or $scheme eq 'http';
34
35 require Cwd;
36 my $dir = Cwd::getcwd();
37 chdir $args{local_dir} or return if exists $args{local_dir};
38
39 if (eval { require LWP::Simple; 1 }) {
40 LWP::Simple::mirror($args{url}, $file);
41 }
42 elsif (eval { require Net::FTP; 1 }) { eval {
43 # use Net::FTP to get past firewall
44 my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
45 $ftp->login("anonymous", 'anonymous@example.com');
46 $ftp->cwd($path);
47 $ftp->binary;
48 $ftp->get($file) or (warn("$!\n"), return);
49 $ftp->quit;
50 } }
51 elsif (my $ftp = $self->can_run('ftp')) { eval {
52 # no Net::FTP, fallback to ftp.exe
53 require FileHandle;
54 my $fh = FileHandle->new;
55
56 local $SIG{CHLD} = 'IGNORE';
57 unless ($fh->open("|$ftp -n")) {
58 warn "Couldn't open ftp: $!\n";
59 chdir $dir; return;
60 }
61
62 my @dialog = split(/\n/, <<"END_FTP");
63 open $host
64 user anonymous anonymous\@example.com
65 cd $path
66 binary
67 get $file $file
68 quit
69 END_FTP
70 foreach (@dialog) { $fh->print("$_\n") }
71 $fh->close;
72 } }
73 else {
74 warn "No working 'ftp' program available!\n";
75 chdir $dir; return;
76 }
77
78 unless (-f $file) {
79 warn "Fetching failed: $@\n";
80 chdir $dir; return;
81 }
82
83 return if exists $args{size} and -s $file != $args{size};
84 system($args{run}) if exists $args{run};
85 unlink($file) if $args{remove};
86
87 print(((!exists $args{check_for} or -e $args{check_for})
88 ? "done!" : "failed! ($!)"), "\n");
89 chdir $dir; return !$?;
90 }
91
92 1;
+418
-0
inc/Module/Install/Makefile.pm less more
0 #line 1
1 package Module::Install::Makefile;
2
3 use strict 'vars';
4 use ExtUtils::MakeMaker ();
5 use Module::Install::Base ();
6 use Fcntl qw/:flock :seek/;
7
8 use vars qw{$VERSION @ISA $ISCORE};
9 BEGIN {
10 $VERSION = '1.14';
11 @ISA = 'Module::Install::Base';
12 $ISCORE = 1;
13 }
14
15 sub Makefile { $_[0] }
16
17 my %seen = ();
18
19 sub prompt {
20 shift;
21
22 # Infinite loop protection
23 my @c = caller();
24 if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
25 die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
26 }
27
28 # In automated testing or non-interactive session, always use defaults
29 if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
30 local $ENV{PERL_MM_USE_DEFAULT} = 1;
31 goto &ExtUtils::MakeMaker::prompt;
32 } else {
33 goto &ExtUtils::MakeMaker::prompt;
34 }
35 }
36
37 # Store a cleaned up version of the MakeMaker version,
38 # since we need to behave differently in a variety of
39 # ways based on the MM version.
40 my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
41
42 # If we are passed a param, do a "newer than" comparison.
43 # Otherwise, just return the MakeMaker version.
44 sub makemaker {
45 ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
46 }
47
48 # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
49 # as we only need to know here whether the attribute is an array
50 # or a hash or something else (which may or may not be appendable).
51 my %makemaker_argtype = (
52 C => 'ARRAY',
53 CONFIG => 'ARRAY',
54 # CONFIGURE => 'CODE', # ignore
55 DIR => 'ARRAY',
56 DL_FUNCS => 'HASH',
57 DL_VARS => 'ARRAY',
58 EXCLUDE_EXT => 'ARRAY',
59 EXE_FILES => 'ARRAY',
60 FUNCLIST => 'ARRAY',
61 H => 'ARRAY',
62 IMPORTS => 'HASH',
63 INCLUDE_EXT => 'ARRAY',
64 LIBS => 'ARRAY', # ignore ''
65 MAN1PODS => 'HASH',
66 MAN3PODS => 'HASH',
67 META_ADD => 'HASH',
68 META_MERGE => 'HASH',
69 PL_FILES => 'HASH',
70 PM => 'HASH',
71 PMLIBDIRS => 'ARRAY',
72 PMLIBPARENTDIRS => 'ARRAY',
73 PREREQ_PM => 'HASH',
74 CONFIGURE_REQUIRES => 'HASH',
75 SKIP => 'ARRAY',
76 TYPEMAPS => 'ARRAY',
77 XS => 'HASH',
78 # VERSION => ['version',''], # ignore
79 # _KEEP_AFTER_FLUSH => '',
80
81 clean => 'HASH',
82 depend => 'HASH',
83 dist => 'HASH',
84 dynamic_lib=> 'HASH',
85 linkext => 'HASH',
86 macro => 'HASH',
87 postamble => 'HASH',
88 realclean => 'HASH',
89 test => 'HASH',
90 tool_autosplit => 'HASH',
91
92 # special cases where you can use makemaker_append
93 CCFLAGS => 'APPENDABLE',
94 DEFINE => 'APPENDABLE',
95 INC => 'APPENDABLE',
96 LDDLFLAGS => 'APPENDABLE',
97 LDFROM => 'APPENDABLE',
98 );
99
100 sub makemaker_args {
101 my ($self, %new_args) = @_;
102 my $args = ( $self->{makemaker_args} ||= {} );
103 foreach my $key (keys %new_args) {
104 if ($makemaker_argtype{$key}) {
105 if ($makemaker_argtype{$key} eq 'ARRAY') {
106 $args->{$key} = [] unless defined $args->{$key};
107 unless (ref $args->{$key} eq 'ARRAY') {
108 $args->{$key} = [$args->{$key}]
109 }
110 push @{$args->{$key}},
111 ref $new_args{$key} eq 'ARRAY'
112 ? @{$new_args{$key}}
113 : $new_args{$key};
114 }
115 elsif ($makemaker_argtype{$key} eq 'HASH') {
116 $args->{$key} = {} unless defined $args->{$key};
117 foreach my $skey (keys %{ $new_args{$key} }) {
118 $args->{$key}{$skey} = $new_args{$key}{$skey};
119 }
120 }
121 elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
122 $self->makemaker_append($key => $new_args{$key});
123 }
124 }
125 else {
126 if (defined $args->{$key}) {
127 warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
128 }
129 $args->{$key} = $new_args{$key};
130 }
131 }
132 return $args;
133 }
134
135 # For mm args that take multiple space-separated args,
136 # append an argument to the current list.
137 sub makemaker_append {
138 my $self = shift;
139 my $name = shift;
140 my $args = $self->makemaker_args;
141 $args->{$name} = defined $args->{$name}
142 ? join( ' ', $args->{$name}, @_ )
143 : join( ' ', @_ );
144 }
145
146 sub build_subdirs {
147 my $self = shift;
148 my $subdirs = $self->makemaker_args->{DIR} ||= [];
149 for my $subdir (@_) {
150 push @$subdirs, $subdir;
151 }
152 }
153
154 sub clean_files {
155 my $self = shift;
156 my $clean = $self->makemaker_args->{clean} ||= {};
157 %$clean = (
158 %$clean,
159 FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
160 );
161 }
162
163 sub realclean_files {
164 my $self = shift;
165 my $realclean = $self->makemaker_args->{realclean} ||= {};
166 %$realclean = (
167 %$realclean,
168 FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
169 );
170 }
171
172 sub libs {
173 my $self = shift;
174 my $libs = ref $_[0] ? shift : [ shift ];
175 $self->makemaker_args( LIBS => $libs );
176 }
177
178 sub inc {
179 my $self = shift;
180 $self->makemaker_args( INC => shift );
181 }
182
183 sub _wanted_t {
184 }
185
186 sub tests_recursive {
187 my $self = shift;
188 my $dir = shift || 't';
189 unless ( -d $dir ) {
190 die "tests_recursive dir '$dir' does not exist";
191 }
192 my %tests = map { $_ => 1 } split / /, ($self->tests || '');
193 require File::Find;
194 File::Find::find(
195 sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
196 $dir
197 );
198 $self->tests( join ' ', sort keys %tests );
199 }
200
201 sub write {
202 my $self = shift;
203 die "&Makefile->write() takes no arguments\n" if @_;
204
205 # Check the current Perl version
206 my $perl_version = $self->perl_version;
207 if ( $perl_version ) {
208 eval "use $perl_version; 1"
209 or die "ERROR: perl: Version $] is installed, "
210 . "but we need version >= $perl_version";
211 }
212
213 # Make sure we have a new enough MakeMaker
214 require ExtUtils::MakeMaker;
215
216 if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
217 # This previous attempted to inherit the version of
218 # ExtUtils::MakeMaker in use by the module author, but this
219 # was found to be untenable as some authors build releases
220 # using future dev versions of EU:MM that nobody else has.
221 # Instead, #toolchain suggests we use 6.59 which is the most
222 # stable version on CPAN at time of writing and is, to quote
223 # ribasushi, "not terminally fucked, > and tested enough".
224 # TODO: We will now need to maintain this over time to push
225 # the version up as new versions are released.
226 $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
227 $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
228 } else {
229 # Allow legacy-compatibility with 5.005 by depending on the
230 # most recent EU:MM that supported 5.005.
231 $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
232 $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
233 }
234
235 # Generate the MakeMaker params
236 my $args = $self->makemaker_args;
237 $args->{DISTNAME} = $self->name;
238 $args->{NAME} = $self->module_name || $self->name;
239 $args->{NAME} =~ s/-/::/g;
240 $args->{VERSION} = $self->version or die <<'EOT';
241 ERROR: Can't determine distribution version. Please specify it
242 explicitly via 'version' in Makefile.PL, or set a valid $VERSION
243 in a module, and provide its file path via 'version_from' (or
244 'all_from' if you prefer) in Makefile.PL.
245 EOT
246
247 if ( $self->tests ) {
248 my @tests = split ' ', $self->tests;
249 my %seen;
250 $args->{test} = {
251 TESTS => (join ' ', grep {!$seen{$_}++} @tests),
252 };
253 } elsif ( $Module::Install::ExtraTests::use_extratests ) {
254 # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
255 # So, just ignore our xt tests here.
256 } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
257 $args->{test} = {
258 TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
259 };
260 }
261 if ( $] >= 5.005 ) {
262 $args->{ABSTRACT} = $self->abstract;
263 $args->{AUTHOR} = join ', ', @{$self->author || []};
264 }
265 if ( $self->makemaker(6.10) ) {
266 $args->{NO_META} = 1;
267 #$args->{NO_MYMETA} = 1;
268 }
269 if ( $self->makemaker(6.17) and $self->sign ) {
270 $args->{SIGN} = 1;
271 }
272 unless ( $self->is_admin ) {
273 delete $args->{SIGN};
274 }
275 if ( $self->makemaker(6.31) and $self->license ) {
276 $args->{LICENSE} = $self->license;
277 }
278
279 my $prereq = ($args->{PREREQ_PM} ||= {});
280 %$prereq = ( %$prereq,
281 map { @$_ } # flatten [module => version]
282 map { @$_ }
283 grep $_,
284 ($self->requires)
285 );
286
287 # Remove any reference to perl, PREREQ_PM doesn't support it
288 delete $args->{PREREQ_PM}->{perl};
289
290 # Merge both kinds of requires into BUILD_REQUIRES
291 my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
292 %$build_prereq = ( %$build_prereq,
293 map { @$_ } # flatten [module => version]
294 map { @$_ }
295 grep $_,
296 ($self->configure_requires, $self->build_requires)
297 );
298
299 # Remove any reference to perl, BUILD_REQUIRES doesn't support it
300 delete $args->{BUILD_REQUIRES}->{perl};
301
302 # Delete bundled dists from prereq_pm, add it to Makefile DIR
303 my $subdirs = ($args->{DIR} || []);
304 if ($self->bundles) {
305 my %processed;
306 foreach my $bundle (@{ $self->bundles }) {
307 my ($mod_name, $dist_dir) = @$bundle;
308 delete $prereq->{$mod_name};
309 $dist_dir = File::Basename::basename($dist_dir); # dir for building this module
310 if (not exists $processed{$dist_dir}) {
311 if (-d $dist_dir) {
312 # List as sub-directory to be processed by make
313 push @$subdirs, $dist_dir;
314 }
315 # Else do nothing: the module is already present on the system
316 $processed{$dist_dir} = undef;
317 }
318 }
319 }
320
321 unless ( $self->makemaker('6.55_03') ) {
322 %$prereq = (%$prereq,%$build_prereq);
323 delete $args->{BUILD_REQUIRES};
324 }
325
326 if ( my $perl_version = $self->perl_version ) {
327 eval "use $perl_version; 1"
328 or die "ERROR: perl: Version $] is installed, "
329 . "but we need version >= $perl_version";
330
331 if ( $self->makemaker(6.48) ) {
332 $args->{MIN_PERL_VERSION} = $perl_version;
333 }
334 }
335
336 if ($self->installdirs) {
337 warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
338 $args->{INSTALLDIRS} = $self->installdirs;
339 }
340
341 my %args = map {
342 ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
343 } keys %$args;
344
345 my $user_preop = delete $args{dist}->{PREOP};
346 if ( my $preop = $self->admin->preop($user_preop) ) {
347 foreach my $key ( keys %$preop ) {
348 $args{dist}->{$key} = $preop->{$key};
349 }
350 }
351
352 my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
353 $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
354 }
355
356 sub fix_up_makefile {
357 my $self = shift;
358 my $makefile_name = shift;
359 my $top_class = ref($self->_top) || '';
360 my $top_version = $self->_top->VERSION || '';
361
362 my $preamble = $self->preamble
363 ? "# Preamble by $top_class $top_version\n"
364 . $self->preamble
365 : '';
366 my $postamble = "# Postamble by $top_class $top_version\n"
367 . ($self->postamble || '');
368
369 local *MAKEFILE;
370 open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
371 eval { flock MAKEFILE, LOCK_EX };
372 my $makefile = do { local $/; <MAKEFILE> };
373
374 $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
375 $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
376 $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
377 $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
378 $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
379
380 # Module::Install will never be used to build the Core Perl
381 # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
382 # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
383 $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
384 #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
385
386 # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
387 $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
388
389 # XXX - This is currently unused; not sure if it breaks other MM-users
390 # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
391
392 seek MAKEFILE, 0, SEEK_SET;
393 truncate MAKEFILE, 0;
394 print MAKEFILE "$preamble$makefile$postamble" or die $!;
395 close MAKEFILE or die $!;
396
397 1;
398 }
399
400 sub preamble {
401 my ($self, $text) = @_;
402 $self->{preamble} = $text . $self->{preamble} if defined $text;
403 $self->{preamble};
404 }
405
406 sub postamble {
407 my ($self, $text) = @_;
408 $self->{postamble} ||= $self->admin->postamble;
409 $self->{postamble} .= $text if defined $text;
410 $self->{postamble}
411 }
412
413 1;
414
415 __END__
416
417 #line 544
+722
-0
inc/Module/Install/Metadata.pm less more
0 #line 1
1 package Module::Install::Metadata;
2
3 use strict 'vars';
4 use Module::Install::Base ();
5
6 use vars qw{$VERSION @ISA $ISCORE};
7 BEGIN {
8 $VERSION = '1.14';
9 @ISA = 'Module::Install::Base';
10 $ISCORE = 1;
11 }
12
13 my @boolean_keys = qw{
14 sign
15 };
16
17 my @scalar_keys = qw{
18 name
19 module_name
20 abstract
21 version
22 distribution_type
23 tests
24 installdirs
25 };
26
27 my @tuple_keys = qw{
28 configure_requires
29 build_requires
30 requires
31 recommends
32 bundles
33 resources
34 };
35
36 my @resource_keys = qw{
37 homepage
38 bugtracker
39 repository
40 };
41
42 my @array_keys = qw{
43 keywords
44 author
45 };
46
47 *authors = \&author;
48
49 sub Meta { shift }
50 sub Meta_BooleanKeys { @boolean_keys }
51 sub Meta_ScalarKeys { @scalar_keys }
52 sub Meta_TupleKeys { @tuple_keys }
53 sub Meta_ResourceKeys { @resource_keys }
54 sub Meta_ArrayKeys { @array_keys }
55
56 foreach my $key ( @boolean_keys ) {
57 *$key = sub {
58 my $self = shift;
59 if ( defined wantarray and not @_ ) {
60 return $self->{values}->{$key};
61 }
62 $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
63 return $self;
64 };
65 }
66
67 foreach my $key ( @scalar_keys ) {
68 *$key = sub {
69 my $self = shift;
70 return $self->{values}->{$key} if defined wantarray and !@_;
71 $self->{values}->{$key} = shift;
72 return $self;
73 };
74 }
75
76 foreach my $key ( @array_keys ) {
77 *$key = sub {
78 my $self = shift;
79 return $self->{values}->{$key} if defined wantarray and !@_;
80 $self->{values}->{$key} ||= [];
81 push @{$self->{values}->{$key}}, @_;
82 return $self;
83 };
84 }
85
86 foreach my $key ( @resource_keys ) {
87 *$key = sub {
88 my $self = shift;
89 unless ( @_ ) {
90 return () unless $self->{values}->{resources};
91 return map { $_->[1] }
92 grep { $_->[0] eq $key }
93 @{ $self->{values}->{resources} };
94 }
95 return $self->{values}->{resources}->{$key} unless @_;
96 my $uri = shift or die(
97 "Did not provide a value to $key()"
98 );
99 $self->resources( $key => $uri );
100 return 1;
101 };
102 }
103
104 foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
105 *$key = sub {
106 my $self = shift;
107 return $self->{values}->{$key} unless @_;
108 my @added;
109 while ( @_ ) {
110 my $module = shift or last;
111 my $version = shift || 0;
112 push @added, [ $module, $version ];
113 }
114 push @{ $self->{values}->{$key} }, @added;
115 return map {@$_} @added;
116 };
117 }
118
119 # Resource handling
120 my %lc_resource = map { $_ => 1 } qw{
121 homepage
122 license
123 bugtracker
124 repository
125 };
126
127 sub resources {
128 my $self = shift;
129 while ( @_ ) {
130 my $name = shift or last;
131 my $value = shift or next;
132 if ( $name eq lc $name and ! $lc_resource{$name} ) {
133 die("Unsupported reserved lowercase resource '$name'");
134 }
135 $self->{values}->{resources} ||= [];
136 push @{ $self->{values}->{resources} }, [ $name, $value ];
137 }
138 $self->{values}->{resources};
139 }
140
141 # Aliases for build_requires that will have alternative
142 # meanings in some future version of META.yml.
143 sub test_requires { shift->build_requires(@_) }
144 sub install_requires { shift->build_requires(@_) }
145
146 # Aliases for installdirs options
147 sub install_as_core { $_[0]->installdirs('perl') }
148 sub install_as_cpan { $_[0]->installdirs('site') }
149 sub install_as_site { $_[0]->installdirs('site') }
150 sub install_as_vendor { $_[0]->installdirs('vendor') }
151
152 sub dynamic_config {
153 my $self = shift;
154 my $value = @_ ? shift : 1;
155 if ( $self->{values}->{dynamic_config} ) {
156 # Once dynamic we never change to static, for safety
157 return 0;
158 }
159 $self->{values}->{dynamic_config} = $value ? 1 : 0;
160 return 1;
161 }
162
163 # Convenience command
164 sub static_config {
165 shift->dynamic_config(0);
166 }
167
168 sub perl_version {
169 my $self = shift;
170 return $self->{values}->{perl_version} unless @_;
171 my $version = shift or die(
172 "Did not provide a value to perl_version()"
173 );
174
175 # Normalize the version
176 $version = $self->_perl_version($version);
177
178 # We don't support the really old versions
179 unless ( $version >= 5.005 ) {
180 die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
181 }
182
183 $self->{values}->{perl_version} = $version;
184 }
185
186 sub all_from {
187 my ( $self, $file ) = @_;
188
189 unless ( defined($file) ) {
190 my $name = $self->name or die(
191 "all_from called with no args without setting name() first"
192 );
193 $file = join('/', 'lib', split(/-/, $name)) . '.pm';
194 $file =~ s{.*/}{} unless -e $file;
195 unless ( -e $file ) {
196 die("all_from cannot find $file from $name");
197 }
198 }
199 unless ( -f $file ) {
200 die("The path '$file' does not exist, or is not a file");
201 }
202
203 $self->{values}{all_from} = $file;
204
205 # Some methods pull from POD instead of code.
206 # If there is a matching .pod, use that instead
207 my $pod = $file;
208 $pod =~ s/\.pm$/.pod/i;
209 $pod = $file unless -e $pod;
210
211 # Pull the different values
212 $self->name_from($file) unless $self->name;
213 $self->version_from($file) unless $self->version;
214 $self->perl_version_from($file) unless $self->perl_version;
215 $self->author_from($pod) unless @{$self->author || []};
216 $self->license_from($pod) unless $self->license;
217 $self->abstract_from($pod) unless $self->abstract;
218
219 return 1;
220 }
221
222 sub provides {
223 my $self = shift;
224 my $provides = ( $self->{values}->{provides} ||= {} );
225 %$provides = (%$provides, @_) if @_;
226 return $provides;
227 }
228
229 sub auto_provides {
230 my $self = shift;
231 return $self unless $self->is_admin;
232 unless (-e 'MANIFEST') {
233 warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
234 return $self;
235 }
236 # Avoid spurious warnings as we are not checking manifest here.
237 local $SIG{__WARN__} = sub {1};
238 require ExtUtils::Manifest;
239 local *ExtUtils::Manifest::manicheck = sub { return };
240
241 require Module::Build;
242 my $build = Module::Build->new(
243 dist_name => $self->name,
244 dist_version => $self->version,
245 license => $self->license,
246 );
247 $self->provides( %{ $build->find_dist_packages || {} } );
248 }
249
250 sub feature {
251 my $self = shift;
252 my $name = shift;
253 my $features = ( $self->{values}->{features} ||= [] );
254 my $mods;
255
256 if ( @_ == 1 and ref( $_[0] ) ) {
257 # The user used ->feature like ->features by passing in the second
258 # argument as a reference. Accomodate for that.
259 $mods = $_[0];
260 } else {
261 $mods = \@_;
262 }
263
264 my $count = 0;
265 push @$features, (
266 $name => [
267 map {
268 ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
269 } @$mods
270 ]
271 );
272
273 return @$features;
274 }
275
276 sub features {
277 my $self = shift;
278 while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
279 $self->feature( $name, @$mods );
280 }
281 return $self->{values}->{features}
282 ? @{ $self->{values}->{features} }
283 : ();
284 }
285
286 sub no_index {
287 my $self = shift;
288 my $type = shift;
289 push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
290 return $self->{values}->{no_index};
291 }
292
293 sub read {
294 my $self = shift;
295 $self->include_deps( 'YAML::Tiny', 0 );
296
297 require YAML::Tiny;
298 my $data = YAML::Tiny::LoadFile('META.yml');
299
300 # Call methods explicitly in case user has already set some values.
301 while ( my ( $key, $value ) = each %$data ) {
302 next unless $self->can($key);
303 if ( ref $value eq 'HASH' ) {
304 while ( my ( $module, $version ) = each %$value ) {
305 $self->can($key)->($self, $module => $version );
306 }
307 } else {
308 $self->can($key)->($self, $value);
309 }
310 }
311 return $self;
312 }
313
314 sub write {
315 my $self = shift;
316 return $self unless $self->is_admin;
317 $self->admin->write_meta;
318 return $self;
319 }
320
321 sub version_from {
322 require ExtUtils::MM_Unix;
323 my ( $self, $file ) = @_;
324 $self->version( ExtUtils::MM_Unix->parse_version($file) );
325
326 # for version integrity check
327 $self->makemaker_args( VERSION_FROM => $file );
328 }
329
330 sub abstract_from {
331 require ExtUtils::MM_Unix;
332 my ( $self, $file ) = @_;
333 $self->abstract(
334 bless(
335 { DISTNAME => $self->name },
336 'ExtUtils::MM_Unix'
337 )->parse_abstract($file)
338 );
339 }
340
341 # Add both distribution and module name
342 sub name_from {
343 my ($self, $file) = @_;
344 if (
345 Module::Install::_read($file) =~ m/
346 ^ \s*
347 package \s*
348 ([\w:]+)
349 [\s|;]*
350 /ixms
351 ) {
352 my ($name, $module_name) = ($1, $1);
353 $name =~ s{::}{-}g;
354 $self->name($name);
355 unless ( $self->module_name ) {
356 $self->module_name($module_name);
357 }
358 } else {
359 die("Cannot determine name from $file\n");
360 }
361 }
362
363 sub _extract_perl_version {
364 if (
365 $_[0] =~ m/
366 ^\s*
367 (?:use|require) \s*
368 v?
369 ([\d_\.]+)
370 \s* ;
371 /ixms
372 ) {
373 my $perl_version = $1;
374 $perl_version =~ s{_}{}g;
375 return $perl_version;
376 } else {
377 return;
378 }
379 }
380
381 sub perl_version_from {
382 my $self = shift;
383 my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
384 if ($perl_version) {
385 $self->perl_version($perl_version);
386 } else {
387 warn "Cannot determine perl version info from $_[0]\n";
388 return;
389 }
390 }
391
392 sub author_from {
393 my $self = shift;
394 my $content = Module::Install::_read($_[0]);
395 if ($content =~ m/
396 =head \d \s+ (?:authors?)\b \s*
397 ([^\n]*)
398 |
399 =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
400 .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
401 ([^\n]*)
402 /ixms) {
403 my $author = $1 || $2;
404
405 # XXX: ugly but should work anyway...
406 if (eval "require Pod::Escapes; 1") {
407 # Pod::Escapes has a mapping table.
408 # It's in core of perl >= 5.9.3, and should be installed
409 # as one of the Pod::Simple's prereqs, which is a prereq
410 # of Pod::Text 3.x (see also below).
411 $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
412 {
413 defined $2
414 ? chr($2)
415 : defined $Pod::Escapes::Name2character_number{$1}
416 ? chr($Pod::Escapes::Name2character_number{$1})
417 : do {
418 warn "Unknown escape: E<$1>";
419 "E<$1>";
420 };
421 }gex;
422 }
423 elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
424 # Pod::Text < 3.0 has yet another mapping table,
425 # though the table name of 2.x and 1.x are different.
426 # (1.x is in core of Perl < 5.6, 2.x is in core of
427 # Perl < 5.9.3)
428 my $mapping = ($Pod::Text::VERSION < 2)
429 ? \%Pod::Text::HTML_Escapes
430 : \%Pod::Text::ESCAPES;
431 $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
432 {
433 defined $2
434 ? chr($2)
435 : defined $mapping->{$1}
436 ? $mapping->{$1}
437 : do {
438 warn "Unknown escape: E<$1>";
439 "E<$1>";
440 };
441 }gex;
442 }
443 else {
444 $author =~ s{E<lt>}{<}g;
445 $author =~ s{E<gt>}{>}g;
446 }
447 $self->author($author);
448 } else {
449 warn "Cannot determine author info from $_[0]\n";
450 }
451 }
452
453 #Stolen from M::B
454 my %license_urls = (
455 perl => 'http://dev.perl.org/licenses/',
456 apache => 'http://apache.org/licenses/LICENSE-2.0',
457 apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
458 artistic => 'http://opensource.org/licenses/artistic-license.php',
459 artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
460 lgpl => 'http://opensource.org/licenses/lgpl-license.php',
461 lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
462 lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
463 bsd => 'http://opensource.org/licenses/bsd-license.php',
464 gpl => 'http://opensource.org/licenses/gpl-license.php',
465 gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
466 gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
467 mit => 'http://opensource.org/licenses/mit-license.php',
468 mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
469 open_source => undef,
470 unrestricted => undef,
471 restrictive => undef,
472 unknown => undef,
473 );
474
475 sub license {
476 my $self = shift;
477 return $self->{values}->{license} unless @_;
478 my $license = shift or die(
479 'Did not provide a value to license()'
480 );
481 $license = __extract_license($license) || lc $license;
482 $self->{values}->{license} = $license;
483
484 # Automatically fill in license URLs
485 if ( $license_urls{$license} ) {
486 $self->resources( license => $license_urls{$license} );
487 }
488
489 return 1;
490 }
491
492 sub _extract_license {
493 my $pod = shift;
494 my $matched;
495 return __extract_license(
496 ($matched) = $pod =~ m/
497 (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
498 (=head \d.*|=cut.*|)\z
499 /xms
500 ) || __extract_license(
501 ($matched) = $pod =~ m/
502 (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
503 (=head \d.*|=cut.*|)\z
504 /xms
505 );
506 }
507
508 sub __extract_license {
509 my $license_text = shift or return;
510 my @phrases = (
511 '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
512 '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
513 'Artistic and GPL' => 'perl', 1,
514 'GNU general public license' => 'gpl', 1,
515 'GNU public license' => 'gpl', 1,
516 'GNU lesser general public license' => 'lgpl', 1,
517 'GNU lesser public license' => 'lgpl', 1,
518 'GNU library general public license' => 'lgpl', 1,
519 'GNU library public license' => 'lgpl', 1,
520 'GNU Free Documentation license' => 'unrestricted', 1,
521 'GNU Affero General Public License' => 'open_source', 1,
522 '(?:Free)?BSD license' => 'bsd', 1,
523 'Artistic license 2\.0' => 'artistic_2', 1,
524 'Artistic license' => 'artistic', 1,
525 'Apache (?:Software )?license' => 'apache', 1,
526 'GPL' => 'gpl', 1,
527 'LGPL' => 'lgpl', 1,
528 'BSD' => 'bsd', 1,
529 'Artistic' => 'artistic', 1,
530 'MIT' => 'mit', 1,
531 'Mozilla Public License' => 'mozilla', 1,
532 'Q Public License' => 'open_source', 1,
533 'OpenSSL License' => 'unrestricted', 1,
534 'SSLeay License' => 'unrestricted', 1,
535 'zlib License' => 'open_source', 1,
536 'proprietary' => 'proprietary', 0,
537 );
538 while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
539 $pattern =~ s#\s+#\\s+#gs;
540 if ( $license_text =~ /\b$pattern\b/i ) {
541 return $license;
542 }
543 }
544 return '';
545 }
546
547 sub license_from {
548 my $self = shift;
549 if (my $license=_extract_license(Module::Install::_read($_[0]))) {
550 $self->license($license);
551 } else {
552 warn "Cannot determine license info from $_[0]\n";
553 return 'unknown';
554 }
555 }
556
557 sub _extract_bugtracker {
558 my @links = $_[0] =~ m#L<(
559 https?\Q://rt.cpan.org/\E[^>]+|
560 https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
561 https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
562 )>#gx;
563 my %links;
564 @links{@links}=();
565 @links=keys %links;
566 return @links;
567 }
568
569 sub bugtracker_from {
570 my $self = shift;
571 my $content = Module::Install::_read($_[0]);
572 my @links = _extract_bugtracker($content);
573 unless ( @links ) {
574 warn "Cannot determine bugtracker info from $_[0]\n";
575 return 0;
576 }
577 if ( @links > 1 ) {
578 warn "Found more than one bugtracker link in $_[0]\n";
579 return 0;
580 }
581
582 # Set the bugtracker
583 bugtracker( $links[0] );
584 return 1;
585 }
586
587 sub requires_from {
588 my $self = shift;
589 my $content = Module::Install::_readperl($_[0]);
590 my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
591 while ( @requires ) {
592 my $module = shift @requires;
593 my $version = shift @requires;
594 $self->requires( $module => $version );
595 }
596 }
597
598 sub test_requires_from {
599 my $self = shift;
600 my $content = Module::Install::_readperl($_[0]);
601 my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
602 while ( @requires ) {
603 my $module = shift @requires;
604 my $version = shift @requires;
605 $self->test_requires( $module => $version );
606 }
607 }
608
609 # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
610 # numbers (eg, 5.006001 or 5.008009).
611 # Also, convert double-part versions (eg, 5.8)
612 sub _perl_version {
613 my $v = $_[-1];
614 $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
615 $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
616 $v =~ s/(\.\d\d\d)000$/$1/;
617 $v =~ s/_.+$//;
618 if ( ref($v) ) {
619 # Numify
620 $v = $v + 0;
621 }
622 return $v;
623 }
624
625 sub add_metadata {
626 my $self = shift;
627 my %hash = @_;
628 for my $key (keys %hash) {
629 warn "add_metadata: $key is not prefixed with 'x_'.\n" .
630 "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
631 $self->{values}->{$key} = $hash{$key};
632 }
633 }
634
635
636 ######################################################################
637 # MYMETA Support
638
639 sub WriteMyMeta {
640 die "WriteMyMeta has been deprecated";
641 }
642
643 sub write_mymeta_yaml {
644 my $self = shift;
645
646 # We need YAML::Tiny to write the MYMETA.yml file
647 unless ( eval { require YAML::Tiny; 1; } ) {
648 return 1;
649 }
650
651 # Generate the data
652 my $meta = $self->_write_mymeta_data or return 1;
653
654 # Save as the MYMETA.yml file
655 print "Writing MYMETA.yml\n";
656 YAML::Tiny::DumpFile('MYMETA.yml', $meta);
657 }
658
659 sub write_mymeta_json {
660 my $self = shift;
661
662 # We need JSON to write the MYMETA.json file
663 unless ( eval { require JSON; 1; } ) {
664 return 1;
665 }
666
667 # Generate the data
668 my $meta = $self->_write_mymeta_data or return 1;
669
670 # Save as the MYMETA.yml file
671 print "Writing MYMETA.json\n";
672 Module::Install::_write(
673 'MYMETA.json',
674 JSON->new->pretty(1)->canonical->encode($meta),
675 );
676 }
677
678 sub _write_mymeta_data {
679 my $self = shift;
680
681 # If there's no existing META.yml there is nothing we can do
682 return undef unless -f 'META.yml';
683
684 # We need Parse::CPAN::Meta to load the file
685 unless ( eval { require Parse::CPAN::Meta; 1; } ) {
686 return undef;
687 }
688
689 # Merge the perl version into the dependencies
690 my $val = $self->Meta->{values};
691 my $perl = delete $val->{perl_version};
692 if ( $perl ) {
693 $val->{requires} ||= [];
694 my $requires = $val->{requires};
695
696 # Canonize to three-dot version after Perl 5.6
697 if ( $perl >= 5.006 ) {
698 $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
699 }
700 unshift @$requires, [ perl => $perl ];
701 }
702
703 # Load the advisory META.yml file
704 my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
705 my $meta = $yaml[0];
706
707 # Overwrite the non-configure dependency hashes
708 delete $meta->{requires};
709 delete $meta->{build_requires};
710 delete $meta->{recommends};
711 if ( exists $val->{requires} ) {
712 $meta->{requires} = { map { @$_ } @{ $val->{requires} } };
713 }
714 if ( exists $val->{build_requires} ) {
715 $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
716 }
717
718 return $meta;
719 }
720
721 1;
+64
-0
inc/Module/Install/Win32.pm less more
0 #line 1
1 package Module::Install::Win32;
2
3 use strict;
4 use Module::Install::Base ();
5
6 use vars qw{$VERSION @ISA $ISCORE};
7 BEGIN {
8 $VERSION = '1.14';
9 @ISA = 'Module::Install::Base';
10 $ISCORE = 1;
11 }
12
13 # determine if the user needs nmake, and download it if needed
14 sub check_nmake {
15 my $self = shift;
16 $self->load('can_run');
17 $self->load('get_file');
18
19 require Config;
20 return unless (
21 $^O eq 'MSWin32' and
22 $Config::Config{make} and
23 $Config::Config{make} =~ /^nmake\b/i and
24 ! $self->can_run('nmake')
25 );
26
27 print "The required 'nmake' executable not found, fetching it...\n";
28
29 require File::Basename;
30 my $rv = $self->get_file(
31 url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
32 ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
33 local_dir => File::Basename::dirname($^X),
34 size => 51928,
35 run => 'Nmake15.exe /o > nul',
36 check_for => 'Nmake.exe',
37 remove => 1,
38 );
39
40 die <<'END_MESSAGE' unless $rv;
41
42 -------------------------------------------------------------------------------
43
44 Since you are using Microsoft Windows, you will need the 'nmake' utility
45 before installation. It's available at:
46
47 http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
48 or
49 ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
50
51 Please download the file manually, save it to a directory in %PATH% (e.g.
52 C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
53 that directory, and run "Nmake15.exe" from there; that will create the
54 'nmake.exe' file needed by this module.
55
56 You may then resume the installation process described in README.
57
58 -------------------------------------------------------------------------------
59 END_MESSAGE
60
61 }
62
63 1;
+63
-0
inc/Module/Install/WriteAll.pm less more
0 #line 1
1 package Module::Install::WriteAll;
2
3 use strict;
4 use Module::Install::Base ();
5
6 use vars qw{$VERSION @ISA $ISCORE};
7 BEGIN {
8 $VERSION = '1.14';
9 @ISA = qw{Module::Install::Base};
10 $ISCORE = 1;
11 }
12
13 sub WriteAll {
14 my $self = shift;
15 my %args = (
16 meta => 1,
17 sign => 0,
18 inline => 0,
19 check_nmake => 1,
20 @_,
21 );
22
23 $self->sign(1) if $args{sign};
24 $self->admin->WriteAll(%args) if $self->is_admin;
25
26 $self->check_nmake if $args{check_nmake};
27 unless ( $self->makemaker_args->{PL_FILES} ) {
28 # XXX: This still may be a bit over-defensive...
29 unless ($self->makemaker(6.25)) {
30 $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
31 }
32 }
33
34 # Until ExtUtils::MakeMaker support MYMETA.yml, make sure
35 # we clean it up properly ourself.
36 $self->realclean_files('MYMETA.yml');
37
38 if ( $args{inline} ) {
39 $self->Inline->write;
40 } else {
41 $self->Makefile->write;
42 }
43
44 # The Makefile write process adds a couple of dependencies,
45 # so write the META.yml files after the Makefile.
46 if ( $args{meta} ) {
47 $self->Meta->write;
48 }
49
50 # Experimental support for MYMETA
51 if ( $ENV{X_MYMETA} ) {
52 if ( $ENV{X_MYMETA} eq 'JSON' ) {
53 $self->Meta->write_mymeta_json;
54 } else {
55 $self->Meta->write_mymeta_yaml;
56 }
57 }
58
59 return 1;
60 }
61
62 1;
+474
-0
inc/Module/Install.pm less more
0 #line 1
1 package Module::Install;
2
3 # For any maintainers:
4 # The load order for Module::Install is a bit magic.
5 # It goes something like this...
6 #
7 # IF ( host has Module::Install installed, creating author mode ) {
8 # 1. Makefile.PL calls "use inc::Module::Install"
9 # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
10 # 3. The installed version of inc::Module::Install loads
11 # 4. inc::Module::Install calls "require Module::Install"
12 # 5. The ./inc/ version of Module::Install loads
13 # } ELSE {
14 # 1. Makefile.PL calls "use inc::Module::Install"
15 # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
16 # 3. The ./inc/ version of Module::Install loads
17 # }
18
19 use 5.006;
20 use strict 'vars';
21 use Cwd ();
22 use File::Find ();
23 use File::Path ();
24
25 use vars qw{$VERSION $MAIN};
26 BEGIN {
27 # All Module::Install core packages now require synchronised versions.
28 # This will be used to ensure we don't accidentally load old or
29 # different versions of modules.
30 # This is not enforced yet, but will be some time in the next few
31 # releases once we can make sure it won't clash with custom
32 # Module::Install extensions.
33 $VERSION = '1.14';
34
35 # Storage for the pseudo-singleton
36 $MAIN = undef;
37
38 *inc::Module::Install::VERSION = *VERSION;
39 @inc::Module::Install::ISA = __PACKAGE__;
40
41 }
42
43 sub import {
44 my $class = shift;
45 my $self = $class->new(@_);
46 my $who = $self->_caller;
47
48 #-------------------------------------------------------------
49 # all of the following checks should be included in import(),
50 # to allow "eval 'require Module::Install; 1' to test
51 # installation of Module::Install. (RT #51267)
52 #-------------------------------------------------------------
53
54 # Whether or not inc::Module::Install is actually loaded, the
55 # $INC{inc/Module/Install.pm} is what will still get set as long as
56 # the caller loaded module this in the documented manner.
57 # If not set, the caller may NOT have loaded the bundled version, and thus
58 # they may not have a MI version that works with the Makefile.PL. This would
59 # result in false errors or unexpected behaviour. And we don't want that.
60 my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
61 unless ( $INC{$file} ) { die <<"END_DIE" }
62
63 Please invoke ${\__PACKAGE__} with:
64
65 use inc::${\__PACKAGE__};
66
67 not:
68
69 use ${\__PACKAGE__};
70
71 END_DIE
72
73 # This reportedly fixes a rare Win32 UTC file time issue, but
74 # as this is a non-cross-platform XS module not in the core,
75 # we shouldn't really depend on it. See RT #24194 for detail.
76 # (Also, this module only supports Perl 5.6 and above).
77 eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
78
79 # If the script that is loading Module::Install is from the future,
80 # then make will detect this and cause it to re-run over and over
81 # again. This is bad. Rather than taking action to touch it (which
82 # is unreliable on some platforms and requires write permissions)
83 # for now we should catch this and refuse to run.
84 if ( -f $0 ) {
85 my $s = (stat($0))[9];
86
87 # If the modification time is only slightly in the future,
88 # sleep briefly to remove the problem.
89 my $a = $s - time;
90 if ( $a > 0 and $a < 5 ) { sleep 5 }
91
92 # Too far in the future, throw an error.
93 my $t = time;
94 if ( $s > $t ) { die <<"END_DIE" }
95
96 Your installer $0 has a modification time in the future ($s > $t).
97
98 This is known to create infinite loops in make.
99
100 Please correct this, then run $0 again.
101
102 END_DIE
103 }
104
105
106 # Build.PL was formerly supported, but no longer is due to excessive
107 # difficulty in implementing every single feature twice.
108 if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
109
110 Module::Install no longer supports Build.PL.
111
112 It was impossible to maintain duel backends, and has been deprecated.
113
114 Please remove all Build.PL files and only use the Makefile.PL installer.
115
116 END_DIE
117
118 #-------------------------------------------------------------
119
120 # To save some more typing in Module::Install installers, every...
121 # use inc::Module::Install
122 # ...also acts as an implicit use strict.
123 $^H |= strict::bits(qw(refs subs vars));
124
125 #-------------------------------------------------------------
126
127 unless ( -f $self->{file} ) {
128 foreach my $key (keys %INC) {
129 delete $INC{$key} if $key =~ /Module\/Install/;
130 }
131
132 local $^W;
133 require "$self->{path}/$self->{dispatch}.pm";
134 File::Path::mkpath("$self->{prefix}/$self->{author}");
135 $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
136 $self->{admin}->init;
137 @_ = ($class, _self => $self);
138 goto &{"$self->{name}::import"};
139 }
140
141 local $^W;
142 *{"${who}::AUTOLOAD"} = $self->autoload;
143 $self->preload;
144
145 # Unregister loader and worker packages so subdirs can use them again
146 delete $INC{'inc/Module/Install.pm'};
147 delete $INC{'Module/Install.pm'};
148
149 # Save to the singleton
150 $MAIN = $self;
151
152 return 1;
153 }
154
155 sub autoload {
156 my $self = shift;
157 my $who = $self->_caller;
158 my $cwd = Cwd::getcwd();
159 my $sym = "${who}::AUTOLOAD";
160 $sym->{$cwd} = sub {
161 my $pwd = Cwd::getcwd();
162 if ( my $code = $sym->{$pwd} ) {
163 # Delegate back to parent dirs
164 goto &$code unless $cwd eq $pwd;
165 }
166 unless ($$sym =~ s/([^:]+)$//) {
167 # XXX: it looks like we can't retrieve the missing function
168 # via $$sym (usually $main::AUTOLOAD) in this case.
169 # I'm still wondering if we should slurp Makefile.PL to
170 # get some context or not ...
171 my ($package, $file, $line) = caller;
172 die <<"EOT";
173 Unknown function is found at $file line $line.
174 Execution of $file aborted due to runtime errors.
175
176 If you're a contributor to a project, you may need to install
177 some Module::Install extensions from CPAN (or other repository).
178 If you're a user of a module, please contact the author.
179 EOT
180 }
181 my $method = $1;
182 if ( uc($method) eq $method ) {
183 # Do nothing
184 return;
185 } elsif ( $method =~ /^_/ and $self->can($method) ) {
186 # Dispatch to the root M:I class
187 return $self->$method(@_);
188 }
189
190 # Dispatch to the appropriate plugin
191 unshift @_, ( $self, $1 );
192 goto &{$self->can('call')};
193 };
194 }
195
196 sub preload {
197 my $self = shift;
198 unless ( $self->{extensions} ) {
199 $self->load_extensions(
200 "$self->{prefix}/$self->{path}", $self
201 );
202 }
203
204 my @exts = @{$self->{extensions}};
205 unless ( @exts ) {
206 @exts = $self->{admin}->load_all_extensions;
207 }
208
209 my %seen;
210 foreach my $obj ( @exts ) {
211 while (my ($method, $glob) = each %{ref($obj) . '::'}) {
212 next unless $obj->can($method);
213 next if $method =~ /^_/;
214 next if $method eq uc($method);
215 $seen{$method}++;
216 }
217 }
218
219 my $who = $self->_caller;
220 foreach my $name ( sort keys %seen ) {
221 local $^W;
222 *{"${who}::$name"} = sub {
223 ${"${who}::AUTOLOAD"} = "${who}::$name";
224 goto &{"${who}::AUTOLOAD"};
225 };
226 }
227 }
228
229 sub new {
230 my ($class, %args) = @_;
231
232 delete $INC{'FindBin.pm'};
233 {
234 # to suppress the redefine warning
235 local $SIG{__WARN__} = sub {};
236 require FindBin;
237 }
238
239 # ignore the prefix on extension modules built from top level.
240 my $base_path = Cwd::abs_path($FindBin::Bin);
241 unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) {
242 delete $args{prefix};
243 }
244 return $args{_self} if $args{_self};
245
246 $args{dispatch} ||= 'Admin';
247 $args{prefix} ||= 'inc';
248 $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
249 $args{bundle} ||= 'inc/BUNDLES';
250 $args{base} ||= $base_path;
251 $class =~ s/^\Q$args{prefix}\E:://;
252 $args{name} ||= $class;
253 $args{version} ||= $class->VERSION;
254 unless ( $args{path} ) {
255 $args{path} = $args{name};
256 $args{path} =~ s!::!/!g;
257 }
258 $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
259 $args{wrote} = 0;
260
261 bless( \%args, $class );
262 }
263
264 sub call {
265 my ($self, $method) = @_;
266 my $obj = $self->load($method) or return;
267 splice(@_, 0, 2, $obj);
268 goto &{$obj->can($method)};
269 }
270
271 sub load {
272 my ($self, $method) = @_;
273
274 $self->load_extensions(
275 "$self->{prefix}/$self->{path}", $self
276 ) unless $self->{extensions};
277
278 foreach my $obj (@{$self->{extensions}}) {
279 return $obj if $obj->can($method);
280 }
281
282 my $admin = $self->{admin} or die <<"END_DIE";
283 The '$method' method does not exist in the '$self->{prefix}' path!
284 Please remove the '$self->{prefix}' directory and run $0 again to load it.
285 END_DIE
286
287 my $obj = $admin->load($method, 1);
288 push @{$self->{extensions}}, $obj;
289
290 $obj;
291 }
292
293 sub load_extensions {
294 my ($self, $path, $top) = @_;
295
296 my $should_reload = 0;
297 unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
298 unshift @INC, $self->{prefix};
299 $should_reload = 1;
300 }
301
302 foreach my $rv ( $self->find_extensions($path) ) {
303 my ($file, $pkg) = @{$rv};
304 next if $self->{pathnames}{$pkg};
305
306 local $@;
307 my $new = eval { local $^W; require $file; $pkg->can('new') };
308 unless ( $new ) {
309 warn $@ if $@;
310 next;
311 }
312 $self->{pathnames}{$pkg} =
313 $should_reload ? delete $INC{$file} : $INC{$file};
314 push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
315 }
316
317 $self->{extensions} ||= [];
318 }
319
320 sub find_extensions {
321 my ($self, $path) = @_;
322
323 my @found;
324 File::Find::find( sub {
325 my $file = $File::Find::name;
326 return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
327 my $subpath = $1;
328 return if lc($subpath) eq lc($self->{dispatch});
329
330 $file = "$self->{path}/$subpath.pm";
331 my $pkg = "$self->{name}::$subpath";
332 $pkg =~ s!/!::!g;
333
334 # If we have a mixed-case package name, assume case has been preserved
335 # correctly. Otherwise, root through the file to locate the case-preserved
336 # version of the package name.
337 if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
338 my $content = Module::Install::_read($subpath . '.pm');
339 my $in_pod = 0;
340 foreach ( split /\n/, $content ) {
341 $in_pod = 1 if /^=\w/;
342 $in_pod = 0 if /^=cut/;
343 next if ($in_pod || /^=cut/); # skip pod text
344 next if /^\s*#/; # and comments
345 if ( m/^\s*package\s+($pkg)\s*;/i ) {
346 $pkg = $1;
347 last;
348 }
349 }
350 }
351
352 push @found, [ $file, $pkg ];
353 }, $path ) if -d $path;
354
355 @found;
356 }
357
358
359
360
361
362 #####################################################################
363 # Common Utility Functions
364
365 sub _caller {
366 my $depth = 0;
367 my $call = caller($depth);
368 while ( $call eq __PACKAGE__ ) {
369 $depth++;
370 $call = caller($depth);
371 }
372 return $call;
373 }
374
375 # Done in evals to avoid confusing Perl::MinimumVersion
376 eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
377 sub _read {
378 local *FH;
379 open( FH, '<', $_[0] ) or die "open($_[0]): $!";
380 binmode FH;
381 my $string = do { local $/; <FH> };
382 close FH or die "close($_[0]): $!";
383 return $string;
384 }
385 END_NEW
386 sub _read {
387 local *FH;
388 open( FH, "< $_[0]" ) or die "open($_[0]): $!";
389 binmode FH;
390 my $string = do { local $/; <FH> };
391 close FH or die "close($_[0]): $!";
392 return $string;
393 }
394 END_OLD
395
396 sub _readperl {
397 my $string = Module::Install::_read($_[0]);
398 $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
399 $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
400 $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
401 return $string;
402 }
403
404 sub _readpod {
405 my $string = Module::Install::_read($_[0]);
406 $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
407 return $string if $_[0] =~ /\.pod\z/;
408 $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
409 $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
410 $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
411 $string =~ s/^\n+//s;
412 return $string;
413 }
414
415 # Done in evals to avoid confusing Perl::MinimumVersion
416 eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
417 sub _write {
418 local *FH;
419 open( FH, '>', $_[0] ) or die "open($_[0]): $!";
420 binmode FH;
421 foreach ( 1 .. $#_ ) {
422 print FH $_[$_] or die "print($_[0]): $!";
423 }
424 close FH or die "close($_[0]): $!";
425 }
426 END_NEW
427 sub _write {
428 local *FH;
429 open( FH, "> $_[0]" ) or die "open($_[0]): $!";
430 binmode FH;
431 foreach ( 1 .. $#_ ) {
432 print FH $_[$_] or die "print($_[0]): $!";
433 }
434 close FH or die "close($_[0]): $!";
435 }
436 END_OLD
437
438 # _version is for processing module versions (eg, 1.03_05) not
439 # Perl versions (eg, 5.8.1).
440 sub _version {
441 my $s = shift || 0;
442 my $d =()= $s =~ /(\.)/g;
443 if ( $d >= 2 ) {
444 # Normalise multipart versions
445 $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
446 }
447 $s =~ s/^(\d+)\.?//;
448 my $l = $1 || 0;
449 my @v = map {
450 $_ . '0' x (3 - length $_)
451 } $s =~ /(\d{1,3})\D?/g;
452 $l = $l . '.' . join '', @v if @v;
453 return $l + 0;
454 }
455
456 sub _cmp {
457 _version($_[1]) <=> _version($_[2]);
458 }
459
460 # Cloned from Params::Util::_CLASS
461 sub _CLASS {
462 (
463 defined $_[0]
464 and
465 ! ref $_[0]
466 and
467 $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
468 ) ? $_[0] : undef;
469 }
470
471 1;
472
473 # Copyright 2008 - 2012 Adam Kennedy.
+52
-0
lib/CHI/Driver/Redis/t/CHIDriverTests.pm less more
0 package CHI::Driver::Redis::t::CHIDriverTests;
1 use strict;
2 use warnings;
3 use CHI::Test;
4
5 use base qw(CHI::t::Driver);
6
7 use Test::Mock::Redis;
8
9 sub testing_driver_class { 'CHI::Driver::Redis' }
10
11 sub supports_expires_on_backend { 1 }
12
13 sub new_cache_options {
14 my $self = shift;
15
16 return (
17 $self->SUPER::new_cache_options(),
18 driver_class => 'CHI::Driver::Redis',
19 redis_class => (defined $ENV{CHI_REDIS_SERVER} ? 'Redis' : 'Test::Mock::Redis'),
20 server => $ENV{CHI_REDIS_SERVER} || undef,
21 ($ENV{CHI_REDIS_PASSWORD} ? ( password => $ENV{CHI_REDIS_PASSWORD} ) : ()),
22 prefix => 'test' . $$ . ':',
23 );
24 }
25
26 sub clear_redis : Test(setup) {
27 my ($self) = @_;
28
29 my $cache = $self->new_cache;
30 $cache->redis->flushall;
31 }
32
33 sub test_redis_object : Tests(1) {
34 my $self = shift;
35 my $cache = $self->new_cache(redis => Test::Mock::Redis->new());
36 $cache->clear();
37 }
38
39 sub test_redis_options : Tests(1) {
40 my $self = shift;
41 my $cache = $self->new_cache(redis_options => { reconnect => 2 });
42 $cache->clear();
43 }
44
45 sub test_extra_options : Tests(1) {
46 my $self = shift;
47 my $cache = $self->new_cache(reconnect => 2);
48 $cache->clear();
49 }
50
51 1;
+227
-0
lib/CHI/Driver/Redis.pm less more
0 package CHI::Driver::Redis;
1
2 use Moo;
3 use Redis;
4 use URI::Escape qw(uri_escape uri_unescape);
5
6 extends 'CHI::Driver';
7
8 our $VERSION = '0.09';
9
10 has 'redis' => (
11 is => 'ro',
12 lazy => 1,
13 builder => '_build_redis',
14 );
15
16 has 'redis_options' => (
17 is => 'rw',
18 default => sub { {} },
19 );
20
21 has 'redis_class' => (
22 is => 'ro',
23 default => 'Redis',
24 );
25
26 has 'prefix'=> (
27 is => 'ro',
28 default => '',
29 );
30
31 sub BUILD {
32 my ($self, $params) = @_;
33 foreach my $param (qw/redis redis_class redis_options prefix/) {
34 if (exists $params->{$param}) {
35 delete $params->{$param};
36 }
37 }
38 my %options = (
39 server => '127.0.0.1:6379',
40 encoding => undef,
41 %{ $self->redis_options() },
42 %{ $self->non_common_constructor_params($params) },
43 );
44 $self->redis_options(\%options);
45 }
46
47 sub _build_redis {
48 my ($self) = @_;
49 return $self->redis_class()->new(%{ $self->redis_options() });
50 }
51
52 sub fetch {
53 my ($self, $key) = @_;
54
55 my $eskey = uri_escape($key);
56 my $realkey = $self->prefix . $self->namespace . '||' . $eskey;
57 my $val = $self->redis->get($realkey);
58 return $val;
59 }
60
61 sub fetch_multi_hashref {
62 my ($self, $keys) = @_;
63
64 return unless scalar(@{ $keys });
65
66 my $ns = $self->prefix . $self->namespace;
67
68 my @keys;
69 foreach my $k (@$keys) {
70 my $esk = uri_escape($k);
71 my $key = $ns . '||' . $esk;
72 push @keys, $key;
73 }
74
75 my @vals = $self->redis->mget(@keys);
76
77 my $count = 0;
78 my %resp;
79 foreach my $k (@$keys) {
80 $resp{$k} = $vals[$count];
81 $count++;
82 }
83
84 return \%resp;
85 }
86
87 sub get_keys {
88 my ($self) = @_;
89
90 my @keys = $self->redis->smembers($self->prefix . $self->namespace);
91
92 my @unesckeys = ();
93
94 foreach my $k (@keys) {
95 # Getting an empty key here for some reason...
96 next unless defined $k;
97 push(@unesckeys, uri_unescape($k));
98 }
99 return @unesckeys;
100 }
101
102 sub get_namespaces {
103 my ($self) = @_;
104
105 return $self->redis->smembers($self->prefix . 'chinamespaces');
106 }
107
108 sub remove {
109 my ($self, $key) = @_;
110
111 return unless defined($key);
112
113 my $ns = $self->prefix . $self->namespace;
114
115 my $skey = uri_escape($key);
116
117 $self->redis->srem($ns, $skey);
118 $self->redis->del($ns . '||' . $skey);
119 }
120
121 sub store {
122 my ($self, $key, $data, $expires_in) = @_;
123
124 my $ns = $self->prefix . $self->namespace;
125
126 my $skey = uri_escape($key);
127 my $realkey = $ns . '||' . $skey;
128
129 $self->redis->sadd($self->prefix . 'chinamespaces', $self->namespace);
130 $self->redis->sadd($ns, $skey);
131 $self->redis->set($realkey, $data);
132
133 if (defined($expires_in)) {
134 $self->redis->expire($realkey, $expires_in);
135 }
136 }
137
138 sub clear {
139 my ($self) = @_;
140
141 my $ns = $self->prefix . $self->namespace;
142 my @keys = $self->redis->smembers($ns);
143
144 foreach my $k (@keys) {
145 $self->redis->srem($ns, $k);
146 $self->redis->del($ns . '||' . $k);
147 }
148 }
149
150 1;
151
152 __END__
153
154 =head1 NAME
155
156 CHI::Driver::Redis - Redis driver for CHI
157
158 =head1 SYNOPSIS
159
160 use CHI;
161
162 my $foo = CHI->new(
163 driver => 'Redis',
164 namespace => 'foo',
165 server => '127.0.0.1:6379',
166 debug => 0
167 );
168
169 =head1 DESCRIPTION
170
171 A CHI driver that uses C<Redis> to store the data. Care has been taken to
172 not have this module fail in fiery ways if the cache is unavailable. It is my
173 hope that if it is failing and the cache is not required for your work, you
174 can ignore it's warnings.
175
176 =head1 TECHNICAL DETAILS
177
178 =head2 Namespaces.
179
180 Redis does not have namespaces. Therefore, we have to do some hoop-jumping.
181
182 Namespaces are tracked in a set named C<chinamespaces>. This is a list of all
183 the namespaces the driver has seen.
184
185 Keys in a namespace are stored in a set that shares the name of the namespace.
186 The actual value is stored as "$namespace||key".
187
188 =head2 Encoding
189
190 This CHI driver uses Redis.pm. Redis.pm by default automatically
191 encodes values to UTF-8. This driver sets the Redis encoding option
192 to undef to disable automatic encoding.
193
194 =back
195
196 =head1 CONSTRUCTOR OPTIONS
197
198 C<redis> option for constructed C<Redis> object.
199
200 C<redis_options> for hash of optios to C<Redis> constructor
201
202 Other options, including C<server>, C<debug>, and C<password> are passed to C<Redis> constructor.
203
204 =head1 ATTRIBUTES
205
206 =head2 redis
207
208 Contains the underlying C<Redis> object.
209
210 =head1 AUTHOR
211
212 Cory G Watson, C<< <gphat at cpan.org> >>
213
214 =head1 CONTRIBUTORS
215
216 Ian Burrell, C<< <iburrell@cpan.org> >>
217
218 =head1 COPYRIGHT & LICENSE
219
220 Copyright 2009 Cold Hard Code, LLC.
221
222 This program is free software; you can redistribute it and/or modify it
223 under the terms of either: the GNU General Public License as published
224 by the Free Software Foundation; or the Artistic License.
225
226 See http://dev.perl.org/licenses/ for more information.
+8
-0
t/CHI-driver-tests.t less more
0 #!perl -w
1 use strict;
2 use warnings;
3 use CHI::Driver::Redis::t::CHIDriverTests;
4
5 use Test::More;
6
7 CHI::Driver::Redis::t::CHIDriverTests->runtests;