Test-Spelling-0.20/000755 000765 000024 00000000000 12414767470 014571 5ustar00sartakstaff000000 000000 Test-Spelling-0.20/Changes000644 000765 000024 00000005715 12414767300 016064 0ustar00sartakstaff000000 000000 Revision history for Test-Spelling 0.20 2014-10-07 - Add a sorted list of your most commonly misspelled words to the end of all_pod_files_spelling_ok to aid stopword list creation and bulk correction. (Kent Fredric) 0.19 2013-05-05 - for more consistent results avoid using the user's local aspell dictionary [rt.cpan.org #84869] (Karen Etheridge) 0.18 2013-04-26 - Work around Pod::Spell limitations (David Golden) - Improve case handling (David Golden) - Improve test failure reporting (Karen Etheridge) - Include more useful info in Test-Spelling's own test suite (Shawn Moore) 0.17 2012-01-27 - Use IPC::Run3 instead of IPC::Open3 Quoth IPC::Open3: If you try to read from the child's stdout writer and their stderr writer, you'll have problems with blocking ... This is very dangerous, as you may block forever. Also the code is nicely shorter. (Randy Stauner) 0.16 2012-12-20 - Allow use of a custom POD parser rather than Pod::Spell using set_pod_parser (Thomas Sibley) 0.15 2011-08-22 - Begin adding actual tests (Hilariously, adding the suggested t/pod-spell.t to this dist to test itself found a typo: "stopwards") 0.14 2011-05-27 - Fix an error when using add_stopwords("constant", "strings") [rt.cpan.org #68471] (reported by Nicholas Bamber) 0.13 2011-04-27 - Make alternatives checking more robust by reading the spellchecker's STDERR 0.12 2011-04-25 - Best Practical has taken over maintainership of this module - Try various spellcheck programs instead of hardcoding the ancient `spell` [rt.cpan.org #56483] (reported by Lars Dɪᴇᴄᴋᴏᴡ, et al) - Remove temporary files more aggressively [rt.cpan.org #41586] (reported by Tokuhiro Matsuno) - fixed by not creating them at all :) instead we now use IPC::Open3 - Remove suggestion to use broken `aspell -l` [rt.cpan.org #28967] (reported by David Hand) - Add set_pod_file_filter for skipping translations, etc. [rt.cpan.org #63755] (reported by me :)) - Skip tests in all_pod_files_spelling_ok if there is no working spellchecker - Provide a has_working_spellchecker so you can skip your own tests if there's no working spellchecker - Switch to Module::Install - Rewrite and modernize a lot of the documentation - Decruftify code, such as by using Exporter and lexical filehandles - Support .plx files (you're welcome Schwern) 0.11 2005-11-15 - Some documentation fixes. - Added note about per-file stopwords by Chris Dolan. - Use a temporary file instead of open2() to solve win32 portability issues. (Thanks to Chris Laco!) 0.10 2005-08-02 - First version Test-Spelling-0.20/inc/000755 000765 000024 00000000000 12414767470 015342 5ustar00sartakstaff000000 000000 Test-Spelling-0.20/lib/000755 000765 000024 00000000000 12414767470 015337 5ustar00sartakstaff000000 000000 Test-Spelling-0.20/Makefile.PL000644 000765 000024 00000000577 12414767163 016553 0ustar00sartakstaff000000 000000 use inc::Module::Install; use Module::Install::GithubMeta; use Module::Install::ManifestSkip; use Module::Install::AutoManifest; name 'Test-Spelling'; all_from 'lib/Test/Spelling.pm'; githubmeta; requires 'Pod::Spell' => '1.01'; requires 'IPC::Run3' => '0.044'; test_requires 'Test::More' => '0.88'; test_requires 'Test::Tester'; manifest_skip; auto_manifest; WriteAll; Test-Spelling-0.20/MANIFEST000644 000765 000024 00000001066 12414767470 015725 0ustar00sartakstaff000000 000000 Changes inc/Module/Install.pm inc/Module/Install/AutoManifest.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/GithubMeta.pm inc/Module/Install/Makefile.pm inc/Module/Install/ManifestSkip.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Test/Spelling.pm Makefile.PL MANIFEST This list of files META.yml README t/basic.t t/corpus/bad-pod.pm t/corpus/good-pod.pm t/corpus/no-pod.pm t/corpus/stopword.pm t/fake_checker.t t/load.t t/pod-spell.t t/pod.t t/stopword.t Test-Spelling-0.20/META.yml000644 000765 000024 00000001340 12414767440 016035 0ustar00sartakstaff000000 000000 --- abstract: 'check for spelling errors in POD files' author: - ', Ivan Tubert-Brohman, All Rights Reserved.' build_requires: ExtUtils::MakeMaker: 6.59 Test::More: 0.88 Test::Tester: 0 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Test-Spelling no_index: directory: - inc - t requires: IPC::Run3: 0.044 Pod::Spell: 1.01 perl: 5.6.0 resources: homepage: https://github.com/sartak/test-spelling/tree license: http://dev.perl.org/licenses/ repository: git://github.com/sartak/test-spelling.git version: 0.20 Test-Spelling-0.20/README000644 000765 000024 00000014151 12414767163 015452 0ustar00sartakstaff000000 000000 NAME Test::Spelling - check for spelling errors in POD files SYNOPSIS use Test::More; BEGIN { plan skip_all => "Spelling tests only for authors" unless -d 'inc/.author'; } use Test::Spelling; all_pod_files_spelling_ok(); DESCRIPTION "Test::Spelling" lets you check the spelling of a POD file, and report its results in standard "Test::More" fashion. This module requires a spellcheck program such as spell, aspell, ispell, or hunspell. use Test::Spelling; pod_file_spelling_ok('lib/Foo/Bar.pm', 'POD file spelling OK'); Note that it is a bad idea to run spelling tests during an ordinary CPAN distribution install, or in a package that will run in an uncontrolled environment. There is no way of predicting whether the word list or spellcheck program used will give the same results. You can include the test in your distribution, but be sure to run it only for authors of the module by guarding it in a "skip_all unless -d 'inc/.author'" clause, or by putting the test in your distribution's xt/ directory. Anyway, people installing your module really do not need to run such tests, as it is unlikely that the documentation will acquire typos while in transit. :-) You can add your own stopwords, which are words that should be ignored by the spell check, like so: add_stopwords(qw(asdf thiswordiscorrect)); Adding stopwards in this fashion affects all files checked for the remainder of the test script. See Pod::Spell (which this module is built upon) for a variety of ways to add per-file stopwords to each .pm file. If you have a lot of stopwords, it's useful to put them in your test file's "DATA" section like so: use Test::Spelling; add_stopwords(); all_pod_files_spelling_ok(); __END__ folksonomy Jifty Zakirov To maintain backwards compatibility, comment markers and some whitespace are ignored. In the near future, the preprocessing we do on the arguments to add_stopwords will be changed and documented properly. FUNCTIONS all_pod_files_spelling_ok( [@files/@directories] ) Checks all the files for POD spelling. It gathers all_pod_files() on each file/directory, and declares a "plan" in Test::More for you (one test for each file), so you must not call "plan" yourself. If @files is empty, the function finds all POD files in the blib directory if it exists, or the lib directory if it does not. A POD file is one that ends with .pod, .pl, .plx, or .pm; or any file where the first line looks like a perl shebang line. If there is no working spellchecker (determined by "has_working_spellchecker"), this test will issue a "skip all" directive. If you're testing a distribution, just create a t/pod-spell.t with the code in the "SYNOPSIS". Returns true if every POD file has correct spelling, or false if any of them fail. This function will show any spelling errors as diagnostics. pod_file_spelling_ok( FILENAME[, TESTNAME ] ) "pod_file_spelling_ok" will test that the given POD file has no spelling errors. When it fails, "pod_file_spelling_ok" will show any spelling errors as diagnostics. The optional second argument TESTNAME is the name of the test. If it is omitted, "pod_file_spelling_ok" chooses a default test name "POD spelling for FILENAME". all_pod_files( [@dirs] ) Returns a list of all the Perl files in each directory and its subdirectories, recursively. If no directories are passed, it defaults to blib if blib exists, or else lib if not. Skips any files in CVS or .svn directories. A Perl file is: * Any file that ends in .PL, .pl, .plx, .pm, .pod or .t. * Any file that has a first line with a shebang and "perl" on it. Furthermore, files for which the filter set by "set_pod_file_filter" return false are skipped. By default, this filter passes everything through. The order of the files returned is machine-dependent. If you want them sorted, you'll have to sort them yourself. add_stopwords(@words) Add words that should be skipped by the spellcheck. Note that Pod::Spell already skips words believed to be code, such as everything in verbatim (indented) blocks and code marked up with "...", as well as some common Perl jargon. has_working_spellchecker "has_working_spellchecker" will return "undef" if there is no working spellchecker, or a true value (the spellchecker command itself) if there is. The module performs a dry-run to determine whether any of the spellcheckers it can will use work on the current system. You can use this to skip tests if there is no spellchecker. Note that "all_pod_files_spelling_ok" will do this for you. set_spell_cmd($command) If you want to force this module to use a particular spellchecker, then you can specify which one with "set_spell_cmd". This is useful to ensure a more consistent lexicon between developers, or if you have an unusual environment. Any command that takes text from standard input and prints a list of misspelled words, one per line, to standard output will do. set_pod_file_filter($code) If your project has POD documents written in languages other than English, then obviously you don't want to be running a spellchecker on every Perl file. "set_pod_file_filter" lets you filter out files returned from "all_pod_files" (and hence, the documents tested by "all_pod_files_spelling_ok"). set_pod_file_filter(sub { my $filename = shift; return 0 if $filename =~ /_ja.pod$/; # skip Japanese translations return 1; }); SEE ALSO Pod::Spell ORIGINAL AUTHOR Ivan Tubert-Brohman "" Heavily based on Test::Pod by Andy Lester and brian d foy. MAINTAINER Shawn M Moore "" COPYRIGHT Copyright 2005, Ivan Tubert-Brohman, All Rights Reserved. You may use, modify, and distribute this package under the same terms as Perl itself. Test-Spelling-0.20/t/000755 000765 000024 00000000000 12414767470 015034 5ustar00sartakstaff000000 000000 Test-Spelling-0.20/t/basic.t000644 000765 000024 00000001233 12414767163 016300 0ustar00sartakstaff000000 000000 use Test::Tester; use Test::More; use Test::Spelling; BEGIN { if (!has_working_spellchecker()) { plan skip_all => "no working spellchecker found"; } } check_test(sub { pod_file_spelling_ok('t/corpus/no-pod.pm', 'no pod has no errors') }, { ok => 1, name => 'no pod has no errors', }); check_test(sub { pod_file_spelling_ok('t/corpus/good-pod.pm', 'good pod has no errors') }, { ok => 1, name => 'good pod has no errors', }); check_test(sub { pod_file_spelling_ok('t/corpus/bad-pod.pm', 'bad pod has no errors') }, { ok => 0, name => 'bad pod has no errors', diag => "Errors:\n incorectly", }); done_testing; Test-Spelling-0.20/t/corpus/000755 000765 000024 00000000000 12414767470 016347 5ustar00sartakstaff000000 000000 Test-Spelling-0.20/t/fake_checker.t000644 000765 000024 00000002162 12414767163 017613 0ustar00sartakstaff000000 000000 use Test::Tester; use Test::More; use Test::Spelling; # Use perl to fake a working spell checker # so we can test module portability even where no spell checker is present. my $spell_cmd = $^X . q< -e "print STDERR q[FOOBAR]">; set_spell_cmd($spell_cmd); is eval { pod_file_spelling_ok('t/corpus/bad-pod.pm', 'expect STDERR'); 1 }, undef, 'spell check died'; like $@, qr/Unable to find a working spellchecker:\n Unable to run '\Q$spell_cmd\E': spellchecker had errors: FOOBAR/, 'died with text found on STDERR'; my $badword = 'Xzaue'; $spell_cmd = $^X . qq< -ane "print grep { /$badword/i } \@F">; set_spell_cmd($spell_cmd); check_test(sub { pod_file_spelling_ok('t/corpus/good-pod.pm', 'no mistakes') }, { ok => 1, name => 'no mistakes', }); check_test(sub { pod_file_spelling_ok('t/corpus/stopword.pm', 'found misspelled word') }, { ok => 0, name => 'found misspelled word', diag => "Errors:\n $badword", }); add_stopwords(lc $badword); check_test(sub { pod_file_spelling_ok('t/corpus/stopword.pm', 'used stopword') }, { ok => 1, name => 'used stopword', }); done_testing; Test-Spelling-0.20/t/load.t000644 000765 000024 00000000513 12414767163 016136 0ustar00sartakstaff000000 000000 use Test::More tests=>1; BEGIN { use_ok( 'Test::Spelling' ); } if (my $checker = Test::Spelling::has_working_spellchecker()) { diag "Test::Spelling found a spellchecker: $checker"; } else { diag "Test::Spelling did not find a spellchecker. Please make sure you have spell, aspell, ispell, or hunspell installed."; } Test-Spelling-0.20/t/pod-spell.t000644 000765 000024 00000000413 12414767163 017115 0ustar00sartakstaff000000 000000 use Test::More; BEGIN { plan skip_all => "Spelling tests only for authors" unless -d 'inc/.author'; } use Test::Spelling; add_stopwords(); all_pod_files_spelling_ok(); __END__ Brohman CPAN Tubert brian foy preprocessing spellcheck subdirectories Test-Spelling-0.20/t/pod.t000644 000765 000024 00000000201 12414767163 015773 0ustar00sartakstaff000000 000000 use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Test-Spelling-0.20/t/stopword.t000644 000765 000024 00000001016 12414767163 017077 0ustar00sartakstaff000000 000000 use Test::Tester; use Test::More; use Test::Spelling; BEGIN { if (!has_working_spellchecker()) { plan skip_all => "no working spellchecker found"; } } check_test(sub { pod_file_spelling_ok('t/corpus/stopword.pm', 'stopword pod file') }, { ok => 0, name => 'stopword pod file', diag => "Errors:\n Xzaue", }); add_stopwords('xzaue'); check_test(sub { pod_file_spelling_ok('t/corpus/stopword.pm', 'stopword pod file') }, { ok => 1, name => 'stopword pod file', }); done_testing; Test-Spelling-0.20/t/corpus/bad-pod.pm000644 000765 000024 00000000174 12414767163 020214 0ustar00sartakstaff000000 000000 package Bad::Pod; use strict; use warnings; sub foo {} 1; __END__ =head1 NAME Bad::Pod - incorectly spelled POD =END Test-Spelling-0.20/t/corpus/good-pod.pm000644 000765 000024 00000000175 12414767163 020417 0ustar00sartakstaff000000 000000 package Good::Pod; use strict; use warnings; sub foo {} 1; __END__ =head1 NAME Good::Pod - correctly spelled POD =END Test-Spelling-0.20/t/corpus/no-pod.pm000644 000765 000024 00000000105 12414767163 020074 0ustar00sartakstaff000000 000000 package No::Pod; use strict; use warnings; sub foo {} 1; __END__ Test-Spelling-0.20/t/corpus/stopword.pm000644 000765 000024 00000000231 12414767163 020561 0ustar00sartakstaff000000 000000 package Stopword::Pod; use strict; use warnings; sub foo {} 1; __END__ =head1 NAME Stopword::Pod - correctly spelled POD and a Xzaue creator =END Test-Spelling-0.20/lib/Test/000755 000765 000024 00000000000 12414767470 016256 5ustar00sartakstaff000000 000000 Test-Spelling-0.20/lib/Test/Spelling.pm000644 000765 000024 00000030624 12414767453 020377 0ustar00sartakstaff000000 000000 package Test::Spelling; use 5.006; use strict; use warnings; use base 'Exporter'; use Pod::Spell; use Test::Builder; use Text::Wrap; use File::Spec; use IPC::Run3; use Symbol 'gensym'; our $VERSION = '0.20'; our @EXPORT = qw( pod_file_spelling_ok all_pod_files_spelling_ok add_stopwords set_spell_cmd all_pod_files set_pod_file_filter has_working_spellchecker set_pod_parser ); my $TEST = Test::Builder->new; my $SPELLCHECKER; my $FILE_FILTER = sub { 1 }; my $POD_PARSER; our %ALL_WORDS; sub spellchecker_candidates { # if they've specified a spellchecker, use only that one return $SPELLCHECKER if $SPELLCHECKER; return ( 'spell', # for back-compat, this is the top candidate ... 'aspell list -l en -p /dev/null', # ... but this should become first soon 'ispell -l', 'hunspell -l', ); } sub has_working_spellchecker { my $dryrun_results = _get_spellcheck_results("dry run", 1); if (ref $dryrun_results) { return; } return $SPELLCHECKER; } sub _get_spellcheck_results { my $document = shift; my $dryrun = shift; my @errors; for my $spellchecker (spellchecker_candidates()) { my @words; my $ok = eval { my ($spellcheck_results, $errors); IPC::Run3::run3($spellchecker, \$document, \$spellcheck_results, \$errors); @words = split /\n/, $spellcheck_results; die "spellchecker had errors: $errors" if length $errors; 1; }; if ($ok) { # remember the one we used, so that it's consistent for all the files # this run, and we don't keep retrying the same spellcheckers that will # never work. also we need to expose the spellchecker we're using in # has_working_spellchecker set_spell_cmd($spellchecker) if !$SPELLCHECKER; return @words; } push @errors, "Unable to run '$spellchecker': $@"; } # no working spellcheckers during a dry run return \"no spellchecker" if $dryrun; # no working spellcheckers; report all the errors require Carp; Carp::croak "Unable to find a working spellchecker:\n" . join("\n", map { " $_\n" } @errors) } sub invalid_words_in { my $file = shift; my $document = ''; open my $handle, '>', \$document; # save digested POD to the string $document get_pod_parser()->parse_from_file($file, $handle); my @words = _get_spellcheck_results($document); chomp for @words; return @words; } sub pod_file_spelling_ok { my $file = shift; my $name = shift || "POD spelling for $file"; if (!-r $file) { $TEST->ok(0, $name); $TEST->diag("$file does not exist or is unreadable"); return; } my @words = invalid_words_in($file); # remove stopwords, select unique errors my $WL = \%Pod::Wordlist::Wordlist; @words = grep { !$WL->{$_} && !$WL->{lc $_} } @words; $ALL_WORDS{$_}++ for @words; my %seen; @seen{@words} = (); @words = sort keys %seen; # emit output my $ok = @words == 0; $TEST->ok($ok, "$name"); if (!$ok) { $TEST->diag("Errors:\n" . join '', map { " $_\n" } @words); } return $ok; } sub all_pod_files_spelling_ok { my @files = all_pod_files(@_); local %ALL_WORDS; if (!has_working_spellchecker()) { return $TEST->plan(skip_all => "no working spellchecker found"); } $TEST->plan(tests => scalar @files); my $ok = 1; for my $file (@files) { local $Test::Builder::Level = $Test::Builder::Level + 1; pod_file_spelling_ok($file) or undef $ok; } if ( keys %ALL_WORDS ) { # Invert k => v to v => [ k ] my %values; push @{ $values{ $ALL_WORDS{$_} } }, $_ for keys %ALL_WORDS; my $labelformat = q[%6s: ]; my $indent = q[ ] x 10; $TEST->diag(qq[\nAll incorrect words, by number of occurrences:\n] . join qq[\n], map { wrap( ( sprintf $labelformat, $_ ), $indent, join q[, ], sort @{ $values{$_} } ) } sort { $a <=> $b } keys %values ); } return $ok; } sub all_pod_files { my @queue = @_ ? @_ : _starting_points(); my @pod; while (@queue) { my $file = shift @queue; # recurse into subdirectories if (-d $file) { opendir(my $dirhandle, $file) or next; my @newfiles = readdir($dirhandle); closedir $dirhandle; @newfiles = File::Spec->no_upwards(@newfiles); @newfiles = grep { $_ ne "CVS" && $_ ne ".svn" } @newfiles; push @queue, map "$file/$_", @newfiles; } # add the file if it meets our criteria if (-f $file) { next unless _is_perl($file); next unless $FILE_FILTER->($file); push @pod, $file; } } return @pod; } sub _starting_points { return 'blib' if -d 'blib'; return 'lib'; } sub _is_perl { my $file = shift; return 1 if $file =~ /\.PL$/; return 1 if $file =~ /\.p(l|lx|m|od)$/; return 1 if $file =~ /\.t$/; open my $handle, '<', $file or return; my $first = <$handle>; return 1 if defined $first && ($first =~ /^#!.*perl/); return 0; } sub add_stopwords { for (@_) { # explicit copy so we don't modify constants as in add_stopwords("SQLite") my $word = $_; # XXX: the processing this performs is to support "perl t/spell.t 2>> # t/spell.t" which is bunk. in the near future the processing here will # become more modern $word =~ s/^#?\s*//; $word =~ s/\s+$//; next if $word =~ /\s/ or $word =~ /:/; $Pod::Wordlist::Wordlist{$word} = 1; } } sub set_spell_cmd { $SPELLCHECKER = shift; } sub set_pod_file_filter { $FILE_FILTER = shift; } # A new Pod::Spell object should be used for every file; people # providing custom pod parsers will have to do this themselves sub get_pod_parser { return $POD_PARSER || Pod::Spell->new; } sub set_pod_parser { $POD_PARSER = shift; } 1; __END__ =head1 NAME Test::Spelling - check for spelling errors in POD files =head1 SYNOPSIS use Test::More; BEGIN { plan skip_all => "Spelling tests only for authors" unless -d 'inc/.author'; } use Test::Spelling; all_pod_files_spelling_ok(); =head1 DESCRIPTION C lets you check the spelling of a POD file, and report its results in standard C fashion. This module requires a spellcheck program such as F, F, F, or F. use Test::Spelling; pod_file_spelling_ok('lib/Foo/Bar.pm', 'POD file spelling OK'); Note that it is a bad idea to run spelling tests during an ordinary CPAN distribution install, or in a package that will run in an uncontrolled environment. There is no way of predicting whether the word list or spellcheck program used will give the same results. You B include the test in your distribution, but be sure to run it only for authors of the module by guarding it in a C clause, or by putting the test in your distribution's F directory. Anyway, people installing your module really do not need to run such tests, as it is unlikely that the documentation will acquire typos while in transit. :-) You can add your own stop words, which are words that should be ignored by the spell check, like so: add_stopwords(qw(asdf thiswordiscorrect)); Adding stop words in this fashion affects all files checked for the remainder of the test script. See L (which this module is built upon) for a variety of ways to add per-file stop words to each .pm file. If you have a lot of stop words, it's useful to put them in your test file's C section like so: use Test::Spelling; add_stopwords(); all_pod_files_spelling_ok(); __END__ folksonomy Jifty Zakirov To maintain backwards compatibility, comment markers and some whitespace are ignored. In the near future, the preprocessing we do on the arguments to L will be changed and documented properly. =head1 FUNCTIONS =head2 all_pod_files_spelling_ok( [@files/@directories] ) Checks all the files for POD spelling. It gathers L on each file/directory, and declares a L for you (one test for each file), so you must not call C yourself. If C<@files> is empty, the function finds all POD files in the F directory if it exists, or the F directory if it does not. A POD file is one that ends with F<.pod>, F<.pl>, F<.plx>, or F<.pm>; or any file where the first line looks like a perl shebang line. If there is no working spellchecker (determined by L), this test will issue a "skip all" directive. If you're testing a distribution, just create a F with the code in the L. Returns true if every POD file has correct spelling, or false if any of them fail. This function will show any spelling errors as diagnostics. =head2 pod_file_spelling_ok( $filename[, $testname ] ) C will test that the given POD file has no spelling errors. When it fails, C will show any spelling errors as diagnostics. The optional second argument is the name of the test. If it is omitted, C chooses a default test name "POD spelling for C<$filename>". =head2 all_pod_files( [@dirs] ) Returns a list of all the Perl files in each directory and its subdirectories, recursively. If no directories are passed, it defaults to F if F exists, or else F if not. Skips any files in F or F<.svn> directories. A Perl file is: =over 4 =item * Any file that ends in F<.PL>, F<.pl>, F<.plx>, F<.pm>, F<.pod> or F<.t>. =item * Any file that has a first line with a shebang and "perl" on it. =back Furthermore, files for which the filter set by L return false are skipped. By default, this filter passes everything through. The order of the files returned is machine-dependent. If you want them sorted, you'll have to sort them yourself. =head2 add_stopwords(@words) Add words that should be skipped by the spellcheck. Note that L already skips words believed to be code, such as everything in verbatim (indented) blocks and code marked up with C<< C<...> >>, as well as some common Perl jargon. =head2 has_working_spellchecker C will return C if there is no working spellchecker, or a true value (the spellchecker command itself) if there is. The module performs a dry-run to determine whether any of the spellcheckers it can will use work on the current system. You can use this to skip tests if there is no spellchecker. Note that L will do this for you. =head2 set_spell_cmd($command) If you want to force this module to use a particular spellchecker, then you can specify which one with C. This is useful to ensure a more consistent lexicon between developers, or if you have an unusual environment. Any command that takes text from standard input and prints a list of misspelled words, one per line, to standard output will do. =head2 set_pod_file_filter($code) If your project has POD documents written in languages other than English, then obviously you don't want to be running a spellchecker on every Perl file. C lets you filter out files returned from L (and hence, the documents tested by L). set_pod_file_filter(sub { my $filename = shift; return 0 if $filename =~ /_ja.pod$/; # skip Japanese translations return 1; }); =head2 set_pod_parser($object) By default L is used to generate text suitable for spellchecking from the input POD. If you want to use a different parser, perhaps a customized subclass of L, call C with an object that is-a L. Be sure to create a fresh parser object for each file (don't use this with C). =head1 SEE ALSO L =head1 ORIGINAL AUTHOR Ivan Tubert-Brohman C<< >> Heavily based on L by Andy Lester and brian d foy. =head1 MAINTAINER Shawn M Moore C<< >> =head1 COPYRIGHT Copyright 2005, Ivan Tubert-Brohman, All Rights Reserved. You may use, modify, and distribute this package under the same terms as Perl itself. =cut Test-Spelling-0.20/inc/Module/000755 000765 000024 00000000000 12414767470 016567 5ustar00sartakstaff000000 000000 Test-Spelling-0.20/inc/Module/Install/000755 000765 000024 00000000000 12414767470 020175 5ustar00sartakstaff000000 000000 Test-Spelling-0.20/inc/Module/Install.pm000644 000765 000024 00000030135 12414767440 020532 0ustar00sartakstaff000000 000000 #line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Test-Spelling-0.20/inc/Module/Install/AutoManifest.pm000644 000765 000024 00000001257 12414767440 023134 0ustar00sartakstaff000000 000000 #line 1 use strict; use warnings; package Module::Install::AutoManifest; use Module::Install::Base; BEGIN { our $VERSION = '0.003'; our $ISCORE = 1; our @ISA = qw(Module::Install::Base); } sub auto_manifest { my ($self) = @_; return unless $Module::Install::AUTHOR; die "auto_manifest requested, but no MANIFEST.SKIP exists\n" unless -e "MANIFEST.SKIP"; if (-e "MANIFEST") { unlink('MANIFEST') or die "Can't remove MANIFEST: $!"; } $self->postamble(<<"END"); create_distdir: manifest_clean manifest distclean :: manifest_clean manifest_clean: \t\$(RM_F) MANIFEST END } 1; __END__ #line 48 #line 131 1; # End of Module::Install::AutoManifest Test-Spelling-0.20/inc/Module/Install/Base.pm000644 000765 000024 00000002147 12414767440 021406 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Test-Spelling-0.20/inc/Module/Install/Can.pm000644 000765 000024 00000006157 12414767440 021242 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Test-Spelling-0.20/inc/Module/Install/Fetch.pm000644 000765 000024 00000004627 12414767440 021572 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Test-Spelling-0.20/inc/Module/Install/GithubMeta.pm000644 000765 000024 00000002135 12414767440 022562 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::GithubMeta; use strict; use warnings; use Cwd; use base qw(Module::Install::Base); use vars qw($VERSION); $VERSION = '0.26'; sub githubmeta { my $self = shift; return unless $Module::Install::AUTHOR; return unless _under_git(); return unless $self->can_run('git'); my $remote = shift || 'origin'; local $ENV{LANG}='C'; return unless my ($git_url) = `git remote show -n $remote` =~ /URL: (.*)$/m; return unless $git_url =~ /github\.com/; # Not a Github repository my $http_url = $git_url; $git_url =~ s![\w\-]+\@([^:]+):!git://$1/!; $http_url =~ s![\w\-]+\@([^:]+):!https://$1/!; $http_url =~ s!\.git$!/tree!; $self->repository( $git_url ); $self->homepage( $http_url ) unless $self->homepage(); return 1; } sub _under_git { return 1 if -e '.git'; my $cwd = getcwd; my $last = $cwd; my $found = 0; while (1) { chdir '..' or last; my $current = getcwd; last if $last eq $current; $last = $current; if ( -e '.git' ) { $found = 1; last; } } chdir $cwd; return $found; } 'Github'; __END__ #line 112 Test-Spelling-0.20/inc/Module/Install/Makefile.pm000644 000765 000024 00000027437 12414767440 022262 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Test-Spelling-0.20/inc/Module/Install/ManifestSkip.pm000644 000765 000024 00000001557 12414767440 023135 0ustar00sartakstaff000000 000000 #line 1 ## # name: Module::Install::ManifestSkip # abstract: Generate a MANIFEST.SKIP file # author: Ingy döt Net # license: perl # copyright: 2010, 2011 # see: # - Module::Manifest::Skip package Module::Install::ManifestSkip; use 5.008001; use strict; use warnings; use base 'Module::Install::Base'; my $requires = " use Module::Manifest::Skip 0.10 (); "; our $VERSION = '0.20'; our $AUTHOR_ONLY = 1; my $skip_file = "MANIFEST.SKIP"; sub manifest_skip { my $self = shift; return unless $self->is_admin; eval $requires; die $@ if $@; print "Writing $skip_file\n"; open OUT, '>', $skip_file or die "Can't open $skip_file for output: $!";; print OUT Module::Manifest::Skip->new->text; close OUT; $self->clean_files('MANIFEST'); $self->clean_files($skip_file) if grep /^clean$/, @_; } 1; Test-Spelling-0.20/inc/Module/Install/Metadata.pm000644 000765 000024 00000043277 12414767440 022265 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Test-Spelling-0.20/inc/Module/Install/Win32.pm000644 000765 000024 00000003403 12414767440 021432 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Test-Spelling-0.20/inc/Module/Install/WriteAll.pm000644 000765 000024 00000002376 12414767440 022263 0ustar00sartakstaff000000 000000 #line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1;