+++ /dev/null
-Matt S Trout <mst@shadowcat.co.uk>
+use strict;
+use warnings FATAL => 'all';
use ExtUtils::MakeMaker;
+(do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml';
+
WriteMakefile(
NAME => 'strictures',
VERSION_FROM => 'lib/strictures.pm',
ABSTRACT_FROM => 'lib/strictures.pm',
- AUTHOR => do { local (@ARGV) = 'AUTHOR'; <> },
+ AUTHOR => 'Matt S Trout <mst@shadowcat.co.uk>',
LICENSE => 'perl',
);
};
if ($do_indirect) {
if (eval { require indirect; 1 }) {
- indirect->unimport('FATAL');
+ indirect->unimport(':fatal');
} else {
die "strictures.pm extra testing active but couldn't load indirect.pm: $@";
}
will continue to only introduce the current set of strictures even if 2.0 is
installed.
+
+=head1 METHODS
+
+=head2 import
+
+This method does the setup work described above in L</DESCRIPTION>
+
+=head2 VERSION
+
+This method traps the strictures->VERSION(1) call produced by a use line
+with a version number on it and does the version check.
+
+=head1 COMMUNITY AND SUPPORT
+
+=head2 IRC channel
+
+irc.perl.org #toolchain
+
+(or bug 'mst' in query on there or freenode)
+
+=head2 Git repository
+
+Gitweb is on http://git.shadowcat.co.uk/ and the clone URL is:
+
+ git clone git://git.shadowcat.co.uk/p5sagit/strictures.git
+
+=head1 AUTHOR
+
+Matt S. Trout <mst@shadowcat.co.uk>
+
+=head1 CONTRIBUTORS
+
+None required yet. Maybe this module is perfect (hahahahaha ...).
+
+=head1 COPYRIGHT
+
+Copyright (c) 2010 the strictures L</AUTHOR> and L</CONTRIBUTORS>
+as listed above.
+
+=head1 LICENSE
+
+This library is free software and may be distributed under the same terms
+as perl itself.
+
+=cut
--- /dev/null
+use strict;
+use warnings FATAL => 'all';
+
+{
+ package MY;
+
+ {
+ no warnings 'once'; push @ExtUtils::MakeMaker::Overridable, 'find_tests';
+ }
+
+ sub find_tests {
+ shift->SUPER::find_tests.' xt/*.t';
+ }
+
+ sub postamble { 'include maint/Makefile.include' }
+}
+
+{
+ no warnings 'redefine';
+ sub WriteMakefile {
+ my %args = @_;
+ ExtUtils::MakeMaker::WriteMakefile(
+ %args,
+ AUTHOR => 'Matt S Trout <mst@shadowcat.co.uk>',
+ ABSTRACT_FROM => $args{VERSION_FROM},
+ );
+ }
+}
+
+sub manifest_include {
+ use autodie;
+ my @files = @_;
+ my @parts;
+ while (my ($dir, $spec) = splice(@files, 0, 2)) {
+ my $re = ($dir ? $dir.'/' : '').
+ ((ref($spec) eq 'Regexp')
+ ? $spec
+ : !ref($spec)
+ ? ".*\Q${spec}\E"
+ : die "spec must be string or regexp, was: ${spec} (${\ref $spec})");
+ push @parts, $re;
+ }
+ my $final = '^(?!'.join('|', map "${_}\$", @parts).')';
+ open my $skip, '>', 'MANIFEST.SKIP';
+ print $skip "${final}\n";
+ close $skip;
+}
+
+manifest_include(
+ 'lib' => '.pm',
+ 't' => '.t',
+ 't/lib' => '.pm',
+ 'xt' => '.t',
+ 'xt/lib' => '.pm',
+ '' => '.PL',
+ '' => qr{Changes|MANIFEST|README|META\.yml},
+ 'maint' => qr{[^.].*},
+);
+
+1;
--- /dev/null
+bump:
+ maint/bump-version
+ rm Makefile
+bumpminor:
+ maint/bump-version minor
+ rm Makefile
+bumpmajor:
+ maint/bump-version major
+ rm Makefile
+upload: $(DISTVNAME).tar$(SUFFIX)
+ cpan-upload $<
--- /dev/null
+#!/usr/bin/env perl
+
+use 5.010;
+use strict;
+use warnings FATAL => 'all';
+use autodie;
+
+chomp(my $LATEST = qx(grep '^[0-9]' Changes | head -1 | awk '{print \$1}'));
+
+my @parts = split /\./, $LATEST;
+
+my $OLD_DECIMAL = sprintf('%i.%03i%03i', @parts);
+
+my %bump_part = (major => 0, minor => 1, bugfix => 2);
+
+my $bump_this =
+ $bump_part{$ARGV[0]||'bugfix'}
+ // die "no idea which part to bump - $ARGV[0] means nothing to me";
+
+my @new_parts = @parts;
+
+$new_parts[$bump_this]++;
+
+my $NEW_DECIMAL = sprintf('%i.%03i%03i', @new_parts);
+
+warn "Bumping $OLD_DECIMAL -> $NEW_DECIMAL\n";
+
+my $PM_FILE = 'lib/Module/Metadata.pm';
+
+my $file = do { local (@ARGV, $/) = ($PM_FILE); <> };
+
+$file =~ s/(?<=\$VERSION = ')${\quotemeta $OLD_DECIMAL}/${NEW_DECIMAL}/;
+
+open my $out, '>', $PM_FILE;
+
+print $out $file;
--- /dev/null
+use Test::More qw(no_plan);
+
+our (@us, @expect);
+
+sub capture_stuff { [ $^H, ${^WARNING_BITS} ] }
+
+sub capture_us { push @us, capture_stuff }
+sub capture_expect { push @expect, capture_stuff }
+
+{
+ use strictures 1;
+ BEGIN { capture_us }
+}
+
+{
+ use strict;
+ use warnings FATAL => 'all';
+ BEGIN { capture_expect }
+}
+
+# I'm assuming here we'll have more cases later. maybe not. eh.
+
+foreach my $idx (0 .. $#us) {
+ is($us[$idx][0], $expect[$idx][0], 'Hints ok for case '.($idx+1));
+ is($us[$idx][1], $expect[$idx][1], 'Warnings ok for case '.($idx+1));
+}
+
+{
+ local $0 = 't/00load.t';
+ sub Foo::new { 1 }
+ my $r = eval q{
+ use strictures 1;
+ new Foo 1, 2, 3;
+ };
+ # I don't test $@ here since if indirect isn't installed we hit one
+ # error and if it is we hit another; it's enough the code path's hit.
+ ok(!$r, 'strictures blows up for t/00load.t');
+}
+
+ok(!eval q{use strictures 2; 1; }, "Can't use strictures 2 (this is version 1)");
--- /dev/null
+use Test::More;
+use Test::Pod;
+use Test::Pod::Coverage;
+use strict;
+use warnings FATAL => 'all';
+
+# the all_ things attempt to plan, which we didn't want, so stop them
+# from doing that
+no warnings 'redefine';
+local *Test::Builder::plan = sub { };
+
+all_pod_files_ok;
+all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::CountParents' });
+
+done_testing;