├── .appveyor.cmd ├── .appveyor.yml ├── .gitignore ├── .perltidyrc ├── .travis.yml ├── Build.PL ├── Changes ├── INSTALL ├── MANIFEST ├── MANIFEST.SKIP ├── Makefile.PL ├── TODO ├── bin └── config_data ├── configs ├── darwin-Config.pm └── win2k-Config.pm ├── contrib └── bash_completion.module-build ├── devtools ├── bump_version.pl ├── doc_check.pl └── release_instructions.pod ├── inc ├── MBVersion.pm ├── Module │ └── Metadata.pm ├── ModuleBuildBuilder.pm ├── Perl │ └── OSType.pm └── bootstrap.pl ├── lib └── Module │ ├── Build.pm │ └── Build │ ├── API.pod │ ├── Authoring.pod │ ├── Base.pm │ ├── Bundling.pod │ ├── Compat.pm │ ├── Config.pm │ ├── Cookbook.pm │ ├── Dumper.pm │ ├── Notes.pm │ ├── PPMMaker.pm │ ├── Platform │ ├── Default.pm │ ├── MacOS.pm │ ├── Unix.pm │ ├── VMS.pm │ ├── VOS.pm │ ├── Windows.pm │ ├── aix.pm │ ├── cygwin.pm │ ├── darwin.pm │ └── os2.pm │ └── PodParser.pm └── t ├── 00-compile.t ├── PL_files.t ├── README.pod ├── actions ├── installdeps.t └── manifest_skip.t ├── add_property.t ├── add_property_array.t ├── add_property_hash.t ├── basic.t ├── bundle_inc.t ├── bundled ├── Software │ └── License.pm └── Tie │ └── CPHash.pm ├── compat.t ├── compat └── exit.t ├── debug.t ├── destinations.t ├── ext.t ├── extend.t ├── files.t ├── help.t ├── install.t ├── install_extra_target.t ├── lib ├── DistGen.pm ├── MBTest.pm ├── Module │ └── Signature.pm └── Software │ └── License │ └── VaporWare.pm ├── manifypods.t ├── manifypods_with_utf8.t ├── metadata.t ├── metadata2.t ├── mymeta.t ├── new_from_context.t ├── notes.t ├── par.t ├── parents.t ├── perl_mb_opt.t ├── pod_parser.t ├── ppm.t ├── properties ├── dist_suffix.t ├── license.t ├── module_name.t ├── needs_compiler.t ├── release_status.t ├── requires.t └── share_dir.t ├── resume.t ├── runthrough.t ├── sample.t ├── script_dist.t ├── signature.t ├── test_file_exts.t ├── test_reqs.t ├── test_type.t ├── test_types.t ├── tilde.t ├── unit_run_test_harness.t ├── use_tap_harness.t ├── versions.t ├── write_default_maniskip.t └── xs.t /.appveyor.cmd: -------------------------------------------------------------------------------- 1 | @echo off 2 | 3 | if not defined perl_type set perl_type=system 4 | if "%perl_type%" == "strawberry" ( 5 | if not defined perl_version ( 6 | cinst -y StrawberryPerl 7 | ) else ( 8 | cinst -y StrawberryPerl --version %perl_version% 9 | ) 10 | set "PATH=C:\Strawberry\perl\bin;C:\Strawberry\perl\site\bin;C:\Strawberry\c\bin;%PATH%" 11 | ) else if "%perl_type%" == "system" ( 12 | mkdir c:\dmake 13 | cinst -y curl 14 | curl http://www.cpan.org/authors/id/S/SH/SHAY/dmake-4.12.2.2.zip -o c:\dmake\dmake.zip 15 | 7z x c:\dmake\dmake.zip -oc:\ >NUL 16 | set "PATH=c:\dmake;C:\MinGW\bin;%PATH%" 17 | ) else ( 18 | echo.Unknown perl type "%perl_type%"! 1>&2 19 | exit /b 1 20 | ) 21 | for /f "usebackq delims=" %%d in (`perl -MConfig -e"print $Config{make}"`) do set make=%%d 22 | set "perl=perl" 23 | set TAR_OPTIONS=--warning=no-unknown-keyword 24 | 25 | :eof 26 | -------------------------------------------------------------------------------- /.appveyor.yml: -------------------------------------------------------------------------------- 1 | version: '{build}' 2 | shallow_clone: true 3 | 4 | environment: 5 | matrix: 6 | - perl_type: system 7 | - perl_type: strawberry 8 | - perl_type: strawberry 9 | perl_version: 5.12.3.1 10 | - perl_type: strawberry 11 | perl_version: 5.16.3.3 12 | - perl_type: strawberry 13 | perl_version: 5.20.1.1 14 | 15 | install: 16 | - 'call .appveyor.cmd perl_setup' 17 | - 'cpan ExtUtils::PL2Bat' 18 | - '%perl% -V' 19 | 20 | build: off 21 | 22 | test_script: 23 | - 'prove -l t' 24 | 25 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.bak 2 | *.old 3 | *.tmp 4 | *.tar.gz 5 | *.rej 6 | *.orig 7 | *~ 8 | /Build 9 | /Build.bat 10 | /Makefile 11 | /_build 12 | /blib 13 | /cover_db 14 | /pm_to_blib 15 | /PM_to_blib 16 | /META.* 17 | /MYMETA.* 18 | /*.tar.gz 19 | /Module-Build-* 20 | /LICENSE 21 | /README 22 | -------------------------------------------------------------------------------- /.perltidyrc: -------------------------------------------------------------------------------- 1 | --maximum-line-length=72 2 | 3 | # (note an indent is an indent, so no "continuation indents") 4 | --indent-columns=2 5 | 6 | # I usually want blank lines before comments, but it is not worth 7 | # fighting with perltidy's inability to recognize blocks. 8 | --noblanks-before-comments 9 | 10 | --space-after-keyword="and or eq ne" 11 | # the paren+args are part of the keyword 12 | --nospace-after-keyword="if else elsif until unless while for foreach return switch case given when" 13 | 14 | # break after the operator so it doesn't look like a syntax error 15 | --want-break-after=". << >> -> && || and or" 16 | 17 | # we don't put spaces after parens in english 18 | --paren-tightness=2 19 | --block-brace-tightness=2 20 | --square-bracket-tightness=2 21 | --brace-tightness=2 22 | 23 | # who uses space before the peterbilt? 24 | --nohanging-side-comments 25 | --nospace-for-semicolon 26 | --indent-block-comments 27 | --minimum-space-to-comment=1 28 | # never outdent 29 | --nooutdent-long-lines 30 | 31 | # these are currently broken wrt closing indent :-( 32 | #--stack-opening-token 33 | #--stack-closing-token 34 | 35 | # still pondering this one -- seems to help in some cases, break others 36 | #--nodelete-old-newlines 37 | 38 | # Eric wants --break-at-correct-breakpoints 39 | #--break-at-old-comma-breakpoints 40 | #--break-at-old-trinary-breakpoints 41 | #--break-at-old-logical-breakpoints 42 | #--break-at-old-keyword-breakpoints 43 | 44 | #--closing-token-indentation=0 45 | --noindent-closing-brace 46 | --noindent-closing-paren 47 | 48 | #--vertical-tightness-closing=0 49 | --nooutdent-long-quotes 50 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: perl 2 | notifications: 3 | on_success: never 4 | on_failure: always 5 | irc: "irc.perl.org#toolchain" 6 | email: false 7 | before_install: 8 | - cpanm CPAN::Meta 9 | matrix: 10 | include: 11 | - perl: "5.20" 12 | dist: trusty 13 | - perl: "5.18" 14 | dist: trusty 15 | - perl: "5.16" 16 | dist: trusty 17 | - perl: "5.14" 18 | dist: trusty 19 | - perl: "5.12" 20 | dist: trusty 21 | - perl: "5.10" 22 | dist: trusty 23 | - perl: "5.8" 24 | dist: trusty 25 | script: 26 | - perl Build.PL && ./Build test && ./Build disttest 27 | - perl Makefile.PL && make test 28 | -------------------------------------------------------------------------------- /Build.PL: -------------------------------------------------------------------------------- 1 | use 5.006001; 2 | use strict; 3 | 4 | use lib 'lib'; # use our self to install 5 | 6 | # bootstrap configure_requires prereqs 7 | BEGIN { do './inc/bootstrap.pl' } 8 | 9 | # We use Module::Build to test & install itself. 10 | use Module::Build; 11 | 12 | # This code is only present for M::B developers, not on CPAN 13 | # A custom builder that does some special stuff during the 'dist' phase 14 | use lib 'inc'; 15 | use ModuleBuildBuilder; 16 | # 17 | 18 | my $build = ModuleBuildBuilder->new( 19 | module_name => 'Module::Build', 20 | license => 'perl', 21 | configure_requires => { 22 | 'CPAN::Meta' => '2.142060', 23 | 'Perl::OSType' => 1, 24 | 'Module::Metadata' => '1.000002', 25 | 'version' => '0.87', 26 | 'File::Spec' => '0.82', 27 | 'File::Copy' => 0, 28 | 'File::Basename' => 0, 29 | 'File::Path' => 0, 30 | }, 31 | # KEEP 'requires' as low as possible and target Build/test/install 32 | # Requirements for authors should be implemented as optional features 33 | requires => { 34 | 'perl' => '5.006001', 35 | 'Data::Dumper' => 0, 36 | 'File::Basename' => 0, 37 | 'File::Compare' => 0, 38 | 'File::Copy' => 0, 39 | 'File::Find' => 0, 40 | 'File::Path' => 0, 41 | 'File::Spec' => ($^O eq 'MSWin32' ? 3.30 : '0.82'), # rel2abs() 42 | 'ExtUtils::CBuilder' => 0.27, # major platform fixes 43 | 'ExtUtils::Install' => 0, 44 | 'ExtUtils::InstallPaths'=> 0.003, 45 | 'ExtUtils::Manifest' => 0, 46 | 'ExtUtils::Mkbootstrap' => 0, 47 | 'ExtUtils::ParseXS' => 2.21, # various bug fixes 48 | 'Cwd' => 0, 49 | 'Text::Abbrev' => 0, 50 | 'Text::ParseWords' => 0, 51 | 'Getopt::Long' => 0, 52 | 'TAP::Harness' => 3.29, 53 | 'CPAN::Meta' => '2.142060', 54 | 'Perl::OSType' => ( $^O eq 'bitrig' ? 1.004 : 1 ), # needs 1.0 API 55 | 'version' => 0.87, # No longer requires M::B 56 | 'Module::Metadata' => 1.000002, # uses version.pm 57 | ($^O eq 'MSWin32' ? ('ExtUtils::PL2Bat' => 0) : ()) 58 | }, 59 | test_requires => { 60 | 'File::Temp' => 0.15, # tmpdir() + fixes 61 | 'Test::More' => 0.49, 62 | 'TAP::Harness' => 3.29, # TAP::Harness::Env 63 | 'Parse::CPAN::Meta' => '1.4401', 64 | 'CPAN::Meta::YAML' => 0.003, 65 | }, 66 | recommends => { 67 | 'ExtUtils::Install' => 0.30, 68 | 'ExtUtils::Manifest' => 1.54, # public maniskip() 69 | }, 70 | recursive_test_files => 1, 71 | sign => 0, 72 | create_readme => 1, 73 | create_license => 1, 74 | 75 | # overwrite the M::B that shipped in core 76 | installdirs => ($] >= 5.009004 && $] < 5.011 ? 'core' : 'site'), 77 | 78 | # Some CPANPLUS::Dist::Build versions need to allow mismatches 79 | # On logic: thanks to Module::Install, CPAN.pm must set both keys, but 80 | # CPANPLUS sets only the one 81 | allow_mb_mismatch => ( 82 | $ENV{PERL5_CPANPLUS_IS_RUNNING} && ! $ENV{PERL5_CPAN_IS_RUNNING} ? 1 : 0 83 | ), 84 | 85 | auto_features => { 86 | dist_authoring => { 87 | description => "Create new distributions", 88 | requires => { 89 | 'Archive::Tar' => 1.09, 90 | }, 91 | recommends => { 92 | 'Pod::Readme' => 0.04, 93 | 'Module::Signature' => 0.21, 94 | }, 95 | }, 96 | license_creation => { 97 | description => "Create licenses automatically in distributions", 98 | requires => { 99 | 'Software::License' => 0.103009 100 | }, 101 | }, 102 | PPM_support => { 103 | description => "Generate PPM files for distributions", 104 | }, 105 | inc_bundling_support => { 106 | description => "Bundle Module::Build in inc/", 107 | requires => { 108 | 'inc::latest' => 0.500, # split out from Module::Build 109 | 'ExtUtils::Install' => 1.54, # also gets us ExtUtils::Installed 1.999_001 110 | 'ExtUtils::Installed' => 1.999, # technically 1.999_001 is what's available 111 | }, 112 | }, 113 | manpage_support => { 114 | description => "Create Unix man pages", 115 | requires => {'Pod::Man' => 0 }, 116 | }, 117 | HTML_support => { 118 | description => "Create HTML documentation", 119 | requires => {'Pod::Html' => 0}, 120 | }, 121 | }, 122 | 123 | add_to_cleanup => ['t/Sample/pod2htm*'], 124 | script_files => ['bin/config_data'], 125 | meta_merge => { 126 | resources => { 127 | MailingList => 'mailto:module-build@perl.org', 128 | repository => 'https://github.com/Perl-Toolchain-Gang/Module-Build', 129 | IRC => 'irc://irc.perl.org/#toolchain', 130 | } 131 | }, 132 | ); 133 | 134 | $build->create_build_script; 135 | if (-f "META.yml" && ! -f "MYMETA.yml") { # fallback if we don't have CPAN::Meta 136 | require File::Copy; 137 | File::Copy::copy("META.yml", "MYMETA.yml") or warn "Error: $!\n"; 138 | if ( -f 'MYMETA.yml' ) { 139 | warn "Copied META.yml to MYMETA.yml for bootstrapping\n"; 140 | } 141 | else { 142 | warn "Could not copy META.yml to MYMETA.yml. That's odd!\n"; 143 | } 144 | } 145 | 146 | # vim:ts=2:sw=2:et:sta 147 | -------------------------------------------------------------------------------- /INSTALL: -------------------------------------------------------------------------------- 1 | Installation instructions for Module::Build 2 | 3 | To install this module, just do: 4 | 5 | perl Build.PL 6 | ./Build 7 | ./Build test 8 | ./Build install (this step may need to be done as the superuser) 9 | 10 | Or, if you're on a platform (like DOS or Windows) that doesn't require 11 | the "./" notation, you can do this: 12 | 13 | perl Build.PL 14 | Build 15 | Build test 16 | Build install 17 | 18 | The important thing is that the "Build" script gets executed and that 19 | you pass it the "test", "install", etc. arguments. 20 | 21 | There's heaps more information in the README and in the documentation 22 | of the various packages in this distribution. 23 | 24 | -Ken 25 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | bin/config_data 2 | Build.PL 3 | Changes 4 | contrib/bash_completion.module-build 5 | inc/bootstrap.pl 6 | inc/MBVersion.pm 7 | inc/Module/Metadata.pm 8 | inc/Perl/OSType.pm 9 | INSTALL 10 | lib/Module/Build.pm 11 | lib/Module/Build/API.pod 12 | lib/Module/Build/Authoring.pod 13 | lib/Module/Build/Base.pm 14 | lib/Module/Build/Bundling.pod 15 | lib/Module/Build/Compat.pm 16 | lib/Module/Build/Config.pm 17 | lib/Module/Build/Cookbook.pm 18 | lib/Module/Build/Dumper.pm 19 | lib/Module/Build/Notes.pm 20 | lib/Module/Build/Platform/aix.pm 21 | lib/Module/Build/Platform/cygwin.pm 22 | lib/Module/Build/Platform/darwin.pm 23 | lib/Module/Build/Platform/Default.pm 24 | lib/Module/Build/Platform/MacOS.pm 25 | lib/Module/Build/Platform/os2.pm 26 | lib/Module/Build/Platform/Unix.pm 27 | lib/Module/Build/Platform/VMS.pm 28 | lib/Module/Build/Platform/VOS.pm 29 | lib/Module/Build/Platform/Windows.pm 30 | lib/Module/Build/PodParser.pm 31 | lib/Module/Build/PPMMaker.pm 32 | LICENSE 33 | Makefile.PL 34 | MANIFEST 35 | META.json 36 | META.yml 37 | README 38 | t/00-compile.t 39 | t/actions/installdeps.t 40 | t/actions/manifest_skip.t 41 | t/add_property.t 42 | t/add_property_array.t 43 | t/add_property_hash.t 44 | t/basic.t 45 | t/bundle_inc.t 46 | t/bundled/Software/License.pm 47 | t/bundled/Tie/CPHash.pm 48 | t/compat.t 49 | t/compat/exit.t 50 | t/debug.t 51 | t/destinations.t 52 | t/ext.t 53 | t/extend.t 54 | t/files.t 55 | t/help.t 56 | t/install.t 57 | t/install_extra_target.t 58 | t/lib/DistGen.pm 59 | t/lib/MBTest.pm 60 | t/lib/Module/Signature.pm 61 | t/lib/Software/License/VaporWare.pm 62 | t/manifypods.t 63 | t/manifypods_with_utf8.t 64 | t/metadata.t 65 | t/metadata2.t 66 | t/mymeta.t 67 | t/new_from_context.t 68 | t/notes.t 69 | t/par.t 70 | t/parents.t 71 | t/perl_mb_opt.t 72 | t/PL_files.t 73 | t/pod_parser.t 74 | t/ppm.t 75 | t/properties/dist_suffix.t 76 | t/properties/license.t 77 | t/properties/module_name.t 78 | t/properties/needs_compiler.t 79 | t/properties/release_status.t 80 | t/properties/requires.t 81 | t/properties/share_dir.t 82 | t/README.pod 83 | t/resume.t 84 | t/runthrough.t 85 | t/sample.t 86 | t/script_dist.t 87 | t/signature.t 88 | t/test_file_exts.t 89 | t/test_reqs.t 90 | t/test_type.t 91 | t/test_types.t 92 | t/tilde.t 93 | t/unit_run_test_harness.t 94 | t/use_tap_harness.t 95 | t/versions.t 96 | t/write_default_maniskip.t 97 | t/xs.t 98 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | ^_build 2 | ^inc/ModuleBuildBuilder.pm 3 | ^kwiki 4 | (^|/)blib 5 | CVS 6 | ^Build$ 7 | ^Build.bat$ 8 | ~$ 9 | ^configs 10 | ^testbed 11 | ^MANIFEST\.SKIP$ 12 | \.bak$ 13 | \.rej$ 14 | \.orig$ 15 | ^patch 16 | ^Module- 17 | ^t/_ 18 | ^t/Sample/(save_out|SIGNATURE|Build)$ 19 | ^t/Sample/_build 20 | (^|/)\. 21 | Makefile$ 22 | /cover_db/ 23 | bleadcheck\.pl$ 24 | 25 | ^TODO$ 26 | ^CPANTEST 27 | \.c$ 28 | \.bs$ 29 | \.bundle$ 30 | \.yaml$ 31 | save_out$ 32 | save_err$ 33 | (^|/)\.# 34 | ^website 35 | /Script$ 36 | ^META- 37 | ^MYMETA\.yml$ 38 | Plugin 39 | doc_check.pl$ 40 | ^[^/]+\.patch$ 41 | ^devtools 42 | ^.gitignore 43 | ^MYMETA\.json$ 44 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | # This Makefile.PL creates a pass-through Makefile that simply calls 2 | # the equivalent Module::Build methods for each make target. See the 3 | # documentation for Module::Build::Compat for more information. 4 | 5 | use 5.006001; 6 | 7 | 8 | use lib qw(lib); 9 | 10 | # bootstrap configure_requires prereqs 11 | BEGIN { do './inc/bootstrap.pl' or die defined($@) ? $@ : $! } 12 | 13 | use Module::Build::Compat; 14 | 15 | Module::Build::Compat->run_build_pl(args => \@ARGV); 16 | Module::Build::Compat->write_makefile(build_class => 'Module::Build'); 17 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | -------------------------- TO DO: -------------------------------- 2 | 3 | * Automatically add anything in configure_requires that is not in 4 | build_requires to build_requires instead of complaining about it. 5 | If we can detect the error, we can fix it. We shouldn't make 6 | authors repeat themselves in Build.PL 7 | 8 | - I'm not sure this is correct. Prereqs shouldn't need to be listed 9 | multiple times in META.yml. Hold off until this is clarified in 10 | the META.yml spec. 11 | 12 | - CPAN::Meta::Spec clearly says that configure, runtime and 13 | build requirements are needed for "Build", and that 14 | configure, runtime, build and test requirements are needed 15 | for "Build test". As such, there is no need to duplicate 16 | the contents of configure_requires into build_requires. 17 | 18 | - I can't find the mentioned "complaining". Has it been removed? 19 | 20 | * Check edge cases for normalize_version -- string "v1.2" might not 21 | get normalized, but it should 22 | 23 | * Dump better diagnostics if we die() while building ourself 24 | 25 | * perllocal.pod? http://rt.cpan.org/Ticket/Display.html?id=14316 26 | 27 | * Look at Time::HiRes as a way to get C modules compiled & linked on 28 | various weird platforms, and abstract them into a new utility module 29 | for this purpose. 30 | 31 | * Rethink the whole approach to dependencies. This means making 32 | "requires vs. recommends vs. conflicts" orthogonal to "build-time 33 | vs. run-time", recording which dependencies the user chooses to 34 | fulfill at install time, and so on. 35 | 36 | - Defer until after META spec revisions 37 | 38 | * Think about how to allow "local policy" configuration, as well as 39 | "local enhancements" for frequent developers or frequent installers. 40 | 41 | * Figure out how to cooperate well with real packaging systems 42 | (chiefly RPM, Debian, and PPM). May mean creating packages ourselves, 43 | may mean creating lists of stuff to let package managers chew on, may 44 | mean something else. 45 | 46 | * When doing an 'install' or 'preinstall' action, create a packlist 47 | file in a format useful for package managers. Probably a subtask of 48 | the above packaging systems task. 49 | 50 | -------------------------- DONE: --------------------------------- 51 | 52 | * Create a mechanism for really easy data sharing between Build.PL, 53 | other .PL files, and test scripts. Probably something like 54 | $r->notes() from mod_perl would be easy to do. Even fancier would be 55 | something like Module::Build->instance() in order to get a M::B object 56 | or reasonable facsimile. 57 | 58 | * Create man pages to install during 'install' action. 59 | 60 | * Add a 'distsign' action that uses Module::Signature to provide 61 | cryptographic authentication to module distributions. 62 | 63 | * Figure out how to make the build process work on MacOS 64 | 65 | * Add a 'diff' action that compares to previously installed version. 66 | 67 | * Write cleanup entries to _build/cleanup immediately, so they still 68 | get written if an error occurs 69 | 70 | * Create a prompt() method similar to ExtUtils::MakeMaker::prompt(). 71 | 72 | * Create a yorn() method that loops prompt() until it gets a yes/no 73 | answer. (Created as y_n()) 74 | 75 | -------------------------------------------------------------------------------- /contrib/bash_completion.module-build: -------------------------------------------------------------------------------- 1 | # Module::Build Bash completion function 2 | # Contributed by Julian Mehnle 3 | # $Id$ 4 | # vim:syn=sh 5 | 6 | if 7 | actions=$( 8 | perl -M'Module::Build' -le 'print foreach Module::Build->known_actions' 2>/dev/null 9 | ) && 10 | properties=$( 11 | perl -M'Module::Build' -le 'print foreach sort Module::Build->valid_properties' 2>/dev/null 12 | ) 13 | then 14 | eval "_Build_actions () { echo '$actions'; }" 15 | eval "_Build_properties () { echo '$properties'; }" 16 | unset -v actions properties 17 | 18 | _Build () { 19 | local word=${COMP_WORDS[COMP_CWORD]} 20 | #local prev_word=${COMP_WORDS[COMP_CWORD-1]} 21 | #local action=${COMP_WORDS[1]} 22 | 23 | if (( $COMP_CWORD == 1 )); then 24 | # Complete actions: 25 | local IFS_org="$IFS" 26 | IFS=$'\x1F\t\n' 27 | # Avoid space (\x20) as a word separator to make the following -S ' ' work. 28 | COMPREPLY=($( compgen -W "$(_Build_actions)" -S ' ' -- "$word" )) 29 | IFS="$IFS_org" 30 | else 31 | # Complete properties: 32 | COMPREPLY=($( compgen -W "$(_Build_properties)" -S = -- "$word" )) 33 | fi 34 | 35 | return 0 36 | } 37 | 38 | complete -o nospace -F _Build Build 39 | fi 40 | -------------------------------------------------------------------------------- /devtools/bump_version.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | # NOTE: we run this immediately *after* a release so that any reports 4 | # against the repo are obvious 5 | 6 | use strict; 7 | use warnings; 8 | 9 | use lib 'lib', 'inc'; 10 | use ModuleBuildBuilder; 11 | 12 | use Tie::File; 13 | 14 | eval { require File::Find::Rule } or 15 | die "$0 requires File::Find::Rule. Please install and try again.\n"; 16 | 17 | my $current = ModuleBuildBuilder->new_from_context(quiet => 1)->dist_version; 18 | 19 | # Get version from command line or prompt 20 | my $version = shift; 21 | unless($version) { 22 | my $default = $current; 23 | 24 | # try to construct a reasonable default automatically 25 | $default =~ s/(\d+)$// or 26 | die "Usage: $0 VERSION\ncurrently: $current\n"; 27 | my $end = $1; 28 | $default .= sprintf('%0'.length($end).'d', $end+1); 29 | 30 | local $| = 1; 31 | print "enter new version [$default]: "; 32 | chomp(my $ans = ); 33 | $version = $ans ? $ans : $default; 34 | # TODO check for garbage in? 35 | } 36 | 37 | die "must bump forward! ($version < $current)\n" 38 | unless(eval $version >= eval $current); 39 | 40 | # Get list of .pm files 41 | my @pmfiles = File::Find::Rule->new->or( 42 | File::Find::Rule->name('*.pm'), 43 | )->in( 'lib' ); 44 | my @scripts = File::Find::Rule->new()->or( 45 | File::Find::Rule->name('*'), 46 | )->in( './scripts' ); 47 | 48 | # first start the new Changes entry 49 | sub { 50 | my $file = 'Changes'; 51 | open(my $fh, '<', $file) or die "cannot read '$file' $!"; 52 | my @lines = <$fh>; 53 | my @head; 54 | while(@lines) { 55 | my $line = shift(@lines); 56 | if($line =~ m/^$current/ ) { 57 | # unreleased case -- re-bumping 58 | if($line =~ m/^$current(?: *- *)?$/) { 59 | print "Error parsing $file - found unreleased '$current'\n"; 60 | local $| = 1; 61 | print "Are you sure you want to change the version number (y/n)? [n]:"; 62 | chomp(my $ans = ); 63 | if ( $ans !~ /^y/i ) { 64 | print "Aborting!\n"; 65 | exit 1; 66 | } 67 | warn "Updating '$file'\n"; 68 | open(my $ofh, '>', $file) or die "cannot write '$file' $!"; 69 | print $ofh @head, "$version - \n", @lines; 70 | close($ofh) or die "cannot write '$file' $!"; 71 | return; 72 | } 73 | if($line =~ m/^$current - \w/) { 74 | warn "Updating '$file'\n"; 75 | open(my $ofh, '>', $file) or die "cannot write '$file' $!"; 76 | print $ofh @head, "$version - \n", "\n", $line, @lines; 77 | close($ofh) or die "cannot write '$file' $!"; 78 | return; 79 | } 80 | elsif($line =~ m/^$version(?: *- *)?$/) { 81 | # TODO should just be checking for a general number+eol case? 82 | die "$file probably needs to be reverted!"; 83 | } 84 | } 85 | else { 86 | push(@head, $line); 87 | } 88 | } 89 | die "cannot find changes entry for current version ($current)!"; 90 | }->(); 91 | 92 | for my $file ( @pmfiles, @scripts ) { 93 | bump_version( $file, $version ); 94 | } 95 | 96 | 97 | exit; 98 | 99 | sub bump_version { 100 | my ( $file, $version ) = @_; 101 | my $o = tie my @lines, 'Tie::File', $file 102 | or die "Couldn't tie '$file' for editing\n"; 103 | $o->flock; 104 | 105 | # find line to change just like EU::MM::parse_version 106 | my $inpod = 0; 107 | for ( @lines ) { 108 | $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; 109 | next if $inpod || /^\s*#/; 110 | next unless /(? file as described in 47 | L's documentation. 48 | 49 | =head2 After shipping 50 | 51 | Now the release is out and tagged, so it's time to start a 52 | new version number: 53 | 54 | $ ./devtools/bump_version.pl 55 | $ git commit -a -m "Changes, lib/***.pm - bump version" 56 | 57 | -------------------------------------------------------------------------------- /inc/Module/Metadata.pm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Perl-Toolchain-Gang/Module-Build/a2ecdf98c25af7dfc7070280232513e8ccec4986/inc/Module/Metadata.pm -------------------------------------------------------------------------------- /inc/ModuleBuildBuilder.pm: -------------------------------------------------------------------------------- 1 | package ModuleBuildBuilder; 2 | 3 | use strict; 4 | use Module::Build; 5 | use File::Copy qw/copy/; 6 | use File::Basename qw/dirname/; 7 | use File::Path qw/mkpath/; 8 | 9 | use vars qw(@ISA); 10 | @ISA = qw(Module::Build); 11 | 12 | 13 | sub ACTION_distdir { 14 | my $self = shift; 15 | $self->SUPER::ACTION_distdir(@_); 16 | 17 | my $build_pl = File::Spec->catfile($self->dist_dir, qw(Build.PL)); 18 | my $build_pm = File::Spec->catfile($self->dist_dir, qw(lib Module Build.pm)); 19 | my $base_pm = File::Spec->catfile($self->dist_dir, qw(lib Module Build Base.pm)); 20 | my $api_pod = File::Spec->catfile($self->dist_dir, qw(lib Module Build API.pod)); 21 | 22 | open my($fh), $base_pm or die "Couldn't read $base_pm: $!"; 23 | my %subs = map {$_,1} map +(/^\s*sub (\w+)/)[0], <$fh>; 24 | 25 | # Replace "" with some POD lists 26 | my @need_doc = sort grep !$subs{$_}, $self->valid_properties; 27 | $self->do_replace(qq[s{=item }{ join "\\n\\n", map "=item \$_()", qw(@need_doc) }e], 28 | $api_pod); 29 | 30 | # Replace "" with a list of actions 31 | my $action_text = $self->_action_listing(scalar Module::Build->known_actions); 32 | $self->do_replace(qq[s{}{$action_text}], $build_pm); 33 | 34 | # Finally, sneakily rewrite the Build.PL to use a vanilla 35 | # Module::Build object instead of a ModuleBuildBuilder. 36 | $self->do_replace(qq[BEGIN{\$/=undef} s{.*}{}gs], $build_pl); 37 | $self->do_replace(qq[s{ModuleBuildBuilder}{Module::Build}gs], $build_pl); 38 | 39 | # XXX Band-aid the signing here again, since we modified some files. 40 | $self->depends_on('distsign') if($self->sign); 41 | } 42 | 43 | sub do_replace { 44 | my ($self, $code, $file) = @_; 45 | $self->run_perl_script('-e', ['-pi.bak'], [$code, $file]); 46 | 1 while unlink "$file.bak"; 47 | } 48 | 49 | sub _copy_to_blead { 50 | my ($files, $munge, $skips) = @_; 51 | for my $file (sort @$files) { 52 | next unless -f $file; 53 | next if $file =~ /\.svn/; 54 | next if grep { $file eq $_ } @$skips; 55 | my $dest = $munge->($file); 56 | mkpath( dirname($dest) ); 57 | print "Copying $file\n"; 58 | copy($file, $dest) 59 | or warn "!! Copy failed: $!"; 60 | chmod 0644 , $dest unless -w $dest; 61 | } 62 | } 63 | 64 | sub ACTION_patch_blead { 65 | my $self = shift; 66 | my $git_dir = $ARGV[1]; 67 | die "Usage: Build patch_blead \n" 68 | unless $git_dir && -d "$git_dir/.git" && -f "$git_dir/perl.h"; 69 | 70 | $self->depends_on('distdir'); 71 | 72 | $self->log_info( "Updating $git_dir\n" ); 73 | $self->{properties}{verbose} = 1; 74 | 75 | # create a branch 76 | my $cwd = $self->cwd; 77 | chdir $git_dir; 78 | $self->do_system("git checkout -b " . $self->dist_dir) 79 | or die "Couldn't create git branch" . $self->dist_dir . "\n"; 80 | chdir $cwd; 81 | 82 | # Prep distdir since we need autogenerated docs 83 | chdir "$cwd/" . $self->dist_dir or die "Couldn't chdir"; 84 | system("$^X Build.PL") and die; 85 | system("$^X Build") and die; 86 | 87 | # copy files 88 | (my $git_mb_dir = $git_dir) =~ s{/?$}{/cpan/Module-Build}; 89 | 90 | # get .pm and .pod from blib to pick up autogenerated stuff 91 | _copy_to_blead( 92 | $self->rscan_dir('blib/lib'), 93 | sub { my $f = shift; $f =~ s{^blib/}{}; "$git_mb_dir/$f" }, 94 | ); 95 | 96 | # get t, bin and Changes directly 97 | _copy_to_blead( 98 | [ @{$self->rscan_dir('t')}, @{$self->rscan_dir('bin')} ], 99 | sub { my $f = shift; return "$git_mb_dir/$f" }, 100 | [ qw{ t/par.t t/signature.t } ], # skip list 101 | ); 102 | 103 | return 1; 104 | } 105 | 106 | sub ACTION_upload { 107 | my $self = shift; 108 | 109 | $self->depends_on('checkchanges'); 110 | $self->depends_on('checkgit'); 111 | 112 | eval { require CPAN::Uploader; 1 } 113 | or die "CPAN::Uploader must be installed for uploading to work.\n"; 114 | 115 | $self->depends_on('build'); 116 | $self->depends_on('distmeta'); 117 | $self->depends_on('distcheck'); 118 | $self->depends_on('disttest'); 119 | $self->depends_on('dist'); 120 | 121 | my $uploader = $self->find_command("cpan-upload"); 122 | 123 | if ( $self->y_n("Upload to CPAN?", 'y') ) { 124 | $self->do_system($uploader, $self->dist_dir . ".tar.gz") 125 | or die "Failed to upload.\n"; 126 | $self->depends_on('tag_git'); 127 | } 128 | 129 | return 1; 130 | } 131 | 132 | sub ACTION_checkgit { 133 | my $self = shift; 134 | 135 | unless ( -d '.git' ) { 136 | $self->log_warn("\n*** This does not seem to be a git repository. Checks disabled ***\n"); 137 | return 1; 138 | } 139 | 140 | eval { require Git::Wrapper; 1 } 141 | or die "Git::Wrapper must be installed to check the distribution.\n"; 142 | 143 | my $git = Git::Wrapper->new('.'); 144 | my @repos = $git->remote; 145 | if ( ! grep { /\Aorigin\z/ } @repos ) { 146 | die "You have no 'origin' repository. Aborting!\n" 147 | } 148 | 149 | # Are we on the master branch? 150 | $self->log_info("Checking current branch...\n"); 151 | my @branches = $git->branch; 152 | my ($cur_branch) = grep { /\A\*\s*\w/ } @branches; 153 | die "Can't determine current branch\n" unless $cur_branch; 154 | $cur_branch =~ s{\A\*\s+}{}; 155 | if ( $cur_branch ne 'master' ) { 156 | unless ( $self->y_n("Are you sure you want to tag the '$cur_branch' branch?", 'n') ) { 157 | die "Aborting!\n"; 158 | } 159 | } 160 | 161 | # files checked in 162 | $self->log_info("Checking for files that aren't checked in...\n"); 163 | my @diff = $git->diff('HEAD'); 164 | if ( @diff ) { 165 | $self->log_warn( "Some files not checked in. Aborting!\n\n" ); 166 | $self->log_warn( join( "\n", $git->diff('--stat') ) . "\n" ); 167 | exit 1; 168 | } 169 | 170 | # check that we're up to date 171 | $self->log_info("Checking for differences from origin...\n"); 172 | my @refs = split q{ }, join( "\n", $git->show_ref("refs/heads/$cur_branch", "refs/remotes/origin/$cur_branch")); 173 | if ( ! ($refs[0] eq $refs[2] )) { 174 | $self->log_warn( "Local repo not in sync with origin. Aborting!\n"); 175 | $self->log_warn( "\n$cur_branch refs:\n" ); 176 | $self->log_warn( "$_\n" ) for $git->show_ref($cur_branch); 177 | exit 1; 178 | } 179 | 180 | } 181 | 182 | sub ACTION_tag_git { 183 | my $self = shift; 184 | 185 | unless ( -d '.git' ) { 186 | $self->log_warn("\n*** This does not seem to be a git repository. Tagging disabled ***\n"); 187 | return 1; 188 | } 189 | 190 | eval { require Git::Wrapper; 1 } 191 | or die "Git::Wrapper must be installed to check the distribution.\n"; 192 | 193 | my $git = Git::Wrapper->new('.'); 194 | my $tag = $self->dist_version; 195 | $self->log_info("Tagging HEAD as $tag\n"); 196 | $git->tag('-m', "tagging $tag", $tag); 197 | $self->log_info("Pushing tags to origin\n"); 198 | $git->push('--tags'); 199 | return 1; 200 | } 201 | 202 | sub ACTION_checkchanges { 203 | my $self = shift; 204 | 205 | # Changes 206 | $self->log_info( "Here is the start of Changes:" ); 207 | system("head -10 Changes"); 208 | unless ( $self->y_n("Have you updated the Changes file with the tag and date?", 'n') ) { 209 | die "Aborting!\n"; 210 | } 211 | 212 | return 1; 213 | } 214 | 215 | 216 | 217 | 218 | 1; 219 | -------------------------------------------------------------------------------- /inc/Perl/OSType.pm: -------------------------------------------------------------------------------- 1 | # 2 | # This file is part of Perl-OSType 3 | # 4 | # This software is copyright (c) 2010 by David Golden. 5 | # 6 | # This is free software; you can redistribute it and/or modify it under 7 | # the same terms as the Perl 5 programming language system itself. 8 | # 9 | use strict; 10 | use warnings; 11 | package Perl::OSType; 12 | BEGIN { 13 | $Perl::OSType::VERSION = '1.002'; 14 | } 15 | # ABSTRACT: Map Perl operating system names to generic types 16 | 17 | require Exporter; 18 | our @ISA = qw(Exporter); 19 | 20 | our %EXPORT_TAGS = ( 21 | all => [ qw( os_type is_os_type ) ] 22 | ); 23 | 24 | our @EXPORT_OK = @{ $EXPORT_TAGS{all} }; 25 | 26 | # originally taken from Module::Build by Ken Williams et al. 27 | my %OSTYPES = qw( 28 | aix Unix 29 | bsdos Unix 30 | beos Unix 31 | dgux Unix 32 | dragonfly Unix 33 | dynixptx Unix 34 | freebsd Unix 35 | linux Unix 36 | haiku Unix 37 | hpux Unix 38 | iphoneos Unix 39 | irix Unix 40 | darwin Unix 41 | machten Unix 42 | midnightbsd Unix 43 | mirbsd Unix 44 | next Unix 45 | openbsd Unix 46 | netbsd Unix 47 | dec_osf Unix 48 | nto Unix 49 | svr4 Unix 50 | svr5 Unix 51 | sco_sv Unix 52 | unicos Unix 53 | unicosmk Unix 54 | solaris Unix 55 | sunos Unix 56 | cygwin Unix 57 | os2 Unix 58 | interix Unix 59 | gnu Unix 60 | gnukfreebsd Unix 61 | nto Unix 62 | qnx Unix 63 | 64 | dos Windows 65 | MSWin32 Windows 66 | 67 | os390 EBCDIC 68 | os400 EBCDIC 69 | posix-bc EBCDIC 70 | vmesa EBCDIC 71 | 72 | MacOS MacOS 73 | VMS VMS 74 | VOS VOS 75 | riscos RiscOS 76 | amigaos Amiga 77 | mpeix MPEiX 78 | ); 79 | 80 | sub os_type { 81 | my ($os) = @_; 82 | $os = $^O unless defined $os; 83 | return $OSTYPES{ $os } || q{}; 84 | } 85 | 86 | sub is_os_type { 87 | my ($type, $os) = @_; 88 | return unless $type; 89 | $os = $^O unless defined $os; 90 | return os_type($os) eq $type; 91 | } 92 | 93 | 1; 94 | 95 | 96 | =pod 97 | 98 | =head1 NAME 99 | 100 | Perl::OSType - Map Perl operating system names to generic types 101 | 102 | =head1 VERSION 103 | 104 | version 1.002 105 | 106 | =head1 SYNOPSIS 107 | 108 | use Perl::OSType ':all'; 109 | 110 | $current_type = os_type(); 111 | $other_type = os_type('dragonfly'); # gives 'Unix' 112 | 113 | =head1 DESCRIPTION 114 | 115 | Modules that provide OS-specific behaviors often need to know if 116 | the current operating system matches a more generic type of 117 | operating systems. For example, 'linux' is a type of 'Unix' operating system 118 | and so is 'freebsd'. 119 | 120 | This module provides a mapping between an operating system name as given by 121 | C<$^O> and a more generic type. The initial version is based on the OS type 122 | mappings provided in L and L. (Thus, 123 | Microsoft operating systems are given the type 'Windows' rather than 'Win32'.) 124 | 125 | =head1 USAGE 126 | 127 | No functions are exported by default. The export tag ":all" will export 128 | all functions listed below. 129 | 130 | =head2 os_type() 131 | 132 | $os_type = os_type(); 133 | $os_type = os_type('MSWin32'); 134 | 135 | Returns a single, generic OS type for a given operating system name. With no 136 | arguments, returns the OS type for the current value of C<$^O>. If the 137 | operating system is not recognized, the function will return the empty string. 138 | 139 | =head2 is_os_type() 140 | 141 | $is_windows = is_os_type('Windows'); 142 | $is_unix = is_os_type('Unix', 'dragonfly'); 143 | 144 | Given an OS type and OS name, returns true or false if the OS name is of the 145 | given type. As with C, it will use the current operating system as a 146 | default if no OS name is provided. 147 | 148 | =head1 SEE ALSO 149 | 150 | =over 4 151 | 152 | =item * 153 | 154 | L 155 | 156 | =back 157 | 158 | =head1 AUTHOR 159 | 160 | David Golden 161 | 162 | =head1 COPYRIGHT AND LICENSE 163 | 164 | This software is copyright (c) 2010 by David Golden. 165 | 166 | This is free software; you can redistribute it and/or modify it under 167 | the same terms as the Perl 5 programming language system itself. 168 | 169 | =cut 170 | 171 | 172 | __END__ 173 | 174 | 175 | -------------------------------------------------------------------------------- /inc/bootstrap.pl: -------------------------------------------------------------------------------- 1 | # bootstrap.pl 2 | # bootstrap modules in inc/ for use during configuration with 3 | # either Build.PL or Makefile.PL 4 | 5 | my @exit_warn; 6 | 7 | END { 8 | warn "\nThese additional prerequisites must be installed:\n requires:\n" 9 | if @exit_warn; 10 | while( my $h = shift @exit_warn ) { 11 | my ($mod, $min) = @$h; 12 | warn " ! $mod (we need version $min)\n"; 13 | } 14 | } 15 | 16 | BEGIN { 17 | if ( ! eval "use Perl::OSType 1 (); 1" ) { 18 | print "*** BOOTSTRAPPING Perl::OSType ***\n"; 19 | push @exit_warn, [ 'Perl::OSType', '1.00' ]; 20 | delete $INC{'Perl/OSType.pm'}; 21 | local @INC = @INC; 22 | push @INC, 'inc'; 23 | eval "require Perl::OSType; 1" 24 | or die "BOOSTRAP FAIL: $@"; 25 | } 26 | if ( ! eval "use version 0.87 (); 1" ) { 27 | print "*** BOOTSTRAPPING version ***\n"; 28 | push @exit_warn, [ 'version', '0.87' ]; 29 | delete $INC{'version.pm'}; 30 | local @INC = @INC; 31 | push @INC, 'inc'; 32 | eval "require MBVersion; 1" 33 | or die "BOOSTRAP FAIL: $@"; 34 | } 35 | if ( ! eval "use Module::Metadata 1.000002 (); 1" ) { 36 | print "*** BOOTSTRAPPING Module::Metadata ***\n"; 37 | push @exit_warn, [ 'Module::Metadata', '1.000002' ]; 38 | delete $INC{'Module/Metadata.pm'}; 39 | local @INC = @INC; 40 | push @INC, 'inc'; 41 | eval "require Module::Metadata; 1" 42 | or die "BOOSTRAP FAIL: $@"; 43 | } 44 | } 45 | 46 | 1; 47 | 48 | -------------------------------------------------------------------------------- /lib/Module/Build/Bundling.pod: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | Module::Build::Bundling - How to bundle Module::Build with a distribution 4 | 5 | =head1 SYNOPSIS 6 | 7 | # Build.PL 8 | use inc::latest 'Module::Build'; 9 | 10 | Module::Build->new( 11 | module_name => 'Foo::Bar', 12 | license => 'perl', 13 | )->create_build_script; 14 | 15 | =head1 DESCRIPTION 16 | 17 | B 18 | 19 | In order to install a distribution using Module::Build, users must 20 | have Module::Build available on their systems. There are two ways 21 | to do this. The first way is to include Module::Build in the 22 | C metadata field. This field is supported by 23 | recent versions L and L and is a standard feature 24 | in the Perl core as of Perl 5.10.1. Module::Build now adds itself 25 | to C by default. 26 | 27 | The second way supports older Perls that have not upgraded CPAN or 28 | CPANPLUS and involves bundling an entire copy of Module::Build 29 | into the distribution's C directory. This is the same approach 30 | used by L, a modern wrapper around ExtUtils::MakeMaker 31 | for Makefile.PL based distributions. 32 | 33 | The "trick" to making this work for Module::Build is making sure the 34 | highest version Module::Build is used, whether this is in C or 35 | already installed on the user's system. This ensures that all necessary 36 | features are available as well as any new bug fixes. This is done using 37 | the experimental L module, available on CPAN. 38 | 39 | A "normal" Build.PL looks like this (with only the minimum required 40 | fields): 41 | 42 | use Module::Build; 43 | 44 | Module::Build->new( 45 | module_name => 'Foo::Bar', 46 | license => 'perl', 47 | )->create_build_script; 48 | 49 | A "bundling" Build.PL replaces the initial "use" line with a nearly 50 | transparent replacement: 51 | 52 | use inc::latest 'Module::Build'; 53 | 54 | Module::Build->new( 55 | module_name => 'Foo::Bar', 56 | license => 'perl', 57 | )->create_build_script; 58 | 59 | For I, when "Build dist" is run, Module::Build will be 60 | automatically bundled into C according to the rules for 61 | L. 62 | 63 | For I, inc::latest will load the latest Module::Build, whether 64 | installed or bundled in C. 65 | 66 | =head1 BUNDLING OTHER CONFIGURATION DEPENDENCIES 67 | 68 | The same approach works for other configuration dependencies -- modules 69 | that I be available for Build.PL to run. All other dependencies can 70 | be specified as usual in the Build.PL and CPAN or CPANPLUS will install 71 | them after Build.PL finishes. 72 | 73 | For example, to bundle the L module (which ensures a 74 | "Unix-like" operating system), one could do this: 75 | 76 | use inc::latest 'Devel::AssertOS::Unix'; 77 | use inc::latest 'Module::Build'; 78 | 79 | Module::Build->new( 80 | module_name => 'Foo::Bar', 81 | license => 'perl', 82 | )->create_build_script; 83 | 84 | The C module creates bundled directories based on the packlist 85 | file of an installed distribution. Even though C takes module 86 | name arguments, it is better to think of it as bundling and making 87 | available entire I. When a module is loaded through 88 | C, it looks in all bundled distributions in C for a 89 | newer module than can be found in the existing C<@INC> array. 90 | 91 | Thus, the module-name provided should usually be the "top-level" module 92 | name of a distribution, though this is not strictly required. For example, 93 | L has a number of heuristics to map module names to 94 | packlists, allowing users to do things like this: 95 | 96 | use inc::latest 'Devel::AssertOS::Unix'; 97 | 98 | even though Devel::AssertOS::Unix is contained within the Devel-CheckOS 99 | distribution. 100 | 101 | At the current time, packlists are required. Thus, bundling dual-core 102 | modules, I, may require a 'forced install' over 103 | versions in the latest version of perl in order to create the necessary 104 | packlist for bundling. This limitation will hopefully be addressed in a 105 | future version of Module::Build. 106 | 107 | =head2 WARNING -- How to Manage Dependency Chains 108 | 109 | Before bundling a distribution you must ensure that all prerequisites are 110 | also bundled and load in the correct order. For Module::Build itself, this 111 | should not be necessary, but it is necessary for any other distribution. 112 | (A future release of Module::Build will hopefully address this deficiency.) 113 | 114 | For example, if you need C, but C depends on C, 115 | your Build.PL might look like this: 116 | 117 | use inc::latest 'Wobble'; 118 | use inc::latest 'Wibble'; 119 | use inc::latest 'Module::Build'; 120 | 121 | Module::Build->new( 122 | module_name => 'Foo::Bar', 123 | license => 'perl', 124 | )->create_build_script; 125 | 126 | Authors are strongly suggested to limit the bundling of additional 127 | dependencies if at all possible and to carefully test their distribution 128 | tarballs on older versions of Perl before uploading to CPAN. 129 | 130 | =head1 AUTHOR 131 | 132 | David Golden 133 | 134 | Development questions, bug reports, and patches should be sent to the 135 | Module-Build mailing list at . 136 | 137 | Bug reports are also welcome at 138 | . 139 | 140 | =head1 SEE ALSO 141 | 142 | perl(1), L, L(3), L(3), 143 | L(3), 144 | 145 | =cut 146 | 147 | # vim: tw=75 148 | -------------------------------------------------------------------------------- /lib/Module/Build/Config.pm: -------------------------------------------------------------------------------- 1 | package Module::Build::Config; 2 | 3 | use strict; 4 | use warnings; 5 | our $VERSION = '0.42_35'; 6 | $VERSION = eval $VERSION; 7 | use Config; 8 | 9 | sub new { 10 | my ($pack, %args) = @_; 11 | return bless { 12 | stack => {}, 13 | values => $args{values} || {}, 14 | }, $pack; 15 | } 16 | 17 | sub get { 18 | my ($self, $key) = @_; 19 | return $self->{values}{$key} if ref($self) && exists $self->{values}{$key}; 20 | return $Config{$key}; 21 | } 22 | 23 | sub set { 24 | my ($self, $key, $val) = @_; 25 | $self->{values}{$key} = $val; 26 | } 27 | 28 | sub push { 29 | my ($self, $key, $val) = @_; 30 | push @{$self->{stack}{$key}}, $self->{values}{$key} 31 | if exists $self->{values}{$key}; 32 | $self->{values}{$key} = $val; 33 | } 34 | 35 | sub pop { 36 | my ($self, $key) = @_; 37 | 38 | my $val = delete $self->{values}{$key}; 39 | if ( exists $self->{stack}{$key} ) { 40 | $self->{values}{$key} = pop @{$self->{stack}{$key}}; 41 | delete $self->{stack}{$key} unless @{$self->{stack}{$key}}; 42 | } 43 | 44 | return $val; 45 | } 46 | 47 | sub values_set { 48 | my $self = shift; 49 | return undef unless ref($self); 50 | return $self->{values}; 51 | } 52 | 53 | sub all_config { 54 | my $self = shift; 55 | my $v = ref($self) ? $self->{values} : {}; 56 | return {%Config, %$v}; 57 | } 58 | 59 | 1; 60 | -------------------------------------------------------------------------------- /lib/Module/Build/Dumper.pm: -------------------------------------------------------------------------------- 1 | package Module::Build::Dumper; 2 | use strict; 3 | use warnings; 4 | our $VERSION = '0.42_35'; 5 | 6 | # This is just a split-out of a wrapper function to do Data::Dumper 7 | # stuff "the right way". See: 8 | # http://groups.google.com/group/perl.module.build/browse_thread/thread/c8065052b2e0d741 9 | 10 | use Data::Dumper; 11 | 12 | sub _data_dump { 13 | my ($self, $data) = @_; 14 | return ("do{ my " 15 | . Data::Dumper->new([$data],['x'])->Purity(1)->Terse(0)->Sortkeys(1)->Dump() 16 | . '$x; }') 17 | } 18 | 19 | 1; 20 | -------------------------------------------------------------------------------- /lib/Module/Build/PPMMaker.pm: -------------------------------------------------------------------------------- 1 | package Module::Build::PPMMaker; 2 | 3 | use strict; 4 | use warnings; 5 | use Config; 6 | 7 | our $VERSION = '0.42_35'; 8 | $VERSION = eval $VERSION; 9 | 10 | # This code is mostly borrowed from ExtUtils::MM_Unix 6.10_03, with a 11 | # few tweaks based on the PPD spec at 12 | # http://www.xav.com/perl/site/lib/XML/PPD.html 13 | 14 | # The PPD spec is based on 15 | 16 | sub new { 17 | my $package = shift; 18 | return bless {@_}, $package; 19 | } 20 | 21 | sub make_ppd { 22 | my ($self, %args) = @_; 23 | my $build = delete $args{build}; 24 | 25 | my @codebase; 26 | if (exists $args{codebase}) { 27 | @codebase = ref $args{codebase} ? @{$args{codebase}} : ($args{codebase}); 28 | } else { 29 | my $distfile = $build->ppm_name . '.tar.gz'; 30 | print "Using default codebase '$distfile'\n"; 31 | @codebase = ($distfile); 32 | } 33 | 34 | my %dist; 35 | foreach my $info (qw(name author abstract version)) { 36 | my $method = "dist_$info"; 37 | $dist{$info} = $build->$method() or die "Can't determine distribution's $info\n"; 38 | } 39 | 40 | $self->_simple_xml_escape($_) foreach $dist{abstract}, @{$dist{author}}; 41 | 42 | # TODO: could add tag if we knew what the URLs were for 43 | # various licenses 44 | my $ppd = <<"PPD"; 45 | 46 | $dist{abstract} 47 | @{[ join "\n", map " $_", @{$dist{author}} ]} 48 | 49 | PPD 50 | 51 | # We don't include recommended dependencies because PPD has no way 52 | # to distinguish them from normal dependencies. We don't include 53 | # build_requires dependencies because the PPM installer doesn't 54 | # build or test before installing. And obviously we don't include 55 | # conflicts either. 56 | 57 | foreach my $type (qw(requires)) { 58 | my $prereq = $build->$type(); 59 | foreach my $modname (sort keys %$prereq) { 60 | next if $modname eq 'perl'; 61 | 62 | my $min_version = '0.0'; 63 | foreach my $c ($build->_parse_conditions($prereq->{$modname})) { 64 | my ($op, $version) = $c =~ /^\s* (<=?|>=?|==|!=) \s* ([\w.]+) \s*$/x; 65 | 66 | # This is a nasty hack because it fails if there is no >= op 67 | if ($op eq '>=') { 68 | $min_version = $version; 69 | last; 70 | } 71 | } 72 | 73 | # PPM4 spec requires a '::' for top level modules 74 | $modname .= '::' unless $modname =~ /::/; 75 | 76 | $ppd .= qq! \n!; 77 | } 78 | } 79 | 80 | # We only include these tags if this module involves XS, on the 81 | # assumption that pure Perl modules will work on any OS. 82 | if (keys %{$build->find_xs_files}) { 83 | my $perl_version = $self->_ppd_version($build->perl_version); 84 | $ppd .= sprintf(<<'EOF', $self->_varchname($build->config) ); 85 | 86 | EOF 87 | } 88 | 89 | foreach my $codebase (@codebase) { 90 | $self->_simple_xml_escape($codebase); 91 | $ppd .= sprintf(<<'EOF', $codebase); 92 | 93 | EOF 94 | } 95 | 96 | $ppd .= <<'EOF'; 97 | 98 | 99 | EOF 100 | 101 | my $ppd_file = "$dist{name}.ppd"; 102 | open(my $fh, '>', $ppd_file) 103 | or die "Cannot write to $ppd_file: $!"; 104 | 105 | binmode($fh, ":utf8") 106 | if $] >= 5.008 && $Config{useperlio}; 107 | print $fh $ppd; 108 | close $fh; 109 | 110 | return $ppd_file; 111 | } 112 | 113 | sub _ppd_version { 114 | my ($self, $version) = @_; 115 | 116 | # generates something like "0,18,0,0" 117 | return join ',', (split(/\./, $version), (0)x4)[0..3]; 118 | } 119 | 120 | sub _varchname { # Copied from PPM.pm 121 | my ($self, $config) = @_; 122 | my $varchname = $config->{archname}; 123 | # Append "-5.8" to architecture name for Perl 5.8 and later 124 | if ($] >= 5.008) { 125 | my $vstring = sprintf "%vd", $^V; 126 | $vstring =~ s/\.\d+$//; 127 | $varchname .= "-$vstring"; 128 | } 129 | return $varchname; 130 | } 131 | 132 | { 133 | my %escapes = ( 134 | "\n" => "\\n", 135 | '"' => '"', 136 | '&' => '&', 137 | '>' => '>', 138 | '<' => '<', 139 | ); 140 | my $rx = join '|', keys %escapes; 141 | 142 | sub _simple_xml_escape { 143 | $_[1] =~ s/($rx)/$escapes{$1}/go; 144 | } 145 | } 146 | 147 | 1; 148 | __END__ 149 | 150 | 151 | =head1 NAME 152 | 153 | Module::Build::PPMMaker - Perl Package Manager file creation 154 | 155 | =head1 SYNOPSIS 156 | 157 | On the command line, builds a .ppd file: 158 | ./Build ppd 159 | 160 | 161 | =head1 DESCRIPTION 162 | 163 | This package contains the code that builds F<.ppd> "Perl Package 164 | Description" files, in support of ActiveState's "Perl Package 165 | Manager". Details are here: 166 | L 167 | 168 | 169 | =head1 AUTHOR 170 | 171 | Dave Rolsky , Ken Williams 172 | 173 | 174 | =head1 COPYRIGHT 175 | 176 | Copyright (c) 2001-2006 Ken Williams. All rights reserved. 177 | 178 | This library is free software; you can redistribute it and/or 179 | modify it under the same terms as Perl itself. 180 | 181 | 182 | =head1 SEE ALSO 183 | 184 | perl(1), Module::Build(3) 185 | 186 | =cut 187 | -------------------------------------------------------------------------------- /lib/Module/Build/Platform/Default.pm: -------------------------------------------------------------------------------- 1 | package Module::Build::Platform::Default; 2 | 3 | use strict; 4 | use warnings; 5 | our $VERSION = '0.42_35'; 6 | $VERSION = eval $VERSION; 7 | use Module::Build::Base; 8 | 9 | our @ISA = qw(Module::Build::Base); 10 | 11 | 1; 12 | __END__ 13 | 14 | 15 | =head1 NAME 16 | 17 | Module::Build::Platform::Default - Stub class for unknown platforms 18 | 19 | =head1 DESCRIPTION 20 | 21 | The sole purpose of this module is to inherit from 22 | C. Please see the L for the docs. 23 | 24 | =head1 AUTHOR 25 | 26 | Ken Williams 27 | 28 | =head1 SEE ALSO 29 | 30 | perl(1), Module::Build(3), ExtUtils::MakeMaker(3) 31 | 32 | =cut 33 | -------------------------------------------------------------------------------- /lib/Module/Build/Platform/MacOS.pm: -------------------------------------------------------------------------------- 1 | package Module::Build::Platform::MacOS; 2 | 3 | use strict; 4 | use warnings; 5 | our $VERSION = '0.42_35'; 6 | $VERSION = eval $VERSION; 7 | use Module::Build::Base; 8 | our @ISA = qw(Module::Build::Base); 9 | 10 | use ExtUtils::Install; 11 | 12 | sub have_forkpipe { 0 } 13 | 14 | sub new { 15 | my $class = shift; 16 | my $self = $class->SUPER::new(@_); 17 | 18 | # $Config{sitelib} and $Config{sitearch} are, unfortunately, missing. 19 | foreach ('sitelib', 'sitearch') { 20 | $self->config($_ => $self->config("install$_")) 21 | unless $self->config($_); 22 | } 23 | 24 | # For some reason $Config{startperl} is filled with a bunch of crap. 25 | (my $sp = $self->config('startperl')) =~ s/.*Exit \{Status\}\s//; 26 | $self->config(startperl => $sp); 27 | 28 | return $self; 29 | } 30 | 31 | sub make_executable { 32 | my $self = shift; 33 | require MacPerl; 34 | foreach (@_) { 35 | MacPerl::SetFileInfo('McPL', 'TEXT', $_); 36 | } 37 | } 38 | 39 | sub dispatch { 40 | my $self = shift; 41 | 42 | if( !@_ and !@ARGV ) { 43 | require MacPerl; 44 | 45 | # What comes first in the action list. 46 | my @action_list = qw(build test install); 47 | my %actions = map {+($_, 1)} $self->known_actions; 48 | delete @actions{@action_list}; 49 | push @action_list, sort { $a cmp $b } keys %actions; 50 | 51 | my %toolserver = map {+$_ => 1} qw(test disttest diff testdb); 52 | foreach (@action_list) { 53 | $_ .= ' *' if $toolserver{$_}; 54 | } 55 | 56 | my $cmd = MacPerl::Pick("What build command? ('*' requires ToolServer)", @action_list); 57 | return unless defined $cmd; 58 | $cmd =~ s/ \*$//; 59 | $ARGV[0] = ($cmd); 60 | 61 | my $args = MacPerl::Ask('Any extra arguments? (ie. verbose=1)', ''); 62 | return unless defined $args; 63 | push @ARGV, $self->split_like_shell($args); 64 | } 65 | 66 | $self->SUPER::dispatch(@_); 67 | } 68 | 69 | sub ACTION_realclean { 70 | my $self = shift; 71 | chmod 0666, $self->{properties}{build_script}; 72 | $self->SUPER::ACTION_realclean; 73 | } 74 | 75 | # ExtUtils::Install has a hard-coded '.' directory in versions less 76 | # than 1.30. We use a sneaky trick to turn that into ':'. 77 | # 78 | # Note that we do it here in a cross-platform way, so this code could 79 | # actually go in Module::Build::Base. But we put it here to be less 80 | # intrusive for other platforms. 81 | 82 | sub ACTION_install { 83 | my $self = shift; 84 | 85 | return $self->SUPER::ACTION_install(@_) 86 | if eval {ExtUtils::Install->VERSION('1.30'); 1}; 87 | 88 | local $^W = 0; # Avoid a 'redefine' warning 89 | local *ExtUtils::Install::find = sub { 90 | my ($code, @dirs) = @_; 91 | 92 | @dirs = map { $_ eq '.' ? File::Spec->curdir : $_ } @dirs; 93 | 94 | return File::Find::find($code, @dirs); 95 | }; 96 | 97 | return $self->SUPER::ACTION_install(@_); 98 | } 99 | 100 | 1; 101 | __END__ 102 | 103 | =head1 NAME 104 | 105 | Module::Build::Platform::MacOS - Builder class for MacOS platforms 106 | 107 | =head1 DESCRIPTION 108 | 109 | The sole purpose of this module is to inherit from 110 | C and override a few methods. Please see 111 | L for the docs. 112 | 113 | =head2 Overridden Methods 114 | 115 | =over 4 116 | 117 | =item new() 118 | 119 | MacPerl doesn't define $Config{sitelib} or $Config{sitearch} for some 120 | reason, but $Config{installsitelib} and $Config{installsitearch} are 121 | there. So we copy the install variables to the other location 122 | 123 | =item make_executable() 124 | 125 | On MacOS we set the file type and creator to MacPerl so it will run 126 | with a double-click. 127 | 128 | =item dispatch() 129 | 130 | Because there's no easy way to say "./Build test" on MacOS, if 131 | dispatch is called with no arguments and no @ARGV a dialog box will 132 | pop up asking what action to take and any extra arguments. 133 | 134 | Default action is "test". 135 | 136 | =item ACTION_realclean() 137 | 138 | Need to unlock the Build program before deleting. 139 | 140 | =back 141 | 142 | =head1 AUTHOR 143 | 144 | Michael G Schwern 145 | 146 | 147 | =head1 SEE ALSO 148 | 149 | perl(1), Module::Build(3), ExtUtils::MakeMaker(3) 150 | 151 | =cut 152 | -------------------------------------------------------------------------------- /lib/Module/Build/Platform/Unix.pm: -------------------------------------------------------------------------------- 1 | package Module::Build::Platform::Unix; 2 | 3 | use strict; 4 | use warnings; 5 | our $VERSION = '0.42_35'; 6 | $VERSION = eval $VERSION; 7 | use Module::Build::Base; 8 | 9 | our @ISA = qw(Module::Build::Base); 10 | 11 | sub is_executable { 12 | # We consider the owner bit to be authoritative on a file, because 13 | # -x will always return true if the user is root and *any* 14 | # executable bit is set. The -x test seems to try to answer the 15 | # question "can I execute this file", but I think we want "is this 16 | # file executable". 17 | 18 | my ($self, $file) = @_; 19 | return +(stat $file)[2] & 0100; 20 | } 21 | 22 | sub _startperl { "#! " . shift()->perl } 23 | 24 | sub _construct { 25 | my $self = shift()->SUPER::_construct(@_); 26 | 27 | # perl 5.8.1-RC[1-3] had some broken %Config entries, and 28 | # unfortunately Red Hat 9 shipped it like that. Fix 'em up here. 29 | my $c = $self->{config}; 30 | for (qw(siteman1 siteman3 vendorman1 vendorman3)) { 31 | $c->{"install${_}dir"} ||= $c->{"install${_}"}; 32 | } 33 | 34 | return $self; 35 | } 36 | 37 | # Open group says username should be portable filename characters, 38 | # but some Unix OS working with ActiveDirectory wind up with user-names 39 | # with back-slashes in the name. The new code below is very liberal 40 | # in what it accepts. 41 | sub _detildefy { 42 | my ($self, $value) = @_; 43 | $value =~ s[^~([^/]+)?(?=/|$)] # tilde with optional username 44 | [$1 ? 45 | (eval{(getpwnam $1)[7]} || "~$1") : 46 | ($ENV{HOME} || eval{(getpwuid $>)[7]} || glob("~")) 47 | ]ex; 48 | return $value; 49 | } 50 | 51 | 1; 52 | __END__ 53 | 54 | 55 | =head1 NAME 56 | 57 | Module::Build::Platform::Unix - Builder class for Unix platforms 58 | 59 | =head1 DESCRIPTION 60 | 61 | The sole purpose of this module is to inherit from 62 | C. Please see the L for the docs. 63 | 64 | =head1 AUTHOR 65 | 66 | Ken Williams 67 | 68 | =head1 SEE ALSO 69 | 70 | perl(1), Module::Build(3), ExtUtils::MakeMaker(3) 71 | 72 | =cut 73 | -------------------------------------------------------------------------------- /lib/Module/Build/Platform/VOS.pm: -------------------------------------------------------------------------------- 1 | package Module::Build::Platform::VOS; 2 | 3 | use strict; 4 | use warnings; 5 | our $VERSION = '0.42_35'; 6 | $VERSION = eval $VERSION; 7 | use Module::Build::Base; 8 | 9 | our @ISA = qw(Module::Build::Base); 10 | 11 | 12 | 1; 13 | __END__ 14 | 15 | 16 | =head1 NAME 17 | 18 | Module::Build::Platform::VOS - Builder class for VOS platforms 19 | 20 | =head1 DESCRIPTION 21 | 22 | The sole purpose of this module is to inherit from 23 | C. Please see the L for the docs. 24 | 25 | =head1 AUTHOR 26 | 27 | Ken Williams 28 | 29 | =head1 SEE ALSO 30 | 31 | perl(1), Module::Build(3), ExtUtils::MakeMaker(3) 32 | 33 | =cut 34 | -------------------------------------------------------------------------------- /lib/Module/Build/Platform/Windows.pm: -------------------------------------------------------------------------------- 1 | package Module::Build::Platform::Windows; 2 | 3 | use strict; 4 | use warnings; 5 | our $VERSION = '0.42_35'; 6 | $VERSION = eval $VERSION; 7 | 8 | use Config; 9 | use File::Basename; 10 | use File::Spec; 11 | 12 | use Module::Build::Base; 13 | 14 | our @ISA = qw(Module::Build::Base); 15 | 16 | 17 | sub manpage_separator { 18 | return '.'; 19 | } 20 | 21 | sub have_forkpipe { 0 } 22 | 23 | sub _detildefy { 24 | my ($self, $value) = @_; 25 | $value =~ s,^~(?= [/\\] | $ ),$ENV{HOME},x 26 | if $ENV{HOME}; 27 | return $value; 28 | } 29 | 30 | sub ACTION_realclean { 31 | my ($self) = @_; 32 | 33 | $self->SUPER::ACTION_realclean(); 34 | 35 | my $basename = basename($0); 36 | $basename =~ s/(?:\.bat)?$//i; 37 | 38 | if ( lc $basename eq lc $self->build_script ) { 39 | if ( $self->build_bat ) { 40 | $self->log_verbose("Deleting $basename.bat\n"); 41 | my $full_progname = $0; 42 | $full_progname =~ s/(?:\.bat)?$/.bat/i; 43 | 44 | # Voodoo required to have a batch file delete itself without error; 45 | # Syntax differs between 9x & NT: the later requires a null arg (???) 46 | require Win32; 47 | my $null_arg = (Win32::IsWinNT()) ? '""' : ''; 48 | my $cmd = qq(start $null_arg /min "\%comspec\%" /c del "$full_progname"); 49 | 50 | open(my $fh, '>>', "$basename.bat") 51 | or die "Can't create $basename.bat: $!"; 52 | print $fh $cmd; 53 | close $fh ; 54 | } else { 55 | $self->delete_filetree($self->build_script . '.bat'); 56 | } 57 | } 58 | } 59 | 60 | sub make_executable { 61 | my $self = shift; 62 | 63 | $self->SUPER::make_executable(@_); 64 | 65 | foreach my $script (@_) { 66 | 67 | # Native batch script 68 | if ( $script =~ /\.(bat|cmd)$/ ) { 69 | $self->SUPER::make_executable($script); 70 | next; 71 | 72 | # Perl script that needs to be wrapped in a batch script 73 | } else { 74 | my %opts = (); 75 | if ( $script eq $self->build_script ) { 76 | $opts{ntargs} = q(-x -S %0 --build_bat %*); 77 | $opts{otherargs} = q(-x -S "%0" --build_bat %1 %2 %3 %4 %5 %6 %7 %8 %9); 78 | } 79 | 80 | my $out = eval {$self->pl2bat(in => $script, update => 1, %opts)}; 81 | if ( $@ ) { 82 | $self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@"); 83 | } else { 84 | $self->SUPER::make_executable($out); 85 | } 86 | } 87 | } 88 | } 89 | 90 | sub pl2bat { 91 | my $self = shift; 92 | my %opts = @_; 93 | require ExtUtils::PL2Bat; 94 | return ExtUtils::PL2Bat::pl2bat(%opts); 95 | } 96 | 97 | 98 | sub _quote_args { 99 | # Returns a string that can become [part of] a command line with 100 | # proper quoting so that the subprocess sees this same list of args. 101 | my ($self, @args) = @_; 102 | 103 | my @quoted; 104 | 105 | for (@args) { 106 | if ( /^[^\s*?!\$<>;|'"\[\]\{\}]+$/ ) { 107 | # Looks pretty safe 108 | push @quoted, $_; 109 | } else { 110 | # XXX this will obviously have to improve - is there already a 111 | # core module lying around that does proper quoting? 112 | s/"/\\"/g; 113 | push @quoted, qq("$_"); 114 | } 115 | } 116 | 117 | return join " ", @quoted; 118 | } 119 | 120 | 121 | sub split_like_shell { 122 | # As it turns out, Windows command-parsing is very different from 123 | # Unix command-parsing. Double-quotes mean different things, 124 | # backslashes don't necessarily mean escapes, and so on. So we 125 | # can't use Text::ParseWords::shellwords() to break a command string 126 | # into words. The algorithm below was bashed out by Randy and Ken 127 | # (mostly Randy), and there are a lot of regression tests, so we 128 | # should feel free to adjust if desired. 129 | 130 | (my $self, local $_) = @_; 131 | 132 | return @$_ if defined() && ref() eq 'ARRAY'; 133 | 134 | my @argv; 135 | return @argv unless defined() && length(); 136 | 137 | my $length = length; 138 | m/\G\s*/gc; 139 | 140 | ARGS: until ( pos == $length ) { 141 | my $quote_mode; 142 | my $arg = ''; 143 | CHARS: until ( pos == $length ) { 144 | if ( m/\G((?:\\\\)+)(?=\\?(")?)/gc ) { 145 | if (defined $2) { 146 | $arg .= '\\' x (length($1) / 2); 147 | } 148 | else { 149 | $arg .= $1; 150 | } 151 | } 152 | elsif ( m/\G\\"/gc ) { 153 | $arg .= '"'; 154 | } 155 | elsif ( m/\G"/gc ) { 156 | if ( $quote_mode && m/\G"/gc ) { 157 | $arg .= '"'; 158 | } 159 | $quote_mode = !$quote_mode; 160 | } 161 | elsif ( !$quote_mode && m/\G\s+/gc ) { 162 | last; 163 | } 164 | elsif ( m/\G(.)/sgc ) { 165 | $arg .= $1; 166 | } 167 | } 168 | push @argv, $arg; 169 | } 170 | 171 | return @argv; 172 | } 173 | 174 | 175 | # system(@cmd) does not like having double-quotes in it on Windows. 176 | # So we quote them and run it as a single command. 177 | sub do_system { 178 | my ($self, @cmd) = @_; 179 | 180 | my $cmd = $self->_quote_args(@cmd); 181 | my $status = system($cmd); 182 | if ($status and $! =~ /Argument list too long/i) { 183 | my $env_entries = ''; 184 | foreach (sort keys %ENV) { $env_entries .= "$_=>".length($ENV{$_})."; " } 185 | warn "'Argument list' was 'too long', env lengths are $env_entries"; 186 | } 187 | return !$status; 188 | } 189 | 190 | # Copied from ExtUtils::MM_Win32 191 | sub _maybe_command { 192 | my($self,$file) = @_; 193 | my @e = exists($ENV{'PATHEXT'}) 194 | ? split(/;/, $ENV{PATHEXT}) 195 | : qw(.com .exe .bat .cmd); 196 | my $e = ''; 197 | for (@e) { $e .= "\Q$_\E|" } 198 | chop $e; 199 | # see if file ends in one of the known extensions 200 | if ($file =~ /($e)$/i) { 201 | return $file if -e $file; 202 | } 203 | else { 204 | for (@e) { 205 | return "$file$_" if -e "$file$_"; 206 | } 207 | } 208 | return; 209 | } 210 | 211 | 212 | 1; 213 | 214 | __END__ 215 | 216 | =head1 NAME 217 | 218 | Module::Build::Platform::Windows - Builder class for Windows platforms 219 | 220 | =head1 DESCRIPTION 221 | 222 | The sole purpose of this module is to inherit from 223 | C and override a few methods. Please see 224 | L for the docs. 225 | 226 | =head1 AUTHOR 227 | 228 | Ken Williams , Randy W. Sims 229 | 230 | =head1 SEE ALSO 231 | 232 | perl(1), Module::Build(3) 233 | 234 | =cut 235 | -------------------------------------------------------------------------------- /lib/Module/Build/Platform/aix.pm: -------------------------------------------------------------------------------- 1 | package Module::Build::Platform::aix; 2 | 3 | use strict; 4 | use warnings; 5 | our $VERSION = '0.42_35'; 6 | $VERSION = eval $VERSION; 7 | use Module::Build::Platform::Unix; 8 | 9 | our @ISA = qw(Module::Build::Platform::Unix); 10 | 11 | # This class isn't necessary anymore, but we can't delete it, because 12 | # some people might still have the old copy in their @INC, containing 13 | # code we don't want to execute, so we have to make sure an upgrade 14 | # will replace it with this empty subclass. 15 | 16 | 1; 17 | __END__ 18 | 19 | 20 | =head1 NAME 21 | 22 | Module::Build::Platform::aix - Builder class for AIX platform 23 | 24 | =head1 DESCRIPTION 25 | 26 | This module provides some routines very specific to the AIX 27 | platform. 28 | 29 | Please see the L for the general docs. 30 | 31 | =head1 AUTHOR 32 | 33 | Ken Williams 34 | 35 | =head1 SEE ALSO 36 | 37 | perl(1), Module::Build(3), ExtUtils::MakeMaker(3) 38 | 39 | =cut 40 | -------------------------------------------------------------------------------- /lib/Module/Build/Platform/cygwin.pm: -------------------------------------------------------------------------------- 1 | package Module::Build::Platform::cygwin; 2 | 3 | use strict; 4 | use warnings; 5 | our $VERSION = '0.42_35'; 6 | $VERSION = eval $VERSION; 7 | use Module::Build::Platform::Unix; 8 | 9 | our @ISA = qw(Module::Build::Platform::Unix); 10 | 11 | sub manpage_separator { 12 | '.' 13 | } 14 | 15 | # Copied from ExtUtils::MM_Cygwin::maybe_command() 16 | # If our path begins with F then we use the Windows version 17 | # to determine if it may be a command. Otherwise we use the tests 18 | # from C. 19 | 20 | sub _maybe_command { 21 | my ($self, $file) = @_; 22 | 23 | if ($file =~ m{^/cygdrive/}i) { 24 | require Module::Build::Platform::Windows; 25 | return Module::Build::Platform::Windows->_maybe_command($file); 26 | } 27 | 28 | return $self->SUPER::_maybe_command($file); 29 | } 30 | 31 | 1; 32 | __END__ 33 | 34 | 35 | =head1 NAME 36 | 37 | Module::Build::Platform::cygwin - Builder class for Cygwin platform 38 | 39 | =head1 DESCRIPTION 40 | 41 | This module provides some routines very specific to the cygwin 42 | platform. 43 | 44 | Please see the L for the general docs. 45 | 46 | =head1 AUTHOR 47 | 48 | Initial stub by Yitzchak Scott-Thoennes 49 | 50 | =head1 SEE ALSO 51 | 52 | perl(1), Module::Build(3), ExtUtils::MakeMaker(3) 53 | 54 | =cut 55 | -------------------------------------------------------------------------------- /lib/Module/Build/Platform/darwin.pm: -------------------------------------------------------------------------------- 1 | package Module::Build::Platform::darwin; 2 | 3 | use strict; 4 | use warnings; 5 | our $VERSION = '0.42_35'; 6 | $VERSION = eval $VERSION; 7 | use Module::Build::Platform::Unix; 8 | 9 | our @ISA = qw(Module::Build::Platform::Unix); 10 | 11 | # This class isn't necessary anymore, but we can't delete it, because 12 | # some people might still have the old copy in their @INC, containing 13 | # code we don't want to execute, so we have to make sure an upgrade 14 | # will replace it with this empty subclass. 15 | 16 | 1; 17 | __END__ 18 | 19 | 20 | =head1 NAME 21 | 22 | Module::Build::Platform::darwin - Builder class for Mac OS X platform 23 | 24 | =head1 DESCRIPTION 25 | 26 | This module provides some routines very specific to the Mac OS X 27 | platform. 28 | 29 | Please see the L for the general docs. 30 | 31 | =head1 AUTHOR 32 | 33 | Ken Williams 34 | 35 | =head1 SEE ALSO 36 | 37 | perl(1), Module::Build(3), ExtUtils::MakeMaker(3) 38 | 39 | =cut 40 | -------------------------------------------------------------------------------- /lib/Module/Build/Platform/os2.pm: -------------------------------------------------------------------------------- 1 | package Module::Build::Platform::os2; 2 | 3 | use strict; 4 | use warnings; 5 | our $VERSION = '0.42_35'; 6 | $VERSION = eval $VERSION; 7 | use Module::Build::Platform::Unix; 8 | 9 | our @ISA = qw(Module::Build::Platform::Unix); 10 | 11 | sub manpage_separator { '.' } 12 | 13 | sub have_forkpipe { 0 } 14 | 15 | # Copied from ExtUtils::MM_OS2::maybe_command 16 | sub _maybe_command { 17 | my($self,$file) = @_; 18 | $file =~ s,[/\\]+,/,g; 19 | return $file if -x $file && ! -d _; 20 | return "$file.exe" if -x "$file.exe" && ! -d _; 21 | return "$file.cmd" if -x "$file.cmd" && ! -d _; 22 | return; 23 | } 24 | 25 | 1; 26 | __END__ 27 | 28 | 29 | =head1 NAME 30 | 31 | Module::Build::Platform::os2 - Builder class for OS/2 platform 32 | 33 | =head1 DESCRIPTION 34 | 35 | This module provides some routines very specific to the OS/2 36 | platform. 37 | 38 | Please see the L for the general docs. 39 | 40 | =head1 AUTHOR 41 | 42 | Ken Williams 43 | 44 | =head1 SEE ALSO 45 | 46 | perl(1), Module::Build(3), ExtUtils::MakeMaker(3) 47 | 48 | =cut 49 | -------------------------------------------------------------------------------- /lib/Module/Build/PodParser.pm: -------------------------------------------------------------------------------- 1 | package Module::Build::PodParser; 2 | 3 | use strict; 4 | use warnings; 5 | our $VERSION = '0.42_35'; 6 | $VERSION = eval $VERSION; 7 | 8 | sub new { 9 | # Perl is so fun. 10 | my $package = shift; 11 | 12 | my $self; 13 | $self = bless {have_pod_parser => 0, @_}, $package; 14 | 15 | unless ($self->{fh}) { 16 | die "No 'file' or 'fh' parameter given" unless $self->{file}; 17 | open($self->{fh}, '<', $self->{file}) or die "Couldn't open $self->{file}: $!"; 18 | } 19 | 20 | return $self; 21 | } 22 | 23 | sub parse_from_filehandle { 24 | my ($self, $fh) = @_; 25 | 26 | local $_; 27 | while (<$fh>) { 28 | next unless /^ =encoding \s+ (\S+)/ix; 29 | binmode $fh, ":encoding($1)"; 30 | last; 31 | } 32 | seek $fh, 0, 0; 33 | 34 | while (<$fh>) { 35 | next unless /^=(?!cut)/ .. /^=cut/; # in POD 36 | # Accept Name - abstract or C - abstract 37 | last if ($self->{abstract}) = /^ (?: [a-z_0-9:]+ | [BCIF] < [a-z_0-9:]+ > ) \s+ - \s+ (.*\S) /ix; 38 | } 39 | 40 | my @author; 41 | while (<$fh>) { 42 | next unless /^=head1\s+AUTHORS?/i ... /^=/; 43 | next if /^=/; 44 | push @author, $_ if /\@/; 45 | } 46 | return unless @author; 47 | s/^\s+|\s+$//g foreach @author; 48 | 49 | $self->{author} = \@author; 50 | 51 | return; 52 | } 53 | 54 | sub get_abstract { 55 | my $self = shift; 56 | return $self->{abstract} if defined $self->{abstract}; 57 | 58 | $self->parse_from_filehandle($self->{fh}); 59 | 60 | return $self->{abstract}; 61 | } 62 | 63 | sub get_author { 64 | my $self = shift; 65 | return $self->{author} if defined $self->{author}; 66 | 67 | $self->parse_from_filehandle($self->{fh}); 68 | 69 | return $self->{author} || []; 70 | } 71 | -------------------------------------------------------------------------------- /t/00-compile.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | use MBTest; 5 | use File::Find qw/find/; 6 | 7 | my @files; 8 | find( sub { -f && /\.pm$/ && push @files, $File::Find::name }, 'lib' ); 9 | 10 | plan tests => scalar @files; 11 | 12 | for my $f ( sort @files ) { 13 | my $ec; 14 | my $output = stdout_stderr_of( sub { $ec = system( $^X, '-c', $f ) } ); 15 | ok( ! $ec, "compiling $f" ) or diag $output; 16 | } 17 | 18 | -------------------------------------------------------------------------------- /t/PL_files.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 8; 6 | use DistGen; 7 | blib_load('Module::Build'); 8 | 9 | my $dist; 10 | 11 | # Test that PL files don't get installed even in bin or lib 12 | { 13 | $dist = DistGen->new( dir => MBTest->tmpdir ); 14 | $dist->regen; 15 | $dist->chdir_in; 16 | 17 | my $distname = $dist->name; 18 | $dist->change_build_pl({ 19 | module_name => $distname, 20 | PL_files => { 21 | 'bin/foo.PL' => 'bin/foo', 22 | 'lib/Bar.pm.PL' => 'lib/Bar.pm', 23 | }, 24 | }); 25 | 26 | $dist->add_file("bin/foo.PL", <<'END'); 27 | open my $fh, ">", $ARGV[0] or die $!; 28 | print $fh "foo\n"; 29 | END 30 | 31 | $dist->add_file("lib/Bar.pm.PL", <<'END'); 32 | open my $fh, ">", $ARGV[0] or die $!; 33 | print $fh "bar\n"; 34 | END 35 | 36 | $dist->regen; 37 | 38 | my $mb = Module::Build->new_from_context( install_base => "test_install" ); 39 | $mb->dispatch("install"); 40 | 41 | ok -e "test_install/bin/foo", "Generated PL_files installed from bin"; 42 | ok -e "test_install/lib/perl5/Bar.pm", " and from lib"; 43 | 44 | ok !-e "test_install/bin/foo.PL", "PL_files not installed from bin"; 45 | ok !-e "test_install/lib/perl5/Bar.pm.PL", " nor from lib"; 46 | 47 | is slurp("test_install/bin/foo"), "foo\n", "Generated bin contains correct content"; 48 | is slurp("test_install/lib/perl5/Bar.pm"), "bar\n", " so does the lib"; 49 | 50 | $dist->chdir_original if $dist->did_chdir; 51 | } 52 | 53 | # Test an empty PL target list runs the PL but doesn't 54 | # add it to MANIFEST or cleanup 55 | { 56 | $dist = DistGen->new( dir => MBTest->tmpdir ); 57 | $dist->regen; 58 | $dist->chdir_in; 59 | 60 | my $distname = $dist->name; 61 | $dist->change_build_pl({ 62 | module_name => $distname, 63 | PL_files => { 64 | 'Special.PL' => [], 65 | }, 66 | }); 67 | 68 | $dist->add_file("Special.PL", <<'END'); 69 | open my $fh, ">", "foo" or die $!; 70 | print $fh "foo\n"; 71 | END 72 | 73 | $dist->regen; 74 | 75 | my $mb = Module::Build->new_from_context(); 76 | $mb->dispatch("code"); 77 | 78 | ok( -f "foo", "special PL file ran" ); 79 | 80 | my $cleanup = $mb->cleanup; 81 | 82 | my %cleanup = map { $_ => 1 } $mb->cleanup; 83 | is($cleanup{foo}, undef, "generated special file not added to cleanup"); 84 | 85 | $dist->chdir_original if $dist->did_chdir; 86 | } 87 | -------------------------------------------------------------------------------- /t/README.pod: -------------------------------------------------------------------------------- 1 | =head1 A GUIDE TO WRITING TESTS FOR MODULE::BUILD 2 | 3 | This document provides tips on writing new tests for Module::Build. Please 4 | note that many existing tests were written prior to these guidelines and 5 | have many different styles. Please don't copy/paste old tests by rote without 6 | considering better ways to test. See C for a starter test file. 7 | 8 | =head1 TEST FILE PREAMBLE 9 | 10 | Every Module::Build test should begin with the same preamble to ensure that the 11 | test library is set properly and that the correct version of Module::Build is 12 | being tested. 13 | 14 | use strict; 15 | use lib 't/lib'; 16 | use MBTest tests => 2; # or 'no_plan' 17 | 18 | blib_load('Module::Build'); 19 | 20 | The C module is in C and subclasses Test::More. When loaded 21 | it cleans up several environment variables that could cause problems, 22 | tweaks C<@INC> and exports several helper functions. See that module for 23 | details. 24 | 25 | =head1 CREATING A TEST DISTRIBUTION 26 | 27 | The C module in C should be used to create sample 28 | distributions for testing. It provides numerous helpful methods to 29 | create a skeleton distribution, add files, change files, and so on. 30 | Run C on C to see the documentation. 31 | 32 | # CREATE A TEST DISTRIBUTION 33 | 34 | use DistGen; 35 | 36 | # create dist object in a temp directory 37 | my $dist = DistGen->new; 38 | 39 | # enter the test distribution directory before further testing 40 | $dist->chdir_in; 41 | 42 | # generate the skeleton files 43 | $dist->regen; 44 | 45 | 46 | =head1 GETTING A MODULE::BUILD OBJECT 47 | 48 | From inside the test distribution, you can get the Module::Build object 49 | configured in Build.PL using the C method on the 50 | dist object. This is just like Module::Build's C except 51 | it passes C<< quiet => 1 >> to avoid sending output to the terminal. 52 | Use the Module::Build object to test the programmatic API. 53 | 54 | my $mb = $dist->new_from_context( quiet => 1 ); 55 | isa_ok( $mb, "Module::Build" ); 56 | is( $mb->dist_name, "Simple", "dist_name is 'Simple'" ); 57 | 58 | =head1 TESTING THE COMMAND LINE API 59 | 60 | The command line API is tested by running subprocesses, not via a Module::Build 61 | object. The C object has helper methods for running C and 62 | C and passing arguments on the command line. 63 | 64 | $dist->run_build_pl( '--quiet' ); 65 | $dist->run_build( 'test' ); 66 | 67 | =head1 TYPICAL TESTING CYCLE 68 | 69 | The typical testing cycle is to generate or modify a test distribution, either 70 | through the C object or directly in the filesystem, then regenerate 71 | the distribution and test it (or run command line tests and observe the 72 | result.) 73 | 74 | # Modify the distribution 75 | 76 | $dist->change_build_pl( 77 | { 78 | module_name => $dist->name, 79 | license => 'artistic', 80 | } 81 | ); 82 | $dist->regen; 83 | 84 | # Get a new build object and test it 85 | 86 | $mb = $dist->new_from_context; 87 | is( $mb->license, "artistic", "saw 'artistic' license" ); 88 | 89 | 90 | =head1 COPYRIGHT 91 | 92 | This documentation is Copyright (C) 2009 by David Golden. You can redistribute 93 | it and/or modify it under the same terms as Perl 5.10.0. 94 | 95 | -------------------------------------------------------------------------------- /t/actions/installdeps.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib 't/lib'; 3 | use MBTest; 4 | use DistGen; 5 | 6 | plan tests => 6; 7 | 8 | # Ensure any Module::Build modules are loaded from correct directory 9 | blib_load('Module::Build'); 10 | 11 | # create dist object in a temp directory 12 | # enter the directory and generate the skeleton files 13 | my $dist = DistGen->new->chdir_in; 14 | 15 | $dist->change_build_pl( 16 | module_name => $dist->name, 17 | requires => { 18 | 'File::Spec' => 9999, 19 | }, 20 | build_requires => { 21 | 'Getopt::Long' => 9998, 22 | }, 23 | cpan_client => qq{"$^X"} . ' -le print($_)for($^X,@ARGV)', 24 | )->regen; 25 | 26 | # get a Module::Build object and test with it 27 | my $mb; 28 | stdout_stderr_of( sub { $mb = $dist->new_from_context('verbose' => 1) } ); 29 | isa_ok( $mb, "Module::Build" ); 30 | like( $mb->cpan_client, qr/^"\Q$^X\E"/, "cpan_client is mocked with perl" ); 31 | 32 | my $retval; 33 | my $out = stdout_of( sub { 34 | $retval = $mb->dispatch('installdeps') 35 | }); 36 | ok( $retval, "ran mocked Build installdeps"); 37 | like( $out, qr/File::Spec/, "saw File::Spec prereq" ); 38 | like( $out, qr/Getopt::Long/, "saw Getopt::Long prereq" ); 39 | 40 | $out = stdout_stderr_of( sub { 41 | $retval = $mb->dispatch('installdeps', cpan_client => 'ADLKASJDFLASDJ'); 42 | }); 43 | ok( !$retval, "Build installdeps with bad cpan_client fails" ); 44 | 45 | # vim:ts=2:sw=2:et:sta:sts=2 46 | -------------------------------------------------------------------------------- /t/actions/manifest_skip.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib 't/lib'; 3 | use MBTest; 4 | use DistGen; 5 | 6 | plan tests => 7; 7 | 8 | # Ensure any Module::Build modules are loaded from correct directory 9 | blib_load('Module::Build'); 10 | 11 | # create dist object in a temp directory 12 | # enter the directory and generate the skeleton files 13 | my $dist = DistGen->new->chdir_in; 14 | $dist->change_build_pl( 15 | module_name => $dist->name, 16 | requires => { 17 | 'File::Spec' => 9999, 18 | }, 19 | build_requires => { 20 | 'Getopt::Long' => 9998, 21 | }, 22 | cpan_client => $^X . ' -le print($_)for($^X,@ARGV)', 23 | )->regen; 24 | 25 | ok( ! -e 'MANIFEST.SKIP', "MANIFEST.SKIP doesn't exist at start" ); 26 | 27 | # get a Module::Build object and test with it 28 | my $mb; 29 | stdout_stderr_of( sub { $mb = $dist->new_from_context('verbose' => 1) } ); 30 | isa_ok( $mb, "Module::Build" ); 31 | 32 | my ($out, $err) = stdout_stderr_of( sub { 33 | $dist->run_build('manifest_skip') 34 | }); 35 | ok( -e 'MANIFEST.SKIP', "'Build manifest_skip' creates MANIFEST.SKIP" ); 36 | like( $out, qr/Creating a new MANIFEST.SKIP file/, "Saw creation message"); 37 | 38 | # shouldn't overwrite 39 | my $old_mtime = -M 'MANIFEST.SKIP'; 40 | ($out, $err) = stdout_stderr_of( sub { 41 | $dist->run_build('manifest_skip') 42 | }); 43 | like( $err, qr/MANIFEST.SKIP already exists/, 44 | "Running it again warns about pre-existing MANIFEST.SKIP" 45 | ); 46 | is( -M 'MANIFEST.SKIP', $old_mtime, "File does not appear modified" ); 47 | 48 | # cleanup 49 | ($out, $err) = stdout_stderr_of( sub { 50 | $dist->run_build('distclean') 51 | }); 52 | ok( -e 'MANIFEST.SKIP', "MANIFEST.SKIP still exists after distclean" ); 53 | 54 | # vim:ts=2:sw=2:et:sta:sts=2 55 | -------------------------------------------------------------------------------- /t/add_property.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 27; 6 | #use MBTest 'no_plan'; 7 | use DistGen; 8 | 9 | blib_load 'Module::Build'; 10 | 11 | my $tmp = MBTest->tmpdir; 12 | my $dist = DistGen->new( dir => $tmp ); 13 | $dist->regen; 14 | $dist->chdir_in; 15 | 16 | ADDPROP: { 17 | package My::Build::Prop; 18 | use base 'Module::Build'; 19 | __PACKAGE__->add_property( 'foo' ); 20 | __PACKAGE__->add_property( 'bar', 'howdy' ); 21 | __PACKAGE__->add_property( 'baz', default => 'howdy' ); 22 | __PACKAGE__->add_property( 'code', default => sub { 'yay' } ); 23 | __PACKAGE__->add_property( 24 | 'check', 25 | default => sub { 'howdy' }, 26 | check => sub { 27 | return 1 if $_ eq 'howdy'; 28 | shift->property_error(qq{"$_" is invalid}); 29 | return 0; 30 | }, 31 | ); 32 | __PACKAGE__->add_property( 33 | 'hash', 34 | default => { foo => 1 }, 35 | check => sub { 36 | return 1 if !defined $_ or exists $_->{foo}; 37 | shift->property_error(qq{hash is invalid}); 38 | return 0; 39 | }, 40 | ); 41 | } 42 | 43 | ok my $build = My::Build::Prop->new( 44 | 'module_name' => 'Simple', 45 | quiet => 1, 46 | ), 'Create new build object'; 47 | 48 | is $build->foo, undef, 'Property "foo" should be undef'; 49 | ok $build->foo(42), 'Set "foo"'; 50 | is $build->foo, 42, 'Now "foo" should have new value'; 51 | 52 | is $build->bar, 'howdy', 'Property "bar" should be its default'; 53 | ok $build->bar('yo'), 'Set "bar"'; 54 | is $build->bar, 'yo', 'Now "bar" should have new value'; 55 | 56 | is $build->check, 'howdy', 'Property "check" should be its default'; 57 | 58 | eval { $build->check('yo') }; 59 | ok my $err = $@, 'Should get an error for an invalid value'; 60 | like $err, qr/^ERROR: "yo" is invalid/, 'It should be the correct error'; 61 | 62 | is $build->code, 'yay', 'Property "code" should have its code value'; 63 | 64 | is_deeply $build->hash, { foo => 1 }, 'Property "hash" should be default'; 65 | is $build->hash('foo'), 1, 'Should be able to get key in hash'; 66 | ok $build->hash( bar => 3 ), 'Add a key to the hash prop'; 67 | is_deeply $build->hash, { foo => 1, bar => 3 }, 'New key should be in hash'; 68 | 69 | eval { $build->hash({ bar => 3 }) }; 70 | ok $err = $@, 'Should get exception for assigning invalid hash'; 71 | like $err, qr/^ERROR: hash is invalid/, 'It should be the correct error'; 72 | 73 | eval { $build->hash( []) }; 74 | ok $err = $@, 'Should get exception for assigning an array for a hash'; 75 | like $err, qr/^Unexpected arguments for property 'hash'/, 76 | 'It should be the proper error'; 77 | is $build->hash(undef), undef, 'Should be able to set hash to undef'; 78 | 79 | # Check core properties. 80 | is $build->installdirs, 'site', 'Property "installdirs" should be default'; 81 | ok $build->installdirs('core'), 'Set "installdirst" to "core"'; 82 | is $build->installdirs, 'core', 'Now "installdirs" should be "core"'; 83 | 84 | eval { $build->installdirs('perl') }; 85 | ok $err = $@, 'Should have caught exception setting "installdirs" to "perl"'; 86 | like $err, qr/^ERROR: Perhaps you meant installdirs to be "core" rather than "perl"\?/, 87 | 'And it should suggest "core" in the error message'; 88 | 89 | eval { $build->installdirs('foo') }; 90 | ok $err = $@, 'Should catch exception for invalid "installdirs" value'; 91 | like $err, qr/ERROR: installdirs must be one of "core", "site", or "vendor"/, 92 | 'And it should suggest the proper values in the error message'; 93 | 94 | $dist->chdir_original if $dist->did_chdir; 95 | -------------------------------------------------------------------------------- /t/add_property_array.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 1; 6 | 7 | blib_load 'Module::Build'; 8 | 9 | ADDPROP: { 10 | package My::Build::Prop; 11 | use base 'Module::Build'; 12 | __PACKAGE__->add_property( 'list_property' => []); 13 | } 14 | 15 | ok grep { $_ eq 'bundle_inc' } My::Build::Prop->array_properties, "has bundle_inc even after adding another array property"; 16 | 17 | -------------------------------------------------------------------------------- /t/add_property_hash.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 1; 6 | 7 | blib_load 'Module::Build'; 8 | 9 | ADDPROP: { 10 | package My::Build::Prop; 11 | use base 'Module::Build'; 12 | __PACKAGE__->add_property( 'hash_property' => {}); 13 | } 14 | 15 | ok grep { $_ eq 'install_path' } My::Build::Prop->hash_properties, "has install_path even after adding another hash property"; 16 | 17 | -------------------------------------------------------------------------------- /t/bundle_inc.t: -------------------------------------------------------------------------------- 1 | # sample.t -- a sample test file for Module::Build 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; # or 'no_plan' 6 | use DistGen; 7 | use Config; 8 | use File::Spec; 9 | use ExtUtils::Packlist; 10 | use ExtUtils::Installed; 11 | use File::Path; 12 | 13 | # Ensure any Module::Build modules are loaded from correct directory 14 | blib_load('Module::Build'); 15 | blib_load('Module::Build::ConfigData'); 16 | 17 | if ( $ENV{PERL_CORE} ) { 18 | plan skip_all => 'bundle_inc tests will never succeed in PERL_CORE'; 19 | } 20 | elsif ( ! $ENV{MB_TEST_EXPERIMENTAL} ) { 21 | plan skip_all => '$ENV{MB_TEST_EXPERIMENTAL} is not set'; 22 | } 23 | elsif ( ! MBTest::check_EUI() ) { 24 | plan skip_all => 'ExtUtils::Installed takes too long on your system'; 25 | } 26 | elsif ( Module::Build::ConfigData->feature('inc_bundling_support') ) { 27 | plan tests => 19; 28 | } else { 29 | plan skip_all => 'inc_bundling_support feature is not enabled'; 30 | } 31 | 32 | # need to do a temp install of M::B being tested to ensure a packlist 33 | # is available for bundling 34 | 35 | my $current_mb = Module::Build->resume(); 36 | my $temp_install = MBTest->tmpdir(); 37 | my $arch = $Config{archname}; 38 | my $lib_path = File::Spec->catdir($temp_install,qw/lib perl5/); 39 | my $arch_path = File::Spec->catdir( $lib_path, $arch ); 40 | mkpath ( $arch_path ); 41 | ok( -d $arch_path, "created temporary M::B pseudo-install directory"); 42 | 43 | unshift @INC, $lib_path, $arch_path; 44 | local $ENV{PERL5LIB} = join( $Config{path_sep}, 45 | $lib_path, ($ENV{PERL5LIB} ? $ENV{PERL5LIB} : () ) 46 | ); 47 | 48 | # must uninst=0 so we don't try to remove an installed M::B! 49 | stdout_of( sub { $current_mb->dispatch( 50 | 'install', install_base => $temp_install, uninst => 0 51 | ) 52 | } 53 | ); 54 | 55 | # create dist object in a temp directory 56 | # enter the directory and generate the skeleton files 57 | my $dist = DistGen->new( inc => 1 )->chdir_in->regen; 58 | 59 | # get a Module::Build object and test with it 60 | my $mb = $dist->new_from_context(); # quiet by default 61 | isa_ok( $mb, "Module::Build" ); 62 | is( $mb->dist_name, "Simple", "dist_name is 'Simple'" ); 63 | is_deeply( $mb->bundle_inc, [ 'Module::Build' ], 64 | "Module::Build is flagged for bundling" 65 | ); 66 | 67 | # bundle stuff into distdir 68 | stdout_stderr_of( sub { $mb->dispatch('distdir') } ); 69 | 70 | my $dist_inc = File::Spec->catdir($mb->dist_dir, 'inc'); 71 | ok( -e File::Spec->catfile( $dist_inc, 'latest.pm' ), 72 | "dist_dir/inc/latest.pm created" 73 | ); 74 | 75 | ok( -d File::Spec->catdir( $dist_inc, 'inc_Module-Build' ), 76 | "dist_dir/inc/inc_Module_Build created" 77 | ); 78 | 79 | my $mb_file = 80 | File::Spec->catfile( $dist_inc, qw/inc_Module-Build Module Build.pm/ ); 81 | 82 | ok( -e $mb_file, 83 | "dist_dir/inc/inc_Module_Build/Module/Build.pm created" 84 | ); 85 | 86 | ok( -e File::Spec->catfile( $dist_inc, qw/inc_Module-Build Module Build Base.pm/ ), 87 | "dist_dir/inc/inc_Module_Build/Module/Build/Base.pm created" 88 | ); 89 | 90 | # Force bundled M::B to a higher version so it gets loaded 91 | # This has failed on Win32 for no known reason, so we'll skip if 92 | # we can't edit the file. 93 | 94 | eval { 95 | chmod 0666, $mb_file; 96 | open(my $fh, '<', $mb_file) or die "Could not read $mb_file: $!"; 97 | my $mb_code = do { local $/; <$fh> }; 98 | $mb_code =~ s{\$VERSION\s+=\s+\S+}{\$VERSION = 9999;}; 99 | close $fh; 100 | open($fh, '>', $mb_file) or die "Could not write $mb_file: $!"; 101 | print {$fh} $mb_code; 102 | close $fh; 103 | }; 104 | 105 | my $err = $@; 106 | diag $@ if $@; 107 | SKIP: { 108 | skip "Couldn't adjust \$VERSION in bundled M::B for testing", 10 109 | if $err; 110 | 111 | # test the bundling in dist_dir 112 | chdir $mb->dist_dir; 113 | 114 | stdout_of( sub { Module::Build->run_perl_script('Build.PL',[],[]) } ); 115 | ok( -e 'MYMETA.yml', 'MYMETA was created' ); 116 | 117 | open(my $meta, '<', 'MYMETA.yml'); 118 | ok( $meta, "opened MYMETA.yml" ); 119 | ok( scalar( grep { /generated_by:.*9999/ } <$meta> ), 120 | "dist_dir Build.PL loaded bundled Module::Build" 121 | ); 122 | close $meta; 123 | 124 | #--------------------------------------------------------------------------# 125 | # test identification of dependencies 126 | #--------------------------------------------------------------------------# 127 | 128 | $dist->chdir_in; 129 | 130 | $dist->add_file( 'mylib/Foo.pm', << 'HERE' ); 131 | package Foo; 132 | our $VERSION = 1; 133 | 1; 134 | HERE 135 | 136 | $dist->add_file( 'mylib/Bar.pm', << 'HERE' ); 137 | package Bar; 138 | use Foo; 139 | our $VERSION = 42; 140 | 1; 141 | HERE 142 | 143 | $dist->change_file( 'Build.PL', << "HERE" ); 144 | use inc::latest 'Module::Build'; 145 | use inc::latest 'Foo'; 146 | 147 | Module::Build->new( 148 | module_name => '$dist->{name}', 149 | license => 'perl', 150 | )->create_build_script; 151 | HERE 152 | 153 | $dist->regen( clean => 1 ); 154 | 155 | make_packlist($_,'mylib') for qw/Foo Bar/; 156 | 157 | # get a Module::Build object and test with it 158 | my $abs_mylib = File::Spec->rel2abs('mylib'); 159 | 160 | 161 | unshift @INC, $abs_mylib; 162 | $mb = $dist->new_from_context(); # quiet by default 163 | isa_ok( $mb, "Module::Build" ); 164 | is_deeply( [sort @{$mb->bundle_inc}], [ 'Foo', 'Module::Build' ], 165 | "Module::Build and Foo are flagged for bundling" 166 | ); 167 | 168 | my $output = stdout_stderr_of( sub { $mb->dispatch('distdir') } ); 169 | 170 | ok( -e File::Spec->catfile( $dist_inc, 'latest.pm' ), 171 | "./inc/latest.pm created" 172 | ); 173 | 174 | ok( -d File::Spec->catdir( $dist_inc, 'inc_Foo' ), 175 | "dist_dir/inc/inc_Foo created" 176 | ); 177 | 178 | $dist->change_file( 'Build.PL', << "HERE" ); 179 | use inc::latest 'Module::Build'; 180 | use inc::latest 'Bar'; 181 | 182 | Module::Build->new( 183 | module_name => '$dist->{name}', 184 | license => 'perl', 185 | )->create_build_script; 186 | HERE 187 | 188 | $dist->regen( clean => 1 ); 189 | make_packlist($_,'mylib') for qw/Foo Bar/; 190 | 191 | $mb = $dist->new_from_context(); # quiet by default 192 | isa_ok( $mb, "Module::Build" ); 193 | is_deeply( [sort @{$mb->bundle_inc}], [ 'Bar', 'Module::Build' ], 194 | "Module::Build and Bar are flagged for bundling" 195 | ); 196 | 197 | $output = stdout_stderr_of( sub { $mb->dispatch('distdir') } ); 198 | 199 | ok( -e File::Spec->catfile( $dist_inc, 'latest.pm' ), 200 | "./inc/latest.pm created" 201 | ); 202 | 203 | ok( -d File::Spec->catdir( $dist_inc, 'inc_Bar' ), 204 | "dist_dir/inc/inc_Bar created" 205 | ); 206 | } 207 | 208 | 209 | sub make_packlist { 210 | my ($mod, $lib) = @_; 211 | my $arch = $Config{archname}; 212 | (my $mod_path = $mod) =~ s{::}{/}g; 213 | my $mod_file = File::Spec->catfile( $lib, "$mod_path\.pm" ); 214 | my $abs = File::Spec->rel2abs($mod_file); 215 | my $packlist_path = File::Spec->catdir($lib, $arch, 'auto', $mod_path); 216 | mkpath $packlist_path; 217 | my $packlist = ExtUtils::Packlist->new; 218 | $packlist->{$abs}++; 219 | $packlist->write( File::Spec->catfile( $packlist_path, '.packlist' )); 220 | } 221 | 222 | # vim:ts=2:sw=2:et:sta:sts=2 223 | -------------------------------------------------------------------------------- /t/bundled/Software/License.pm: -------------------------------------------------------------------------------- 1 | # Modified from the original as a "mock" version for testing 2 | use strict; 3 | use warnings; 4 | use 5.006; # warnings 5 | package Software::License; 6 | our $VERSION = 9999; 7 | 8 | sub new { 9 | my ($class, $arg) = @_; 10 | 11 | # XXX changed from Carp::croak to die 12 | die "no copyright holder specified" unless $arg->{holder}; 13 | 14 | bless $arg => $class; 15 | } 16 | 17 | 18 | sub year { defined $_[0]->{year} ? $_[0]->{year} : (localtime)[5]+1900 } 19 | sub holder { $_[0]->{holder} } 20 | 21 | sub version { 22 | my ($self) = @_; 23 | my $pkg = ref $self ? ref $self : $self; 24 | $pkg =~ s/.+:://; 25 | my (undef, @vparts) = split /_/, $pkg; 26 | 27 | return unless @vparts; 28 | return join '.', @vparts; 29 | } 30 | 31 | 32 | # sub meta1_name { return undef; } # sort this out later, should be easy 33 | sub meta_name { return undef; } 34 | sub meta_yml_name { $_[0]->meta_name } 35 | 36 | sub meta2_name { 37 | my ($self) = @_; 38 | my $meta1 = $self->meta_name; 39 | 40 | return undef unless defined $meta1; 41 | 42 | return $meta1 43 | if $meta1 =~ /\A(?:open_source|restricted|unrestricted|unknown)\z/; 44 | 45 | return undef; 46 | } 47 | 48 | # XXX these are trivial mocks of the real thing 49 | sub notice { 'NOTICE' } 50 | sub license { 'LICENSE' } 51 | sub fulltext { 'FULLTEXT' } 52 | 53 | 1; 54 | 55 | 56 | 57 | -------------------------------------------------------------------------------- /t/bundled/Tie/CPHash.pm: -------------------------------------------------------------------------------- 1 | #--------------------------------------------------------------------- 2 | package Tie::CPHash; 3 | # 4 | # Copyright 1997 Christopher J. Madsen 5 | # 6 | # Author: Christopher J. Madsen 7 | # Created: 08 Nov 1997 8 | # $Revision$ $Date$ 9 | # 10 | # This program is free software; you can redistribute it and/or modify 11 | # it under the same terms as Perl itself. 12 | # 13 | # This program is distributed in the hope that it will be useful, 14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the 16 | # GNU General Public License or the Artistic License for more details. 17 | # 18 | # Case preserving but case insensitive hash 19 | #--------------------------------------------------------------------- 20 | 21 | require 5.000; 22 | use strict; 23 | use vars qw(@ISA $VERSION); 24 | 25 | @ISA = qw(); 26 | 27 | #===================================================================== 28 | # Package Global Variables: 29 | 30 | $VERSION = '1.02'; 31 | 32 | #===================================================================== 33 | # Tied Methods: 34 | #--------------------------------------------------------------------- 35 | # TIEHASH classname 36 | # The method invoked by the command `tie %hash, classname'. 37 | # Associates a new hash instance with the specified class. 38 | 39 | sub TIEHASH 40 | { 41 | bless {}, $_[0]; 42 | } # end TIEHASH 43 | 44 | #--------------------------------------------------------------------- 45 | # STORE this, key, value 46 | # Store datum *value* into *key* for the tied hash *this*. 47 | 48 | sub STORE 49 | { 50 | $_[0]->{lc $_[1]} = [ $_[1], $_[2] ]; 51 | } # end STORE 52 | 53 | #--------------------------------------------------------------------- 54 | # FETCH this, key 55 | # Retrieve the datum in *key* for the tied hash *this*. 56 | 57 | sub FETCH 58 | { 59 | my $v = $_[0]->{lc $_[1]}; 60 | ($v ? $v->[1] : undef); 61 | } # end FETCH 62 | 63 | #--------------------------------------------------------------------- 64 | # FIRSTKEY this 65 | # Return the (key, value) pair for the first key in the hash. 66 | 67 | sub FIRSTKEY 68 | { 69 | my $a = scalar keys %{$_[0]}; 70 | &NEXTKEY; 71 | } # end FIRSTKEY 72 | 73 | #--------------------------------------------------------------------- 74 | # NEXTKEY this, lastkey 75 | # Return the next (key, value) pair for the hash. 76 | 77 | sub NEXTKEY 78 | { 79 | my $v = (each %{$_[0]})[1]; 80 | ($v ? $v->[0] : undef ); 81 | } # end NEXTKEY 82 | 83 | #--------------------------------------------------------------------- 84 | # SCALAR this 85 | # Return bucket usage information for the hash (0 if empty). 86 | 87 | sub SCALAR 88 | { 89 | scalar %{$_[0]}; 90 | } # end SCALAR 91 | 92 | #--------------------------------------------------------------------- 93 | # EXISTS this, key 94 | # Verify that *key* exists with the tied hash *this*. 95 | 96 | sub EXISTS 97 | { 98 | exists $_[0]->{lc $_[1]}; 99 | } # end EXISTS 100 | 101 | #--------------------------------------------------------------------- 102 | # DELETE this, key 103 | # Delete the key *key* from the tied hash *this*. 104 | # Returns the old value, or undef if it didn't exist. 105 | 106 | sub DELETE 107 | { 108 | my $v = delete $_[0]->{lc $_[1]}; 109 | ($v ? $v->[1] : undef); 110 | } # end DELETE 111 | 112 | #--------------------------------------------------------------------- 113 | # CLEAR this 114 | # Clear all values from the tied hash *this*. 115 | 116 | sub CLEAR 117 | { 118 | %{$_[0]} = (); 119 | } # end CLEAR 120 | 121 | #===================================================================== 122 | # Other Methods: 123 | #--------------------------------------------------------------------- 124 | # Return the case of KEY. 125 | 126 | sub key 127 | { 128 | my $v = $_[0]->{lc $_[1]}; 129 | ($v ? $v->[0] : undef); 130 | } 131 | 132 | #===================================================================== 133 | # Package Return Value: 134 | 135 | 1; 136 | 137 | __END__ 138 | 139 | =head1 NAME 140 | 141 | Tie::CPHash - Case preserving but case insensitive hash table 142 | 143 | =head1 SYNOPSIS 144 | 145 | require Tie::CPHash; 146 | tie %cphash, 'Tie::CPHash'; 147 | 148 | $cphash{'Hello World'} = 'Hi there!'; 149 | printf("The key `%s' was used to store `%s'.\n", 150 | tied(%cphash)->key('HELLO WORLD'), 151 | $cphash{'HELLO world'}); 152 | 153 | =head1 DESCRIPTION 154 | 155 | The B module provides a hash table that is case 156 | preserving but case insensitive. This means that 157 | 158 | $cphash{KEY} $cphash{key} 159 | $cphash{Key} $cphash{keY} 160 | 161 | all refer to the same entry. Also, the hash remembers which form of 162 | the key was last used to store the entry. The C and C 163 | functions will return the key that was used to set the value. 164 | 165 | An example should make this clear: 166 | 167 | tie %h, 'Tie::CPHash'; 168 | $h{Hello} = 'World'; 169 | print $h{HELLO}; # Prints 'World' 170 | print keys(%h); # Prints 'Hello' 171 | $h{HELLO} = 'WORLD'; 172 | print $h{hello}; # Prints 'WORLD' 173 | print keys(%h); # Prints 'HELLO' 174 | 175 | The additional C method lets you fetch the case of a specific key: 176 | 177 | # When run after the previous example, this prints 'HELLO': 178 | print tied(%h)->key('Hello'); 179 | 180 | (The C function returns the object that C<%h> is tied to.) 181 | 182 | If you need a case insensitive hash, but don't need to preserve case, 183 | just use C<$hash{lc $key}> instead of C<$hash{$key}>. This has a lot 184 | less overhead than B. 185 | 186 | =head1 AUTHOR 187 | 188 | Christopher J. Madsen EFE 189 | 190 | =cut 191 | 192 | # Local Variables: 193 | # tmtrack-file-task: "Tie::CPHash.pm" 194 | # End: 195 | -------------------------------------------------------------------------------- /t/compat/exit.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use lib 't/lib'; 6 | use MBTest tests => 3; 7 | 8 | blib_load('Module::Build'); 9 | 10 | ######################### 11 | 12 | my $tmp = MBTest->tmpdir; 13 | 14 | # Create test distribution; set requires and build_requires 15 | use DistGen; 16 | my $dist = DistGen->new( dir => $tmp ); 17 | 18 | $dist->regen; 19 | 20 | $dist->chdir_in; 21 | 22 | ######################### 23 | 24 | my $mb; stdout_of(sub{ $mb = Module::Build->new_from_context}); 25 | 26 | blib_load('Module::Build::Compat'); 27 | 28 | $dist->regen; 29 | 30 | stdout_stderr_of( 31 | sub{ Module::Build::Compat->create_makefile_pl('passthrough', $mb); } 32 | ); 33 | 34 | # as silly as all of this exit(0) business is, that is what the cpan 35 | # testers have instructed everybody to do so... 36 | $dist->change_file('Build.PL' => 37 | "warn qq(you have no libthbbt\n); exit;\n" . $dist->get_file('Build.PL') 38 | ); 39 | 40 | $dist->regen; 41 | 42 | stdout_of(sub{ $mb->ACTION_realclean }); 43 | 44 | my $result; 45 | my ($stdout, $stderr ) = stdout_stderr_of (sub { 46 | $result = $mb->run_perl_script('Makefile.PL'); 47 | }); 48 | ok $result, "Makefile.PL exit"; 49 | like $stdout, qr/running Build\.PL/; 50 | like $stderr, qr/you have no libthbbt$/; 51 | #warn "out: $stdout"; warn "err: $stderr"; 52 | 53 | # vim:ts=2:sw=2:et:sta 54 | -------------------------------------------------------------------------------- /t/debug.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 1; 6 | 7 | blib_load('Module::Build'); 8 | 9 | my $tmp = MBTest->tmpdir; 10 | 11 | use DistGen; 12 | my $dist = DistGen->new( dir => $tmp ); 13 | $dist->regen; 14 | $dist->chdir_in; 15 | 16 | ######################### 17 | 18 | # Test debug output 19 | { 20 | my $output; 21 | $output = stdout_of sub { $dist->run_build_pl }; 22 | $output = stdout_of sub { $dist->run_build('--debug') }; 23 | like($output, '/Starting ACTION_build.*?Starting ACTION_code.*?Finished ACTION_code.*?Finished ACTION_build/ms', 24 | "found nested ACTION_* debug statements" 25 | ); 26 | } 27 | 28 | -------------------------------------------------------------------------------- /t/ext.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | 7 | my @unix_splits = 8 | ( 9 | { q{one t'wo th'ree f"o\"ur " "five" } => [ 'one', 'two three', 'fo"ur ', 'five' ] }, 10 | { q{ foo bar } => [ 'foo', 'bar' ] }, 11 | { q{ D\'oh f\{g\'h\"i\]\* } => [ "D'oh", "f{g'h\"i]*" ] }, 12 | { q{ D\$foo } => [ 'D$foo' ] }, 13 | { qq{one\\\ntwo} => [ "one\ntwo" ] }, # TODO 14 | ); 15 | 16 | my @win_splits = 17 | ( 18 | { 'a" "b\\c" "d' => [ 'a b\c d' ] }, 19 | { '"a b\\c d"' => [ 'a b\c d' ] }, 20 | { '"a b"\\"c d"' => [ 'a b"c', 'd' ] }, 21 | { '"a b"\\\\"c d"' => [ 'a b\c d' ] }, 22 | { '"a"\\"b" "a\\"b"' => [ 'a"b a"b' ] }, 23 | { '"a"\\\\"b" "a\\\\"b"' => [ 'a\b', 'a\b' ] }, 24 | { '"a"\\"b a\\"b"' => [ 'a"b', 'a"b' ] }, 25 | { 'a"\\"b" "a\\"b' => [ 'a"b', 'a"b' ] }, 26 | { 'a"\\"b" "a\\"b' => [ 'a"b', 'a"b' ] }, 27 | { 'a b' => [ 'a', 'b' ] }, 28 | { 'a"\\"b a\\"b' => [ 'a"b a"b' ] }, 29 | { '"a""b" "a"b"' => [ 'a"b ab' ] }, 30 | { '\\"a\\"' => [ '"a"' ] }, 31 | { '"a"" "b"' => [ 'a"', 'b' ] }, 32 | { 'a"b' => [ 'ab' ] }, 33 | { 'a""b' => [ 'ab' ] }, 34 | { 'a"""b' => [ 'a"b' ] }, 35 | { 'a""""b' => [ 'a"b' ] }, 36 | { 'a"""""b' => [ 'a"b' ] }, 37 | { 'a""""""b' => [ 'a""b' ] }, 38 | { '"a"b"' => [ 'ab' ] }, 39 | { '"a""b"' => [ 'a"b' ] }, 40 | { '"a"""b"' => [ 'a"b' ] }, 41 | { '"a""""b"' => [ 'a"b' ] }, 42 | { '"a"""""b"' => [ 'a""b' ] }, 43 | { '"a""""""b"' => [ 'a""b' ] }, 44 | { '' => [ ] }, 45 | { ' ' => [ ] }, 46 | { '""' => [ '' ] }, 47 | { '" "' => [ ' ' ] }, 48 | { '""a' => [ 'a' ] }, 49 | { '""a b' => [ 'a', 'b' ] }, 50 | { 'a""' => [ 'a' ] }, 51 | { 'a"" b' => [ 'a', 'b' ] }, 52 | { '"" a' => [ '', 'a' ] }, 53 | { 'a ""' => [ 'a', '' ] }, 54 | { 'a "" b' => [ 'a', '', 'b' ] }, 55 | { 'a " " b' => [ 'a', ' ', 'b' ] }, 56 | { 'a " b " c' => [ 'a', ' b ', 'c' ] }, 57 | { 'a "0" c' => [ 'a', '0', 'c' ] }, 58 | { '"a\\b"' => [ 'a\\b' ] }, 59 | { '"a\\\\b"' => [ 'a\\\\b' ] }, 60 | { '"a\\\\\\b"' => [ 'a\\\\\\b' ] }, 61 | { '"a\\\\\\\\b"' => [ 'a\\\\\\\\b' ] }, 62 | { '"a\\"' => [ 'a"' ] }, 63 | { '"a\\\\"' => [ 'a\\' ] }, 64 | { '"a\\\\\\"' => [ 'a\\"' ] }, 65 | { '"a\\\\\\\\"' => [ 'a\\\\' ] }, 66 | { '"a\\\\\\""' => [ 'a\\"' ] }, 67 | ); 68 | 69 | plan tests => 9 + 4*@unix_splits + 4*@win_splits; 70 | 71 | blib_load('Module::Build'); 72 | blib_load('Module::Build::Platform::Unix'); 73 | blib_load('Module::Build::Platform::Windows'); 74 | 75 | ######################### 76 | 77 | # Should always return an array unscathed 78 | foreach my $platform ('', '::Platform::Unix', '::Platform::Windows') { 79 | my $pkg = "Module::Build$platform"; 80 | my @result = $pkg->split_like_shell(['foo', 'bar', 'baz']); 81 | is @result, 3, "Split using $pkg"; 82 | is "@result", "foo bar baz", "Split using $pkg"; 83 | } 84 | 85 | # I think 3.24 isn't actually the majik version, my 3.23 seems to pass... 86 | my $low_TPW_version = Text::ParseWords->VERSION < 3.24; 87 | foreach my $test (@unix_splits) { 88 | # Text::ParseWords bug: 89 | local $TODO = $low_TPW_version && ((keys %$test)[0] =~ m{\\\n}); 90 | 91 | do_split_tests('Module::Build::Platform::Unix', $test); 92 | } 93 | 94 | foreach my $test (@win_splits) { 95 | do_split_tests('Module::Build::Platform::Windows', $test); 96 | } 97 | 98 | 99 | { 100 | # Make sure read_args() functions properly as a class method 101 | my @args = qw(foo=bar --food bard --foods=bards); 102 | my ($args) = Module::Build->read_args(@args); 103 | is_deeply($args, {foo => 'bar', food => 'bard', foods => 'bards', ARGV => []}); 104 | } 105 | 106 | { 107 | # Make sure data can make a round-trip through unparse_args() and read_args() 108 | my %args = (foo => 'bar', food => 'bard', config => {a => 1, b => 2}, ARGV => []); 109 | my ($args) = Module::Build->read_args( Module::Build->unparse_args(\%args) ); 110 | is_deeply($args, \%args); 111 | } 112 | 113 | { 114 | # Make sure data can make a round-trip through an external perl 115 | # process, which can involve the shell command line 116 | 117 | # silence the printing for easier matching 118 | local *Module::Build::log_info = sub {}; 119 | 120 | my @data = map values(%$_), @unix_splits, @win_splits; 121 | for my $d (@data) { 122 | my $out = stdout_of 123 | ( sub { 124 | Module::Build->run_perl_script('-le', [], ['print join " ", map "{$_}", @ARGV', @$d]); 125 | } ); 126 | chomp $out; 127 | is($out, join(' ', map "{$_}", @$d), "perl round trip for ".join('',map "{$_}", @$d)); 128 | } 129 | } 130 | 131 | { 132 | # Make sure data can make a round-trip through an external backtick 133 | # process, which can involve the shell command line 134 | 135 | # silence the printing for easier matching 136 | local *Module::Build::log_info = sub {}; 137 | 138 | my @data = map values(%$_), @unix_splits, @win_splits; 139 | for my $d (@data) { 140 | chomp(my $out = Module::Build->_backticks($^X, '-le', 'print join " ", map "{$_}", @ARGV', @$d)); 141 | is($out, join(' ', map "{$_}", @$d), "backticks round trip for ".join('',map "{$_}", @$d)); 142 | } 143 | } 144 | 145 | { 146 | # Make sure run_perl_script() propagates @INC 147 | my $dir = MBTest->tmpdir; 148 | if ($^O eq 'VMS') { 149 | # VMS can store INC paths in Unix format with out the trailing 150 | # directory delimiter. 151 | $dir = VMS::Filespec::unixify($dir); 152 | $dir =~ s#/$##; 153 | } 154 | local @INC = ($dir, @INC); 155 | my $output = stdout_of( sub { Module::Build->run_perl_script('-le', [], ['print for @INC']) } ); 156 | like $output, qr{^\Q$dir\E}m; 157 | } 158 | 159 | ################################################################## 160 | sub do_split_tests { 161 | my ($package, $test) = @_; 162 | 163 | my ($string, $expected) = %$test; 164 | my @result = $package->split_like_shell($string); 165 | is( 0 + grep( !defined(), @result ), # all defined 166 | 0, 167 | "'$string' result all defined" ); 168 | is_deeply(\@result, $expected) or 169 | diag("$package split_like_shell error \n" . 170 | ">$string< is not splitting as >" . join("|", @$expected) . '<'); 171 | } 172 | -------------------------------------------------------------------------------- /t/files.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 4; 6 | 7 | blib_load('Module::Build'); 8 | 9 | my $tmp = MBTest->tmpdir; 10 | 11 | use DistGen; 12 | my $dist = DistGen->new( dir => $tmp ); 13 | $dist->regen; 14 | 15 | $dist->chdir_in; 16 | 17 | my $mb = Module::Build->new_from_context; 18 | 19 | { 20 | # Make sure copy_if_modified() can handle spaces in filenames 21 | 22 | my @tmp; 23 | push @tmp, MBTest->tmpdir for (0 .. 1); 24 | 25 | my $filename = 'file with spaces.txt'; 26 | 27 | my $file = File::Spec->catfile($tmp[0], $filename); 28 | open(my $fh, '>', $file) or die "Can't create $file: $!"; 29 | print $fh "Foo\n"; 30 | close $fh; 31 | ok -e $file; 32 | 33 | 34 | my $file2 = $mb->copy_if_modified(from => $file, to_dir => $tmp[1]); 35 | ok $file2; 36 | ok -e $file2; 37 | } 38 | 39 | { 40 | # Try some dir_contains() combinations 41 | my $first = File::Spec->catdir('', 'one', 'two'); 42 | my $second = File::Spec->catdir('', 'one', 'two', 'three'); 43 | 44 | ok( Module::Build->dir_contains($first, $second) ); 45 | } 46 | 47 | -------------------------------------------------------------------------------- /t/help.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 23; 6 | 7 | blib_load('Module::Build'); 8 | 9 | use DistGen; 10 | 11 | my $dist = DistGen->new; 12 | $dist->regen; 13 | $dist->chdir_in; 14 | 15 | my $restart = sub { 16 | # we're redefining the same package as we go, so... 17 | delete($::{'MyModuleBuilder::'}); 18 | delete($INC{'MyModuleBuilder.pm'}); 19 | $dist->regen( clean => 1 ); 20 | }; 21 | 22 | ######################################################################## 23 | { # check the =item style 24 | my $mb = Module::Build->subclass( 25 | code => join "\n", map {s/^ {4}//; $_} split /\n/, <<' ---', 26 | =head1 ACTIONS 27 | 28 | =over 29 | 30 | =item foo 31 | 32 | Does the foo thing. 33 | 34 | =item bar 35 | 36 | Does the bar thing. 37 | 38 | =item help 39 | 40 | Does the help thing. 41 | 42 | You should probably not be seeing this. That is, we haven't 43 | overridden the help action, but we're able to override just the 44 | docs? That almost seems reasonable, but is probably wrong. 45 | 46 | =back 47 | 48 | =cut 49 | 50 | sub ACTION_foo { die "fooey" } 51 | sub ACTION_bar { die "barey" } 52 | sub ACTION_baz { die "bazey" } 53 | 54 | # guess we can have extra pod later 55 | 56 | =over 57 | 58 | =item baz 59 | 60 | Does the baz thing. 61 | 62 | =back 63 | 64 | =cut 65 | 66 | --- 67 | )->new( 68 | module_name => $dist->name, 69 | ); 70 | 71 | ok $mb; 72 | can_ok($mb, 'ACTION_foo'); 73 | 74 | foreach my $action (qw(foo bar baz)) { # typical usage 75 | my $doc = $mb->get_action_docs($action); 76 | ok($doc, "got doc for '$action'"); 77 | like($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s, 78 | 'got the right doc'); 79 | } 80 | 81 | { # user typo'd the action name 82 | ok( ! eval {$mb->get_action_docs('batz'); 1}, 'slap'); 83 | like($@, qr/No known action 'batz'/, 'informative error'); 84 | } 85 | 86 | { # XXX this one needs some thought 87 | my $action = 'help'; 88 | my $doc = $mb->get_action_docs($action); 89 | ok($doc, "got doc for '$action'"); 90 | 0 and warn "help doc >\n$doc<\n"; 91 | TODO: { 92 | local $TODO = 'Do we allow overrides on just docs?'; 93 | unlike($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s, 94 | 'got the right doc'); 95 | } 96 | } 97 | } # end =item style 98 | $restart->(); 99 | ######################################################################## 100 | if(0) { # the =item style without spanning =head1 sections 101 | my $mb = Module::Build->subclass( 102 | code => join "\n", map {s/^ {4}//; $_} split /\n/, <<' ---', 103 | =head1 ACTIONS 104 | 105 | =over 106 | 107 | =item foo 108 | 109 | Does the foo thing. 110 | 111 | =item bar 112 | 113 | Does the bar thing. 114 | 115 | =back 116 | 117 | =head1 thbbt 118 | 119 | =over 120 | 121 | =item baz 122 | 123 | Should not see this. 124 | 125 | =back 126 | 127 | =cut 128 | 129 | sub ACTION_foo { die "fooey" } 130 | sub ACTION_bar { die "barey" } 131 | sub ACTION_baz { die "bazey" } 132 | 133 | --- 134 | )->new( 135 | module_name => $dist->name, 136 | ); 137 | 138 | ok $mb; 139 | can_ok($mb, 'ACTION_foo'); 140 | 141 | foreach my $action (qw(foo bar)) { # typical usage 142 | my $doc = $mb->get_action_docs($action); 143 | ok($doc, "got doc for '$action'"); 144 | like($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s, 145 | 'got the right doc'); 146 | } 147 | is($mb->get_action_docs('baz'), undef, 'no jumping =head1 sections'); 148 | 149 | } # end =item style without spanning =head1's 150 | $restart->(); 151 | ######################################################################## 152 | TODO: { # the =item style with 'Actions' not 'ACTIONS' 153 | local $TODO = 'Support capitalized Actions section'; 154 | my $mb = Module::Build->subclass( 155 | code => join "\n", map {s/^ {4}//; $_} split /\n/, <<' ---', 156 | =head1 Actions 157 | 158 | =over 159 | 160 | =item foo 161 | 162 | Does the foo thing. 163 | 164 | =item bar 165 | 166 | Does the bar thing. 167 | 168 | =back 169 | 170 | =cut 171 | 172 | sub ACTION_foo { die "fooey" } 173 | sub ACTION_bar { die "barey" } 174 | 175 | --- 176 | )->new( 177 | module_name => $dist->name, 178 | ); 179 | 180 | foreach my $action (qw(foo bar)) { # typical usage 181 | my $doc = $mb->get_action_docs($action); 182 | ok($doc, "got doc for '$action'"); 183 | like($doc || 'undef', qr/^=\w+ $action\n\nDoes the $action thing\./s, 184 | 'got the right doc'); 185 | } 186 | 187 | } # end =item style with Actions 188 | $restart->(); 189 | ######################################################################## 190 | { # check the =head2 style 191 | my $mb = Module::Build->subclass( 192 | code => join "\n", map {s/^ {4}//; $_} split /\n/, <<' ---', 193 | =head1 ACTIONS 194 | 195 | =head2 foo 196 | 197 | Does the foo thing. 198 | 199 | =head2 bar 200 | 201 | Does the bar thing. 202 | 203 | =head3 bears 204 | 205 | Be careful with bears. 206 | 207 | =cut 208 | 209 | sub ACTION_foo { die "fooey" } 210 | sub ACTION_bar { die "barey" } 211 | sub ACTION_baz { die "bazey" } 212 | sub ACTION_batz { die "batzey" } 213 | 214 | # guess we can have extra pod later 215 | # Though, I do wonder whether we should allow them to mix... 216 | # maybe everything should have to be head2? 217 | 218 | =head2 baz 219 | 220 | Does the baz thing. 221 | 222 | =head4 What's a baz? 223 | 224 | =head1 not this part 225 | 226 | This is level 1, so the stuff about baz is done. 227 | 228 | =head1 Thing 229 | 230 | =head2 batz 231 | 232 | This is not an action doc. 233 | 234 | =cut 235 | 236 | --- 237 | )->new( 238 | module_name => $dist->name, 239 | ); 240 | 241 | my %also = ( 242 | foo => '', 243 | bar => "\n=head3 bears\n\nBe careful with bears.\n", 244 | baz => "\n=head4 What's a baz\\?\n", 245 | ); 246 | 247 | foreach my $action (qw(foo bar baz)) { 248 | my $doc = $mb->get_action_docs($action); 249 | ok($doc, "got doc for '$action'"); 250 | my $and = $also{$action}; 251 | like($doc || 'undef', 252 | qr/^=\w+ $action\n\nDoes the $action thing\.\n$and\n$/s, 253 | 'got the right doc'); 254 | } 255 | is($mb->get_action_docs('batz'), undef, 'nothing after uplevel'); 256 | 257 | } # end =head2 style 258 | ######################################################################## 259 | 260 | # cleanup 261 | $dist->clean(); 262 | 263 | # vim:ts=2:sw=2:et:sta 264 | -------------------------------------------------------------------------------- /t/install.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 34; 6 | 7 | blib_load('Module::Build'); 8 | 9 | use Config; 10 | use Cwd (); 11 | my $cwd = Cwd::cwd; 12 | my $tmp = MBTest->tmpdir; 13 | 14 | use DistGen; 15 | my $dist = DistGen->new( dir => $tmp ); 16 | $dist->regen; 17 | $dist->chdir_in; 18 | 19 | ######################### 20 | 21 | 22 | $dist->add_file( 'script', <<'---' ); 23 | #!perl -w 24 | print "Hello, World!\n"; 25 | --- 26 | $dist->change_build_pl 27 | ({ 28 | module_name => $dist->name, 29 | scripts => [ 'script' ], 30 | license => 'perl', 31 | requires => { 'File::Spec' => 0 }, 32 | }); 33 | $dist->regen; 34 | 35 | 36 | use File::Spec::Functions qw( catdir ); 37 | 38 | my $mb = Module::Build->new_from_context( 39 | # Need default install paths to ensure manpages get generated. 40 | installdirs => 'site', 41 | config => { 42 | installman1dir => catdir($tmp, 'man', 'man1'), 43 | installman3dir => catdir($tmp, 'man', 'man3'), 44 | installsiteman1dir => catdir($tmp, 'site', 'man', 'man1'), 45 | installsiteman3dir => catdir($tmp, 'site', 'man', 'man3'), 46 | ## We also used to have HTML paths here, but building HTML docs 47 | ## can be super slow, and we never checked the result anyway. 48 | } 49 | 50 | ); 51 | 52 | ok $mb; 53 | 54 | 55 | my $destdir = File::Spec->catdir($cwd, 't', 'install_test' . $$); 56 | $mb->add_to_cleanup($destdir); 57 | 58 | { 59 | eval {$mb->dispatch('install', destdir => $destdir)}; 60 | is $@, ''; 61 | 62 | my @libdir = strip_volume( $mb->install_destination('lib') ); 63 | my $install_to = File::Spec->catfile($destdir, @libdir, $dist->name ) . '.pm'; 64 | file_exists($install_to); 65 | 66 | local @INC = (@INC, File::Spec->catdir($destdir, @libdir)); 67 | eval "require @{[$dist->name]}"; 68 | is $@, ''; 69 | 70 | # Make sure there's a packlist installed 71 | my $archdir = $mb->install_destination('arch'); 72 | my @dirs = strip_volume($archdir); 73 | my $packlist = File::Spec->catfile 74 | ($destdir, @dirs, 'auto', $dist->name, '.packlist'); 75 | is -e $packlist, 1, "$packlist should be written"; 76 | } 77 | 78 | { 79 | eval {$mb->dispatch('install', installdirs => 'core', destdir => $destdir)}; 80 | is $@, ''; 81 | my @libdir = strip_volume( $Config{installprivlib} ); 82 | my $install_to = File::Spec->catfile($destdir, @libdir, $dist->name ) . '.pm'; 83 | file_exists($install_to); 84 | } 85 | 86 | { 87 | my $libdir = File::Spec->catdir(File::Spec->rootdir, 'foo', 'bar'); 88 | eval {$mb->dispatch('install', install_path => {lib => $libdir}, destdir => $destdir)}; 89 | is $@, ''; 90 | my @dirs = strip_volume($libdir); 91 | my $install_to = File::Spec->catfile($destdir, @dirs, $dist->name ) . '.pm'; 92 | file_exists($install_to); 93 | } 94 | 95 | { 96 | my $libdir = File::Spec->catdir(File::Spec->rootdir, 'foo', 'base'); 97 | eval {$mb->dispatch('install', install_base => $libdir, destdir => $destdir)}; 98 | is $@, ''; 99 | my @dirs = strip_volume($libdir); 100 | my $install_to = File::Spec->catfile($destdir, @dirs, 'lib', 'perl5', $dist->name ) . '.pm'; 101 | file_exists($install_to); 102 | } 103 | 104 | { 105 | # Test the ConfigData stuff 106 | 107 | $mb->config_data(foo => 'bar'); 108 | $mb->features(baz => 1); 109 | $mb->auto_features(auto_foo => {requires => {'File::Spec' => 0}}); 110 | eval {$mb->dispatch('install', destdir => $destdir)}; 111 | is $@, ''; 112 | 113 | my @libdir = strip_volume( $mb->install_destination('lib') ); 114 | local @INC = (@INC, File::Spec->catdir($destdir, @libdir)); 115 | eval "require @{[$dist->name]}::ConfigData"; 116 | 117 | is $mb->feature('auto_foo'), 1; 118 | 119 | SKIP: { 120 | skip $@, 5 if @_; 121 | 122 | # Make sure the values are present 123 | my $config = $dist->name . '::ConfigData'; 124 | is( $config->config('foo'), 'bar' ); 125 | ok( $config->feature('baz') ); 126 | ok( $config->feature('auto_foo') ); 127 | ok( not $config->feature('nonexistent') ); 128 | 129 | # Add a new value to the config set 130 | $config->set_config(floo => 'bhlar'); 131 | is( $config->config('floo'), 'bhlar' ); 132 | 133 | # Make sure it actually got written 134 | $config->write; 135 | delete $INC{"@{[$dist->name]}/ConfigData.pm"}; 136 | { 137 | local $^W; # Avoid warnings for subroutine redefinitions 138 | eval "require $config"; 139 | } 140 | is( $config->config('floo'), 'bhlar' ); 141 | } 142 | } 143 | 144 | 145 | eval {$mb->dispatch('realclean')}; 146 | is $@, ''; 147 | 148 | { 149 | # Try again by running the script rather than with programmatic interface 150 | my $libdir = File::Spec->catdir('', 'foo', 'lib'); 151 | eval {$mb->run_perl_script('Build.PL', [], ['--install_path', "lib=$libdir"])}; 152 | is $@, ''; 153 | 154 | my $cmd = 'Build'; 155 | $cmd .= ".COM" if $^O eq 'VMS'; 156 | eval {$mb->run_perl_script($cmd, [], ['install', '--destdir', $destdir])}; 157 | is $@, ''; 158 | my $install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) . '.pm'; 159 | file_exists($install_to); 160 | 161 | my $basedir = File::Spec->catdir('', 'bar'); 162 | eval {$mb->run_perl_script($cmd, [], ['install', '--destdir', $destdir, 163 | '--install_base', $basedir])}; 164 | is $@, ''; 165 | 166 | $install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) . '.pm'; 167 | is -e $install_to, 1, "Look for file at $install_to"; 168 | 169 | eval {$mb->dispatch('realclean')}; 170 | is $@, ''; 171 | } 172 | 173 | { 174 | # Make sure 'install_path' overrides 'install_base' 175 | my $mb = Module::Build->new( module_name => $dist->name, 176 | install_base => File::Spec->catdir('', 'foo'), 177 | install_path => { 178 | lib => File::Spec->catdir('', 'bar') 179 | } 180 | ); 181 | ok $mb; 182 | is $mb->install_destination('lib'), File::Spec->catdir('', 'bar'); 183 | } 184 | 185 | { 186 | $dist->add_file( 'lib/Simple/Docs.pod', <<'---' ); 187 | =head1 NAME 188 | 189 | Simple::Docs - Simple pod 190 | 191 | =head1 AUTHOR 192 | 193 | Simple Man 194 | 195 | =cut 196 | --- 197 | $dist->regen; 198 | 199 | # _find_file_by_type() isn't a public method, but this is currently 200 | # the only easy way to test that it works properly. 201 | my $pods = $mb->_find_file_by_type('pod', 'lib'); 202 | is keys %$pods, 1; 203 | my $expect = $mb->localize_file_path('lib/Simple/Docs.pod'); 204 | 205 | is $pods->{$expect}, $expect; 206 | 207 | my $pms = $mb->_find_file_by_type('awefawef', 'lib'); 208 | ok $pms; 209 | is keys %$pms, 0; 210 | 211 | $pms = $mb->_find_file_by_type('pod', 'awefawef'); 212 | ok $pms; 213 | is keys %$pms, 0; 214 | 215 | # revert to pristine state 216 | $dist->regen( clean => 1 ); 217 | } 218 | 219 | sub strip_volume { 220 | my $dir = shift; 221 | (undef, $dir) = File::Spec->splitpath( $dir, 1 ); 222 | my @dirs = File::Spec->splitdir($dir); 223 | return @dirs; 224 | } 225 | 226 | sub file_exists { 227 | my $file = shift; 228 | ok -e $file or diag("Expected $file to exist, but it doesn't"); 229 | } 230 | 231 | -------------------------------------------------------------------------------- /t/install_extra_target.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | # Contributed by: Thorben Jaendling 3 | 4 | use strict; 5 | use lib 't/lib'; 6 | use MBTest tests => 6; 7 | 8 | blib_load('Module::Build'); 9 | 10 | use File::Spec::Functions qw( catdir catfile ); 11 | 12 | my $tmp = MBTest->tmpdir; 13 | my $output; 14 | 15 | use DistGen; 16 | my $dist = DistGen->new( dir => $tmp ); 17 | 18 | # note("Dist is in $tmp\n"); 19 | 20 | $dist->add_file("Build.PL", <<'===EOF==='); 21 | #!perl -w 22 | 23 | use strict; 24 | use Module::Build; 25 | 26 | my $subclass = Module::Build->subclass(code => <<'=EOF='); 27 | sub copy_files 28 | { 29 | my $self = shift; 30 | my $dir = shift; 31 | 32 | my $files = $self->rscan_dir($dir, sub {-f $_ and not m!/\.|[#~]$!}); 33 | 34 | foreach my $file (@$files) { 35 | $self->copy_if_modified(from => $file, to_dir => "blib"); 36 | } 37 | } 38 | 39 | #Copy etc files to blib 40 | sub process_etc_files 41 | { 42 | my $self = shift; 43 | 44 | $self->copy_files("etc"); 45 | } 46 | 47 | #Copy share files to blib 48 | sub process_shared_files 49 | { 50 | my $self = shift; 51 | 52 | $self->copy_files("shared"); 53 | } 54 | 55 | 1; 56 | =EOF= 57 | 58 | my $build = $subclass->new( 59 | module_name => 'Simple', 60 | license => 'perl' 61 | ); 62 | 63 | $build->add_build_element('etc'); 64 | $build->add_build_element('shared'); 65 | 66 | my $distdir = lc $build->dist_name(); 67 | 68 | foreach my $id ('core', 'site', 'vendor') { 69 | #Where to install these build types when using prefix symantics 70 | $build->prefix_relpaths($id, 'shared' => "shared/$distdir"); 71 | $build->prefix_relpaths($id, 'etc' => "etc/$distdir"); 72 | 73 | #Where to install these build types when using default symantics 74 | my $set = $build->install_sets($id); 75 | $set->{'shared'} = '/usr/'.($id eq 'site' ? 'local/':'')."shared/$distdir"; 76 | $set->{'etc'} = ($id eq 'site' ? '/usr/local/etc/':'/etc/').$distdir; 77 | } 78 | 79 | #Where to install these types when using install_base symantics 80 | $build->install_base_relpaths('shared' => "shared/$distdir"); 81 | $build->install_base_relpaths('etc' => "etc/$distdir"); 82 | 83 | $build->create_build_script(); 84 | 85 | ===EOF=== 86 | 87 | #Test Build.PL exists ok? 88 | 89 | $dist->add_file("etc/config", <<'===EOF==='); 90 | [main] 91 | Foo = bar 92 | Jim = bob 93 | 94 | [supplemental] 95 | stardate = 1234344 96 | 97 | ===EOF=== 98 | 99 | $dist->add_file("shared/data", <<'===EOF==='); 100 | 7 * 9 = 42? 101 | 102 | ===EOF=== 103 | 104 | $dist->add_file("shared/html/index.html", <<'===EOF==='); 105 | 106 | 107 |

Hello World!

108 | 109 | 110 | 111 | ===EOF=== 112 | 113 | $dist->regen; 114 | $dist->chdir_in; 115 | 116 | my $installdest = catdir($tmp, 't', "install_extra_targets-$$"); 117 | 118 | $output = stdout_of sub { $dist->run_build_pl("--install_base=$installdest") }; 119 | 120 | $output .= stdout_of sub { $dist->run_build }; 121 | 122 | my $error; 123 | $error++ unless ok(-e "blib/etc/config", "Built etc/config"); 124 | $error++ unless ok(-e "blib/shared/data", "Built shared/data"); 125 | $error++ unless ok(-e "blib/shared/html/index.html", "Built shared/html"); 126 | diag "OUTPUT:\n$output" if $error; 127 | 128 | $output = stdout_of sub { $dist->run_build('install') }; 129 | 130 | $error = 0; 131 | $error++ unless ok(-e catfile($installdest, qw/etc simple config/), "installed etc/config"); 132 | $error++ unless ok(-e catfile($installdest, qw/shared simple data/), "installed shared/data"); 133 | $error++ unless ok(-e catfile($installdest, qw/shared simple html index.html/), "installed shared/html"); 134 | diag "OUTPUT:\n$output" if $error; 135 | 136 | -------------------------------------------------------------------------------- /t/lib/Module/Signature.pm: -------------------------------------------------------------------------------- 1 | package Module::Signature; # mocked 2 | use strict; 3 | use warnings; 4 | our $VERSION = 999; 5 | 6 | sub sign { 7 | open my $fh, ">", "SIGNATURE"; 8 | print {$fh} "SIGNATURE"; 9 | } 10 | 11 | 1; 12 | -------------------------------------------------------------------------------- /t/lib/Software/License/VaporWare.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | package Software::License::VaporWare; 5 | our $VERSION = '0.001'; 6 | 7 | use Software::License; 8 | our @ISA = qw/Software::License/; 9 | 10 | sub name { 'VaporWare License' } 11 | sub url { 'http://example.com/vaporware/' } 12 | sub meta_name { 'unrestricted' } 13 | sub meta2_name { 'unrestricted' } 14 | 15 | 1; 16 | 17 | 18 | -------------------------------------------------------------------------------- /t/manifypods.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | blib_load('Module::Build'); 7 | blib_load('Module::Build::ConfigData'); 8 | 9 | if ( Module::Build::ConfigData->feature('manpage_support') ) { 10 | plan tests => 33; 11 | } else { 12 | plan skip_all => 'manpage_support feature is not enabled'; 13 | } 14 | 15 | 16 | ######################### 17 | 18 | 19 | use Cwd (); 20 | my $cwd = Cwd::cwd; 21 | my $tmp = MBTest->tmpdir; 22 | 23 | use DistGen; 24 | my $dist = DistGen->new( dir => $tmp ); 25 | $dist->add_file( 'bin/nopod.pl', <<'---' ); 26 | #!perl -w 27 | print "sample script without pod to test manifypods action\n"; 28 | --- 29 | $dist->add_file( 'bin/haspod.pl', <<'---' ); 30 | #!perl -w 31 | print "Hello, world"; 32 | 33 | __END__ 34 | 35 | =head1 NAME 36 | 37 | haspod.pl - sample script with pod to test manifypods action 38 | 39 | =cut 40 | --- 41 | $dist->add_file( 'lib/Simple/NoPod.pm', <<'---' ); 42 | package Simple::NoPod; 43 | 1; 44 | --- 45 | $dist->add_file( 'lib/Simple/AllPod.pod', <<'---' ); 46 | =head1 NAME 47 | 48 | Simple::AllPod - Pure POD 49 | 50 | =head1 AUTHOR 51 | 52 | Simple Man 53 | 54 | =cut 55 | --- 56 | 57 | 58 | for ([1 => ".pod"], [2 => ".pm"], [3 => ".pl"], [4 => ""]) { # array of _arrays_ 59 | $dist->add_file( "docs/myapp$_->[0]$_->[1]", <<"---" ); 60 | =head1 NAME 61 | 62 | myapp$_->[0] - Pure POD 63 | 64 | =head1 AUTHOR 65 | 66 | Simple Man 67 | 68 | =cut 69 | 1; 70 | --- 71 | } 72 | $dist->regen; 73 | 74 | 75 | $dist->chdir_in; 76 | 77 | use File::Spec::Functions qw( catdir ); 78 | my $destdir = catdir($cwd, 't', 'install_test' . $$); 79 | 80 | 81 | my $mb = Module::Build->new( 82 | module_name => $dist->name, 83 | install_base => $destdir, 84 | bindoc_dirs => ['bin', 'docs'], 85 | scripts => [ File::Spec->catfile( 'bin', 'nopod.pl' ), 86 | File::Spec->catfile( 'bin', 'haspod.pl' ) ], 87 | 88 | # Need default install paths to ensure manpages get generated 89 | installdirs => 'site', 90 | config => { 91 | installsiteman1dir => catdir($tmp, 'site', 'man', 'man1'), 92 | installsiteman3dir => catdir($tmp, 'site', 'man', 'man3'), 93 | } 94 | 95 | ); 96 | 97 | $mb->add_to_cleanup($destdir); 98 | 99 | 100 | is( ref $mb->{properties}->{bindoc_dirs}, 'ARRAY', 'bindoc_dirs' ); 101 | is( ref $mb->{properties}->{libdoc_dirs}, 'ARRAY', 'libdoc_dirs' ); 102 | 103 | my %man = ( 104 | sep => $mb->manpage_separator, 105 | dir1 => 'man1', 106 | dir3 => 'man3', 107 | ext1 => $mb->config('man1ext'), 108 | ext3 => $mb->config('man3ext'), 109 | ); 110 | 111 | my %distro = ( 112 | 'bin/nopod.pl' => '', 113 | 'bin/haspod.pl' => "haspod.pl.$man{ext1}", 114 | 'lib/Simple.pm' => "Simple.$man{ext3}", 115 | 'lib/Simple/NoPod.pm' => '', 116 | 'lib/Simple/AllPod.pod' => "Simple$man{sep}AllPod.$man{ext3}", 117 | 'docs/myapp1.pod' => "myapp1.pod.$man{ext1}", 118 | 'docs/myapp2.pm' => "myapp2.pm.$man{ext1}", 119 | 'docs/myapp3.pl' => "myapp3.pl.$man{ext1}", 120 | 'docs/myapp4' => "myapp4.$man{ext1}", 121 | ); 122 | 123 | %distro = map {$mb->localize_file_path($_), $distro{$_}} keys %distro; 124 | 125 | my $lib_path = $mb->localize_dir_path('lib'); 126 | 127 | # Remove trailing directory delimiter on VMS for compares 128 | $lib_path =~ s/\]// if $^O eq 'VMS'; 129 | 130 | $mb->dispatch('build'); 131 | 132 | eval {$mb->dispatch('docs')}; 133 | is $@, ''; 134 | 135 | while (my ($from, $v) = each %distro) { 136 | if (!$v) { 137 | ok ! $mb->contains_pod($from), "$from should not contain POD"; 138 | next; 139 | } 140 | 141 | my $to = File::Spec->catfile('blib', ($from =~ /^[\.\/\[]*lib/ ? 'libdoc' : 'bindoc'), $v); 142 | ok $mb->contains_pod($from), "$from should contain POD"; 143 | ok -e $to, "Created $to manpage"; 144 | } 145 | 146 | 147 | $mb->dispatch('install'); 148 | 149 | while (my ($from, $v) = each %distro) { 150 | next unless $v; 151 | my $to = File::Spec->catfile 152 | ($destdir, 'man', $man{($from =~ /^\Q$lib_path\E/ ? 'dir3' : 'dir1')}, $v); 153 | ok -e $to, "Created $to manpage"; 154 | } 155 | 156 | $mb->dispatch('realclean'); 157 | 158 | 159 | # revert to a pristine state 160 | $dist->regen( clean => 1 ); 161 | 162 | my $mb2 = Module::Build->new( 163 | module_name => $dist->name, 164 | libdoc_dirs => [qw( foo bar baz )], 165 | ); 166 | 167 | is( $mb2->{properties}->{libdoc_dirs}->[0], 'foo', 'override libdoc_dirs' ); 168 | 169 | # Make sure we can find our own action documentation 170 | ok $mb2->get_action_docs('build'); 171 | ok !eval{$mb2->get_action_docs('foo')}; 172 | 173 | # Make sure those docs are the correct ones 174 | foreach ('testcover', 'disttest') { 175 | my $docs = $mb2->get_action_docs($_); 176 | like $docs, qr/=item $_/; 177 | unlike $docs, qr/\n=/, $docs; 178 | } 179 | 180 | -------------------------------------------------------------------------------- /t/manifypods_with_utf8.t: -------------------------------------------------------------------------------- 1 | package ManifypodsWithUtf8; 2 | use strict; 3 | use utf8; 4 | use Test::More; 5 | 6 | use lib 't/lib'; 7 | blib_load('Module::Build'); 8 | blib_load('Module::Build::ConfigData'); 9 | 10 | use MBTest; 11 | plan ($] > 5.008 ? (tests => 2) : (skip_all => 'UTF-8 manpages require perl 5.8.1')); 12 | use File::Spec::Functions qw( catdir ); 13 | 14 | use Cwd (); 15 | my $cwd = Cwd::cwd; 16 | my $tmp = MBTest->tmpdir; 17 | 18 | use DistGen; 19 | my $dist = DistGen->new( dir => $tmp ); 20 | my $content = <<'---'; 21 | 22 | =encoding utf8 23 | 24 | =head1 NAME 25 | 26 | Simple::PodWithUtf8 - POD with some (ç á à ô) special chars 27 | 28 | =cut 29 | --- 30 | utf8::encode($content); 31 | $dist->add_file( 'lib/Simple/PodWithUtf8.pod', $content); 32 | $dist->regen; 33 | $dist->chdir_in; 34 | 35 | my $destdir = catdir($cwd, 't', 'install_test' . $$); 36 | 37 | my $mb = Module::Build->new( 38 | module_name => $dist->name, 39 | install_base => $destdir, 40 | 41 | # need default install paths to ensure manpages get generated 42 | installdirs => 'site', 43 | config => { 44 | installsiteman1dir => catdir($tmp, 'site', 'man', 'man1'), 45 | installsiteman3dir => catdir($tmp, 'site', 'man', 'man3'), 46 | }, 47 | extra_manify_args => { utf8 => 1 }, 48 | ); 49 | $mb->add_to_cleanup($destdir); 50 | 51 | 52 | $mb->dispatch('build'); 53 | my $sep = $mb->manpage_separator; 54 | my $ext3 = $mb->config('man3ext'); 55 | my $to = File::Spec->catfile('blib', 'libdoc', "Simple${sep}PodWithUtf8.${ext3}"); 56 | 57 | ok(-e $to, "Manpage is found at $to"); 58 | open my $pod, '<:encoding(utf-8)', $to or diag "Could not open $to: $!"; 59 | my $pod_content = do { local $/; <$pod> }; 60 | close $pod; 61 | 62 | like($pod_content, qr/ \(ç á à ô\) /, "POD should contain special characters"); 63 | 64 | -------------------------------------------------------------------------------- /t/metadata.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | 7 | if (eval { require CPAN::Meta; CPAN::Meta->VERSION(2.142060) }) { 8 | plan(tests => 14); 9 | } 10 | else { 11 | plan(skip_all => 'No or old CPAN::Meta'); 12 | } 13 | 14 | blib_load('Module::Build'); 15 | blib_load('Module::Build::ConfigData'); 16 | 17 | my $tmp = MBTest->tmpdir; 18 | 19 | my %metadata = 20 | ( 21 | module_name => 'Simple', 22 | dist_version => '3.14159265', 23 | dist_author => [ 'Simple Simon ' ], 24 | dist_abstract => 'Something interesting', 25 | test_requires => { 26 | 'Test::More' => 0.49, 27 | }, 28 | license => 'perl', 29 | meta_add => { 30 | keywords => [qw(super duper something)], 31 | resources => {homepage => 'http://foo.example.com'}, 32 | }, 33 | ); 34 | 35 | 36 | use DistGen; 37 | my $dist = DistGen->new( dir => $tmp ); 38 | $dist->change_build_pl( \%metadata ); 39 | $dist->regen; 40 | 41 | my $simple_file = 'lib/Simple.pm'; 42 | my $simple2_file = 'lib/Simple2.pm'; 43 | 44 | # Traditional VMS will return the file in in lower case, and is_deeply 45 | # does exact case comparisons. 46 | # When ODS-5 support is active for preserved case file names we do not 47 | # change the case. 48 | if ($^O eq 'VMS') { 49 | my $lower_case_expect = 1; 50 | my $vms_efs_case = 0; 51 | if (eval 'require VMS::Feature') { 52 | $vms_efs_case = VMS::Feature::current("efs_case_preserve"); 53 | } else { 54 | my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || ''; 55 | $vms_efs_case = $efs_case =~ /^[ET1]/i; 56 | } 57 | $lower_case_expect = 0 if $vms_efs_case; 58 | if ($lower_case_expect) { 59 | $simple_file = lc($simple_file); 60 | $simple2_file = lc($simple2_file); 61 | } 62 | } 63 | 64 | 65 | $dist->chdir_in; 66 | 67 | my $mb = Module::Build->new_from_context; 68 | 69 | ################################################## 70 | # 71 | # Test for valid META.yml 72 | 73 | { 74 | my $mb_prereq = { 'Module::Build' => $Module::Build::VERSION }; 75 | my $mb_config_req = { 76 | 'Module::Build' => sprintf '%2.2f', int($Module::Build::VERSION * 100)/100 77 | }; 78 | my $node; 79 | my $output = stdout_stderr_of( sub { 80 | $node = $mb->get_metadata( auto => 1 ); 81 | }); 82 | like( $output, qr/Module::Build was not found in configure_requires/, 83 | "saw warning about M::B not in configure_requires" 84 | ); 85 | 86 | # exists() doesn't seem to work here 87 | is $node->{name}, $metadata{module_name}; 88 | is $node->{version}, $metadata{dist_version}; 89 | is $node->{abstract}, $metadata{dist_abstract}; 90 | is_deeply $node->{author}, $metadata{dist_author}; 91 | is_deeply $node->{license}, [ 'perl_5' ]; 92 | is_deeply $node->{prereqs}{configure}{requires}, $mb_config_req, 'Add M::B to configure_requires'; 93 | is_deeply $node->{prereqs}{test}{requires}, { 94 | 'Test::More' => '0.49', 95 | }, 'Test::More was required by ->new'; 96 | like $node->{generated_by}, qr{Module::Build}; 97 | ok defined( $node->{'meta-spec'}{version} ), 98 | "'meta-spec' -> 'version' field present in META.yml"; 99 | ok defined( $node->{'meta-spec'}{url} ), 100 | "'meta-spec' -> 'url' field present in META.yml"; 101 | is_deeply $node->{keywords}, $metadata{meta_add}{keywords}; 102 | is_deeply $node->{resources}, $metadata{meta_add}{resources}; 103 | } 104 | 105 | { 106 | my $mb_prereq = { 'Module::Build' => 0 }; 107 | $mb->configure_requires( $mb_prereq ); 108 | my $node = $mb->get_metadata( auto => 1 ); 109 | 110 | 111 | # exists() doesn't seem to work here 112 | is_deeply $node->{prereqs}{configure}{requires}, $mb_prereq, 'Add M::B to configure_requires'; 113 | } 114 | 115 | $dist->clean; 116 | 117 | -------------------------------------------------------------------------------- /t/metadata2.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | 7 | if (eval { require CPAN::Meta; CPAN::Meta->VERSION(2.142060) }) { 8 | plan(tests => 18); 9 | } 10 | else { 11 | plan(skip_all => 'No or old CPAN::Meta'); 12 | } 13 | 14 | blib_load('Module::Build'); 15 | blib_load('Module::Build::ConfigData'); 16 | 17 | use DistGen; 18 | 19 | 20 | ############################## ACTION distmeta works without a MANIFEST file 21 | 22 | { 23 | my $dist = DistGen->new( no_manifest => 1 )->chdir_in->regen; 24 | 25 | ok ! -e 'MANIFEST'; 26 | 27 | my $mb; 28 | stderr_of( sub { $mb = Module::Build->new_from_context } ); 29 | 30 | my $out; 31 | $out = eval { stderr_of(sub{$mb->dispatch('distmeta')}) }; 32 | is $@, ''; 33 | 34 | like $out, qr/Nothing to enter for 'provides'/; 35 | 36 | ok -e 'META.yml'; 37 | 38 | } 39 | 40 | 41 | ############################## Check generation of README file 42 | 43 | # TODO: We need to test faking the absence of Pod::Readme when present 44 | # so Pod::Text will be used. Also fake the absence of both to 45 | # test that we fail gracefully. 46 | 47 | my $provides; # Used a bunch of times below 48 | 49 | my $pod_text = <<'---'; 50 | =pod 51 | 52 | =head1 NAME 53 | 54 | Simple - A simple module 55 | 56 | =head1 AUTHOR 57 | 58 | Simple Simon 59 | 60 | =cut 61 | --- 62 | 63 | my $dist = DistGen->new->chdir_in; 64 | 65 | $dist->change_build_pl 66 | ({ 67 | module_name => $dist->name, 68 | dist_version => '3.14159265', 69 | license => 'perl', 70 | create_readme => 1, 71 | }); 72 | 73 | # .pm File with pod 74 | # 75 | 76 | $dist->change_file( 'lib/Simple.pm', <<'---' . $pod_text); 77 | package Simple; 78 | $VERSION = '1.23'; 79 | --- 80 | $dist->regen( clean => 1 ); 81 | ok( -e "lib/Simple.pm", "Creating Simple.pm" ); 82 | my $mb = Module::Build->new_from_context; 83 | $mb->do_create_readme; 84 | like( slurp("README"), qr/NAME/, 85 | "Generating README from .pm"); 86 | is( $mb->dist_author->[0], 'Simple Simon ', 87 | "Extracting AUTHOR from .pm"); 88 | is( $mb->dist_abstract, "A simple module", 89 | "Extracting abstract from .pm"); 90 | 91 | # .pm File with pod in separate file 92 | # 93 | 94 | $dist->change_file( 'lib/Simple.pm', <<'---'); 95 | package Simple; 96 | $VERSION = '1.23'; 97 | --- 98 | $dist->change_file( 'lib/Simple.pod', $pod_text ); 99 | $dist->regen( clean => 1 ); 100 | 101 | ok( -e "lib/Simple.pm", "Creating Simple.pm" ); 102 | ok( -e "lib/Simple.pod", "Creating Simple.pod" ); 103 | $mb = Module::Build->new_from_context; 104 | $mb->do_create_readme; 105 | like( slurp("README"), qr/NAME/, "Generating README from .pod"); 106 | is( $mb->dist_author->[0], 'Simple Simon ', 107 | "Extracting AUTHOR from .pod"); 108 | is( $mb->dist_abstract, "A simple module", 109 | "Extracting abstract from .pod"); 110 | 111 | # .pm File with pod and separate pod file 112 | # 113 | 114 | $dist->change_file( 'lib/Simple.pm', <<'---' ); 115 | package Simple; 116 | $VERSION = '1.23'; 117 | 118 | =pod 119 | 120 | =head1 DONT USE THIS FILE FOR POD 121 | 122 | =cut 123 | --- 124 | $dist->change_file( 'lib/Simple.pod', $pod_text ); 125 | $dist->regen( clean => 1 ); 126 | ok( -e "lib/Simple.pm", "Creating Simple.pm" ); 127 | ok( -e "lib/Simple.pod", "Creating Simple.pod" ); 128 | $mb = Module::Build->new_from_context; 129 | $mb->do_create_readme; 130 | like( slurp("README"), qr/NAME/, "Generating README from .pod over .pm"); 131 | is( $mb->dist_author->[0], 'Simple Simon ', 132 | "Extracting AUTHOR from .pod over .pm"); 133 | is( $mb->dist_abstract, "A simple module", 134 | "Extracting abstract from .pod over .pm"); 135 | 136 | -------------------------------------------------------------------------------- /t/mymeta.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | 7 | if (eval { require CPAN::Meta; CPAN::Meta->VERSION(2.142060) }) { 8 | plan(tests => 41); 9 | require CPAN::Meta::YAML; 10 | require Parse::CPAN::Meta; 11 | } 12 | else { 13 | plan(skip_all => 'No or old CPAN::Meta'); 14 | } 15 | 16 | blib_load('Module::Build'); 17 | 18 | my $tmp = MBTest->tmpdir; 19 | 20 | use DistGen; 21 | my $dist = DistGen->new( dir => $tmp ); 22 | $dist->change_file('Build.PL', <<"---"); 23 | use strict; 24 | use Module::Build; 25 | 26 | my \$builder = Module::Build->new( 27 | module_name => '$dist->{name}', 28 | license => 'perl', 29 | requires => { 30 | 'File::Spec' => ( \$ENV{BUMP_PREREQ} ? 0.86 : 0 ), 31 | }, 32 | configure_requires => { 33 | 'Module::Build' => '0.42', 34 | } 35 | ); 36 | 37 | \$builder->create_build_script(); 38 | --- 39 | $dist->regen; 40 | $dist->chdir_in; 41 | 42 | ######################### 43 | 44 | # Test MYMETA generation 45 | { 46 | ok( ! -e "META.yml", "META.yml doesn't exist before Build.PL runs" ); 47 | ok( ! -e "MYMETA.yml", "MYMETA.yml doesn't exist before Build.PL runs" ); 48 | ok( ! -e "META.json", "META.json doesn't exist before Build.PL runs" ); 49 | ok( ! -e "MYMETA.json", "MYMETA.json doesn't exist before Build.PL runs" ); 50 | my $output; 51 | $output = stdout_of sub { $dist->run_build_pl }; 52 | like($output, qr/Created MYMETA\.yml and MYMETA\.json/, 53 | "Ran Build.PL and saw MYMETA.yml creation message" 54 | ); 55 | ok( -e "MYMETA.yml", "MYMETA.yml exists" ); 56 | ok( -e "MYMETA.json", "MYMETA.json exists" ); 57 | } 58 | 59 | ######################### 60 | 61 | # Test interactions between META/MYMETA 62 | { 63 | my $output = stdout_stderr_of sub { $dist->run_build('distmeta') }; 64 | like($output, qr/Created META\.yml and META\.json/, 65 | "Ran Build distmeta to create META.yml"); 66 | # regenerate MYMETA to pick up from META instead of creating from scratch 67 | $output = stdout_of sub { $dist->run_build_pl }; 68 | like($output, qr/Created MYMETA\.yml and MYMETA\.json/, 69 | "Re-ran Build.PL and regenerated MYMETA.yml based on META.yml" 70 | ); 71 | 72 | for my $suffix ( qw/.yml .json/ ) { 73 | my $meta = Parse::CPAN::Meta->load_file("META$suffix"); 74 | my $mymeta = Parse::CPAN::Meta->load_file("MYMETA$suffix"); 75 | is( delete $meta->{dynamic_config}, 1, 76 | "META$suffix 'dynamic_config' is 1" 77 | ); 78 | is( delete $mymeta->{dynamic_config}, 0, 79 | "MYMETA$suffix 'dynamic_config' is 0" 80 | ); 81 | 82 | my $have_url = delete $mymeta->{'meta-spec'}->{url}; 83 | my $want_url = delete $meta->{'meta-spec'}->{url}; 84 | 85 | is_deeply( $mymeta, $meta, "Other generated MYMETA$suffix matches generated META$suffix" ) 86 | or do { 87 | require Data::Dumper; 88 | diag "MYMETA:\n" . Data::Dumper::Dumper($mymeta) 89 | . "META:\n" . Data::Dumper::Dumper($meta); 90 | }; 91 | 92 | like $have_url, qr{Meta(::|-)Spec}i, "CPAN meta spec mentioned in meta-spec URL"; 93 | } 94 | 95 | $output = stdout_stderr_of sub { $dist->run_build('realclean') }; 96 | like( $output, qr/Cleaning up/, "Ran realclean"); 97 | ok( ! -e 'Build', "Build file removed" ); 98 | ok( ! -e 'MYMETA.yml', "MYMETA.yml file removed" ); 99 | ok( ! -e 'MYMETA.json', "MYMETA.json file removed" ); 100 | 101 | # test that dynamic prereq is picked up 102 | my $meta = Parse::CPAN::Meta->load_file("META.yml"); 103 | my $meta2 = Parse::CPAN::Meta->load_file("META.json"); 104 | local $ENV{BUMP_PREREQ} = 1; 105 | $output = stdout_of sub { $dist->run_build_pl }; 106 | like($output, qr/Created MYMETA\.yml and MYMETA\.json/, 107 | "Ran Build.PL with dynamic config" 108 | ); 109 | ok( -e "MYMETA.yml", "MYMETA.yml exists" ); 110 | ok( -e "MYMETA.json", "MYMETA.json exists" ); 111 | my $mymeta = Parse::CPAN::Meta->load_file('MYMETA.yml'); 112 | my $mymeta2 = Parse::CPAN::Meta->load_file('MYMETA.json'); 113 | isnt( $meta->{requires}{'File::Spec'}, 114 | $mymeta->{requires}{'File::Spec'}, 115 | "MYMETA.yml requires differs from META.yml" 116 | ); 117 | isnt( $meta2->{prereqs}{runtime}{requires}{'File::Spec'}, 118 | $mymeta2->{prereqs}{runtime}{requires}{'File::Spec'}, 119 | "MYMETA.json requires differs from META.json" 120 | ); 121 | $output = stdout_stderr_of sub { $dist->run_build('realclean') }; 122 | like( $output, qr/Cleaning up/, "Ran realclean"); 123 | ok( ! -e 'Build', "Build file removed" ); 124 | ok( ! -e 'MYMETA.yml', "MYMETA file removed" ); 125 | ok( ! -e 'MYMETA.json', "MYMETA file removed" ); 126 | 127 | # manually change META and check that changes are preserved 128 | $meta->{author} = ['John Gault']; 129 | $meta2->{author} = ['John Gault']; 130 | ok( CPAN::Meta::YAML->new($meta)->write('META.yml'), 131 | "Wrote manually modified META.yml" ); 132 | ok( CPAN::Meta->new( $meta2 )->save('META.json'), 133 | "Wrote manually modified META.json" ); 134 | 135 | $output = stdout_of sub { $dist->run_build_pl }; 136 | like($output, qr/Created MYMETA\.yml and MYMETA\.json/, 137 | "Ran Build.PL" 138 | ); 139 | $mymeta = Parse::CPAN::Meta->load_file('MYMETA.yml'); 140 | $mymeta2 = Parse::CPAN::Meta->load_file('MYMETA.json'); 141 | is_deeply( $mymeta->{author}, [ 'John Gault' ], 142 | "MYMETA.yml preserved META.yml modifications" 143 | ); 144 | is_deeply( $mymeta2->{author}, [ 'John Gault' ], 145 | "MYMETA.json preserved META.json modifications" 146 | ); 147 | 148 | } 149 | 150 | ######################### 151 | 152 | # Test cleanup 153 | { 154 | my $output = stdout_stderr_of sub { $dist->run_build('distcheck') }; 155 | like($output, qr/Creating a temporary 'MANIFEST.SKIP'/, 156 | "MANIFEST.SKIP created for distcheck" 157 | ); 158 | unlike($output, qr/MYMETA/, 159 | "MYMETA not flagged by distcheck" 160 | ); 161 | } 162 | 163 | 164 | { 165 | my $output = stdout_of sub { $dist->run_build_pl }; 166 | like($output, qr/Created MYMETA\.yml and MYMETA\.json/, 167 | "Ran Build.PL and saw MYMETA.yml creation message" 168 | ); 169 | $output = stdout_stderr_of sub { $dist->run_build('distclean') }; 170 | ok( ! -f 'MYMETA.yml', "No MYMETA.yml after distclean" ); 171 | ok( ! -f 'MYMETA.json', "No MYMETA.json after distclean" ); 172 | ok( ! -f 'MANIFEST.SKIP', "No MANIFEST.SKIP after distclean" ); 173 | } 174 | 175 | 176 | -------------------------------------------------------------------------------- /t/new_from_context.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 2; 6 | 7 | blib_load('Module::Build'); 8 | 9 | my $tmp = MBTest->tmpdir; 10 | 11 | use DistGen; 12 | my $dist = DistGen->new( dir => $tmp ); 13 | 14 | my $libdir = 'badlib'; 15 | $dist->add_file("$libdir/Build.PL", 'die'); 16 | $dist->regen; 17 | 18 | $dist->chdir_in; 19 | 20 | 21 | unshift(@INC, $libdir); 22 | my $mb = eval { Module::Build->new_from_context}; 23 | ok(! $@, 'dodged the bullet') or die; 24 | ok($mb); 25 | 26 | # vim:ts=2:sw=2:et:sta 27 | -------------------------------------------------------------------------------- /t/notes.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 11; 6 | 7 | blib_load('Module::Build'); 8 | 9 | my $tmp = MBTest->tmpdir; 10 | 11 | use DistGen; 12 | my $dist = DistGen->new( dir => $tmp ); 13 | $dist->regen; 14 | 15 | $dist->chdir_in; 16 | 17 | 18 | ################################### 19 | $dist->change_file( 'Build.PL', <<"---" ); 20 | use strict; 21 | use warnings; 22 | use Module::Build; 23 | 24 | my \$build = Module::Build->new( 25 | module_name => '@{[$dist->name]}', 26 | license => 'perl' 27 | ); 28 | \$build->create_build_script; 29 | \$build->notes(foo => 'bar'); 30 | --- 31 | 32 | $dist->regen; 33 | 34 | my $mb = Module::Build->new_from_context; 35 | 36 | is $mb->notes('foo'), 'bar'; 37 | 38 | # Try setting & checking a new value 39 | $mb->notes(argh => 'new'); 40 | is $mb->notes('argh'), 'new'; 41 | 42 | # Change existing value 43 | $mb->notes(foo => 'foo'); 44 | is $mb->notes('foo'), 'foo'; 45 | 46 | # Change back so we can run this test again successfully 47 | $mb->notes(foo => 'bar'); 48 | is $mb->notes('foo'), 'bar'; 49 | 50 | # Check undef vs. 0 vs '' 51 | foreach my $val (undef, 0, '') { 52 | $mb->notes(null => $val); 53 | is $mb->notes('null'), $val; 54 | } 55 | 56 | 57 | ################################### 58 | # Make sure notes set before create_build_script() get preserved 59 | $mb = Module::Build->new(module_name => $dist->name); 60 | ok $mb; 61 | $mb->notes(foo => 'bar'); 62 | is $mb->notes('foo'), 'bar'; 63 | 64 | $mb->create_build_script; 65 | 66 | $mb = Module::Build->resume; 67 | ok $mb; 68 | is $mb->notes('foo'), 'bar'; 69 | 70 | -------------------------------------------------------------------------------- /t/par.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | blib_load('Module::Build'); 7 | blib_load('Module::Build::ConfigData'); 8 | 9 | my $tmp; 10 | 11 | { 12 | my ($have_c_compiler, $tmp_exec) = check_compiler(); 13 | if ( ! $have_c_compiler ) { 14 | plan skip_all => 'No compiler found'; 15 | } elsif ( ! eval {require PAR::Dist; PAR::Dist->VERSION(0.17)} ) { 16 | plan skip_all => "PAR::Dist 0.17 or up not installed to check .par's."; 17 | } elsif ( ! eval {require Archive::Zip} ) { 18 | plan skip_all => "Archive::Zip required."; 19 | } else { 20 | plan tests => 3; 21 | } 22 | require Cwd; 23 | $tmp = MBTest->tmpdir( $tmp_exec ? () : (DIR => Cwd::cwd) ); 24 | } 25 | 26 | 27 | 28 | use DistGen; 29 | my $dist = DistGen->new( dir => $tmp, xs => 1 ); 30 | $dist->add_file( 'hello', <<'---' ); 31 | #!perl -w 32 | print "Hello, World!\n"; 33 | __END__ 34 | 35 | =pod 36 | 37 | =head1 NAME 38 | 39 | hello 40 | 41 | =head1 DESCRIPTION 42 | 43 | Says "Hello" 44 | 45 | =cut 46 | --- 47 | $dist->change_build_pl 48 | ({ 49 | module_name => $dist->name, 50 | version => '0.01', 51 | license => 'perl', 52 | scripts => [ 'hello' ], 53 | }); 54 | $dist->regen; 55 | 56 | $dist->chdir_in; 57 | 58 | use File::Spec::Functions qw(catdir); 59 | 60 | my @installstyle = qw(lib perl5); 61 | my $mb = Module::Build->new_from_context( 62 | verbose => 0, 63 | quiet => 1, 64 | 65 | installdirs => 'site', 66 | ); 67 | 68 | my $filename = $mb->dispatch('pardist'); 69 | 70 | ok( -f $filename, '.par distributions exists' ); 71 | my $distname = $dist->name; 72 | ok( $filename =~ /^\Q$distname\E/, 'Distribution name seems correct' ); 73 | 74 | #--------------------------------------------------------------------------# 75 | # must work around broken Archive::Zip (1.28) which breaks PAR::Dist 76 | #--------------------------------------------------------------------------# 77 | 78 | SKIP: { 79 | my $zip = Archive::Zip->new; 80 | my $tmp2 = MBTest->tmpdir; 81 | local %SIG; 82 | $SIG{__WARN__} = sub { print STDERR $_[0] unless $_[0] =~ /\bstat\b/ }; 83 | skip "broken Archive::Zip", 1 84 | unless eval { $zip->read($filename) == Archive::Zip::AZ_OK() } 85 | && eval { $zip->extractTree('', "$tmp2/") == Archive::Zip::AZ_OK() } 86 | && -r File::Spec->catfile( $tmp2, 'blib', 'META.yml' ); 87 | 88 | my $meta; 89 | eval { $meta = PAR::Dist::get_meta($filename) }; 90 | 91 | ok( 92 | (not $@ and defined $meta and not $meta eq ''), 93 | 'Distribution contains META.yml' 94 | ); 95 | } 96 | 97 | -------------------------------------------------------------------------------- /t/parents.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 26; 6 | 7 | blib_load('Module::Build'); 8 | 9 | ######################### 10 | 11 | package Foo; 12 | sub foo; 13 | 14 | package MySub1; 15 | use base 'Module::Build'; 16 | 17 | package MySub2; 18 | use base 'MySub1'; 19 | 20 | package MySub3; 21 | use base qw(MySub2 Foo); 22 | 23 | package MyTest; 24 | use base 'Module::Build'; 25 | 26 | package MyBulk; 27 | use base qw(MySub2 MyTest); 28 | 29 | package main; 30 | 31 | ok my @parents = MySub1->mb_parents; 32 | # There will be at least one platform class in between. 33 | ok @parents >= 2; 34 | # They should all inherit from Module::Build::Base; 35 | ok ! grep { !$_->isa('Module::Build::Base') } @parents; 36 | is $parents[0], 'Module::Build'; 37 | is $parents[-1], 'Module::Build::Base'; 38 | 39 | ok @parents = MySub2->mb_parents; 40 | ok @parents >= 3; 41 | ok ! grep { !$_->isa('Module::Build::Base') } @parents; 42 | is $parents[0], 'MySub1'; 43 | is $parents[1], 'Module::Build'; 44 | is $parents[-1], 'Module::Build::Base'; 45 | 46 | ok @parents = MySub3->mb_parents; 47 | ok @parents >= 4; 48 | ok ! grep { !$_->isa('Module::Build::Base') } @parents; 49 | is $parents[0], 'MySub2'; 50 | is $parents[1], 'MySub1'; 51 | is $parents[2], 'Module::Build'; 52 | is $parents[-1], 'Module::Build::Base'; 53 | 54 | ok @parents = MyBulk->mb_parents; 55 | ok @parents >= 5; 56 | ok ! grep { !$_->isa('Module::Build::Base') } @parents; 57 | is $parents[0], 'MySub2'; 58 | is $parents[1], 'MySub1'; 59 | is $parents[2], 'Module::Build'; 60 | is $parents[-2], 'Module::Build::Base'; 61 | is $parents[-1], 'MyTest'; 62 | -------------------------------------------------------------------------------- /t/perl_mb_opt.t: -------------------------------------------------------------------------------- 1 | # sample.t -- a sample test file for Module::Build 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | use DistGen; 7 | 8 | plan tests => 8; # or 'no_plan' 9 | 10 | # Ensure any Module::Build modules are loaded from correct directory 11 | blib_load('Module::Build'); 12 | 13 | # create dist object in a temp directory 14 | # enter the directory and generate the skeleton files 15 | my $dist = DistGen->new->chdir_in->regen; 16 | 17 | $dist->add_file('t/subtest/foo.t', <<'END_T'); 18 | use strict; 19 | use Test::More tests => 1; 20 | ok(1, "this is a recursive test"); 21 | END_T 22 | 23 | $dist->regen; 24 | 25 | # get a Module::Build object and test with it 26 | my $mb = $dist->new_from_context(); # quiet by default 27 | isa_ok( $mb, "Module::Build" ); 28 | is( $mb->dist_name, "Simple", "dist_name is 'Simple'" ); 29 | ok( ! $mb->recursive_test_files, "set for no recursive testing" ); 30 | 31 | # set for recursive testing using PERL_MB_OPT 32 | { 33 | local $ENV{PERL_MB_OPT} = "--verbose --recursive_test_files 1"; 34 | 35 | my $out = stdout_stderr_of( sub { 36 | $dist->run_build('test'); 37 | }); 38 | like( $out, qr/this is a recursive test/, 39 | "recursive tests run via PERL_MB_OPT" 40 | ); 41 | } 42 | 43 | # set Build.PL opts using PERL_MB_OPT 44 | { 45 | local $ENV{PERL_MB_OPT} = "--verbose --recursive_test_files 1"; 46 | my $mb = $dist->new_from_context(); # quiet by default 47 | ok( $mb->recursive_test_files, "PERL_MB_OPT set recusive tests in Build.PL" ); 48 | ok( $mb->verbose, "PERL_MB_OPT set verbose in Build.PL" ); 49 | } 50 | 51 | # verify settings preserved during 'Build test' 52 | { 53 | ok( !$ENV{PERL_MB_OPT}, "PERL_MB_OPT cleared" ); 54 | my $out = stdout_stderr_of( sub { 55 | $dist->run_build('test'); 56 | }); 57 | like( $out, qr/this is a recursive test/, 58 | "recursive tests run via Build object" 59 | ); 60 | } 61 | 62 | # vim:ts=2:sw=2:et:sta:sts=2 63 | -------------------------------------------------------------------------------- /t/pod_parser.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 16; 6 | 7 | use Encode 'encode'; 8 | 9 | blib_load('Module::Build::PodParser'); 10 | 11 | ######################### 12 | 13 | { 14 | open my $fh, '<', \<<'EOF'; 15 | =head1 NAME 16 | 17 | Foo::Bar - Perl extension for blah blah blah 18 | 19 | =head1 AUTHOR 20 | 21 | C was written by Engelbert Humperdinck Ieh@example.comE> in 2004. 22 | 23 | Home page: http://example.com/~eh/ 24 | 25 | =cut 26 | EOF 27 | 28 | 29 | my $pp = Module::Build::PodParser->new(fh => $fh); 30 | ok $pp, 'object created'; 31 | 32 | is $pp->get_author->[0], 'C was written by Engelbert Humperdinck Ieh@example.comE> in 2004.', 'author'; 33 | is $pp->get_abstract, 'Perl extension for blah blah blah', 'abstract'; 34 | } 35 | 36 | { 37 | # Try again without a valid author spec 38 | open my $fh, '<', \<<'EOF'; 39 | =head1 NAME 40 | 41 | Foo::Bar - Perl extension for blah blah blah 42 | 43 | =cut 44 | EOF 45 | 46 | my $pp = Module::Build::PodParser->new(fh => $fh); 47 | ok $pp, 'object created'; 48 | 49 | is_deeply $pp->get_author, [], 'author'; 50 | is $pp->get_abstract, 'Perl extension for blah blah blah', 'abstract'; 51 | } 52 | 53 | 54 | { 55 | # Try again with mixed-case =head1s. 56 | open my $fh, '<', \<<'EOF'; 57 | =head1 Name 58 | 59 | Foo::Bar - Perl extension for blah blah blah 60 | 61 | =head1 Author 62 | 63 | C was written by Engelbert Humperdinck Ieh@example.comE> in 2004. 64 | 65 | Home page: http://example.com/~eh/ 66 | 67 | =cut 68 | EOF 69 | 70 | my $pp = Module::Build::PodParser->new(fh => $fh); 71 | ok $pp, 'object created'; 72 | 73 | is $pp->get_author->[0], 'C was written by Engelbert Humperdinck Ieh@example.comE> in 2004.', 'author'; 74 | is $pp->get_abstract, 'Perl extension for blah blah blah', 'abstract'; 75 | } 76 | 77 | 78 | { 79 | # Now with C 80 | open my $fh, '<', \<<'EOF'; 81 | =head1 Name 82 | 83 | C - Perl extension for blah blah blah 84 | 85 | =head1 Author 86 | 87 | C was written by Engelbert Humperdinck Ieh@example.comE> in 2004. 88 | 89 | Home page: http://example.com/~eh/ 90 | 91 | =cut 92 | EOF 93 | 94 | my $pp = Module::Build::PodParser->new(fh => $fh); 95 | ok $pp, 'object created'; 96 | 97 | is $pp->get_author->[0], 'C was written by Engelbert Humperdinck Ieh@example.comE> in 2004.', 'author'; 98 | is $pp->get_abstract, 'Perl extension for blah blah blah', 'abstract'; 99 | } 100 | 101 | { 102 | open my $fh, '<', \<<'EOF'; 103 | =head1 NAME 104 | 105 | Foo_Bar - Perl extension for eating pie 106 | 107 | =head1 AUTHOR 108 | 109 | C was written by Engelbert Humperdinck Ieh@example.comE> in 2004. 110 | 111 | Home page: http://example.com/~eh/ 112 | 113 | =cut 114 | EOF 115 | 116 | 117 | my $pp = Module::Build::PodParser->new(fh => $fh); 118 | ok $pp, 'object created'; 119 | is $pp->get_abstract, 'Perl extension for eating pie', 'abstract'; 120 | } 121 | 122 | { 123 | open my $fh, '<', \ encode 'UTF-8', <<"EOF"; 124 | =encoding utf8 125 | 126 | =head1 NAME 127 | 128 | Foo_Bar - I \x{2764} Perl 129 | 130 | =head1 AUTHOR 131 | 132 | C was written by Engelbert Humperdinck Ieh\@example.comE> in 2004. 133 | 134 | Home page: http://example.com/~eh/ 135 | 136 | =cut 137 | EOF 138 | 139 | my $pp = Module::Build::PodParser->new(fh => $fh); 140 | ok $pp, 'object created'; 141 | is $pp->get_abstract, "I \x{2764} Perl", 'abstract with unicode'; 142 | } 143 | -------------------------------------------------------------------------------- /t/ppm.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | use Config; 7 | 8 | blib_load('Module::Build'); 9 | blib_load('Module::Build::ConfigData'); 10 | my $PPM_support = Module::Build::ConfigData->feature('PPM_support'); 11 | my $manpage_support = Module::Build::ConfigData->feature('manpage_support'); 12 | my $HTML_support = Module::Build::ConfigData->feature('HTML_support'); 13 | 14 | my $tmp; 15 | 16 | { 17 | my ($have_c_compiler, $tmp_exec) = check_compiler(); 18 | if ( ! $have_c_compiler ) { 19 | plan skip_all => 'No compiler found'; 20 | } elsif ( ! $tmp_exec ) { 21 | plan skip_all => 'Dysfunctional compiler detected'; 22 | } elsif ( ! $PPM_support ) { 23 | plan skip_all => 'PPM support modules not installed'; 24 | } elsif ( !$Config{usedl} ) { 25 | plan skip_all => 'Perl not compiled for dynamic loading'; 26 | } elsif ( ! $HTML_support ) { 27 | plan skip_all => "HTML support not installed"; 28 | } elsif ( ! eval {require Archive::Tar} ) { 29 | plan skip_all => "Archive::Tar not installed to read archives."; 30 | } elsif ( ! eval {IO::Zlib->VERSION(1.01)} ) { 31 | plan skip_all => "IO::Zlib 1.01 required to read compressed archives."; 32 | } elsif ( $^O eq 'VMS' ) { 33 | plan skip_all => "Needs porting work on VMS"; 34 | } else { 35 | plan tests => 12; 36 | } 37 | require Cwd; 38 | $tmp = MBTest->tmpdir( $tmp_exec ? () : (DIR => Cwd::cwd) ); 39 | } 40 | 41 | 42 | use DistGen; 43 | my $dist = DistGen->new( dir => $tmp, xs => 1 ); 44 | $dist->add_file( 'hello', <<'---' ); 45 | #!perl -w 46 | print "Hello, World!\n"; 47 | __END__ 48 | 49 | =pod 50 | 51 | =head1 NAME 52 | 53 | hello 54 | 55 | =head1 DESCRIPTION 56 | 57 | Says "Hello" 58 | 59 | =cut 60 | --- 61 | $dist->change_build_pl 62 | ({ 63 | module_name => $dist->name, 64 | license => 'perl', 65 | scripts => [ 'hello' ], 66 | }); 67 | $dist->regen; 68 | 69 | $dist->chdir_in; 70 | 71 | use File::Spec::Functions qw(catdir); 72 | 73 | my @installstyle = qw(lib perl5); 74 | my $mb = Module::Build->new_from_context( 75 | verbose => 0, 76 | quiet => 1, 77 | 78 | installdirs => 'site', 79 | config => { 80 | manpage_reset(), html_reset(), 81 | ( $manpage_support ? 82 | ( installsiteman1dir => catdir($tmp, 'site', 'man', 'man1'), 83 | installsiteman3dir => catdir($tmp, 'site', 'man', 'man3') ) : () ), 84 | ( $HTML_support ? 85 | ( installsitehtml1dir => catdir($tmp, 'site', 'html'), 86 | installsitehtml3dir => catdir($tmp, 'site', 'html') ) : () ), 87 | }, 88 | html_links => 0, 89 | ); 90 | 91 | 92 | 93 | $mb->dispatch('ppd', args => {codebase => '/path/to/codebase-xs'}); 94 | 95 | (my $dist_filename = $dist->name) =~ s/::/-/g; 96 | my $ppd = slurp($dist_filename . '.ppd'); 97 | 98 | my $perl_version = Module::Build::PPMMaker->_ppd_version($mb->perl_version); 99 | my $varchname = Module::Build::PPMMaker->_varchname($mb->config); 100 | 101 | # This test is quite a hack since with XML you don't really want to 102 | # do a strict string comparison, but absent an XML parser it's the 103 | # best we can do. 104 | is $ppd, <<"---"; 105 | 106 | Perl extension for blah blah blah 107 | A. U. Thor, a.u.thor\@a.galaxy.far.far.away 108 | 109 | 110 | 111 | 112 | 113 | --- 114 | 115 | 116 | 117 | $mb->dispatch('ppmdist'); 118 | is $@, ''; 119 | 120 | my $tar = Archive::Tar->new; 121 | 122 | my $tarfile = $mb->ppm_name . '.tar.gz'; 123 | $tar->read( $tarfile, 1 ); 124 | 125 | my $files = { map { $_ => 1 } $tar->list_files }; 126 | 127 | my $fname = 'Simple'; 128 | $fname = DynaLoader::mod2fname([$fname]) if defined &DynaLoader::mod2fname; 129 | exists_ok($files, "blib/arch/auto/Simple/$fname." . $mb->config('dlext')); 130 | exists_ok($files, 'blib/lib/Simple.pm'); 131 | exists_ok($files, 'blib/script/hello'); 132 | 133 | SKIP: { 134 | skip( "manpage_support not enabled.", 2 ) unless $manpage_support; 135 | 136 | exists_ok($files, 'blib/man3/Simple.' . $mb->config('man3ext')); 137 | exists_ok($files, 'blib/man1/hello.' . $mb->config('man1ext')); 138 | } 139 | 140 | SKIP: { 141 | skip( "HTML_support not enabled.", 2 ) unless $HTML_support; 142 | 143 | exists_ok($files, 'blib/html/site/lib/Simple.html'); 144 | exists_ok($files, 'blib/html/bin/hello.html'); 145 | } 146 | 147 | $tar->clear; 148 | undef( $tar ); 149 | 150 | $mb->dispatch('realclean'); 151 | $dist->clean; 152 | 153 | 154 | SKIP: { 155 | skip( "HTML_support not enabled.", 3 ) unless $HTML_support; 156 | 157 | # Make sure html documents are generated for the ppm distro even when 158 | # they would not be built during a normal build. 159 | $mb = Module::Build->new_from_context( 160 | verbose => 0, 161 | quiet => 1, 162 | 163 | installdirs => 'site', 164 | config => { 165 | html_reset(), 166 | installsiteman1dir => catdir($tmp, 'site', 'man', 'man1'), 167 | installsiteman3dir => catdir($tmp, 'site', 'man', 'man3'), 168 | }, 169 | html_links => 0, 170 | ); 171 | 172 | $mb->dispatch('ppmdist'); 173 | is $@, ''; 174 | 175 | $tar = Archive::Tar->new; 176 | $tar->read( $tarfile, 1 ); 177 | 178 | $files = {map { $_ => 1 } $tar->list_files}; 179 | 180 | exists_ok($files, 'blib/html/site/lib/Simple.html'); 181 | exists_ok($files, 'blib/html/bin/hello.html'); 182 | 183 | $tar->clear; 184 | 185 | $mb->dispatch('realclean'); 186 | $dist->clean; 187 | } 188 | 189 | 190 | ######################################## 191 | 192 | sub exists_ok { 193 | my $files = shift; 194 | my $file = shift; 195 | local $Test::Builder::Level = $Test::Builder::Level + 1; 196 | ok exists( $files->{$file} ) && $files->{$file}, $file; 197 | } 198 | 199 | # A hash of all Config.pm settings related to installing 200 | # manpages with values set to an empty string. 201 | sub manpage_reset { 202 | return ( 203 | installman1dir => '', 204 | installman3dir => '', 205 | installsiteman1dir => '', 206 | installsiteman3dir => '', 207 | installvendorman1dir => '', 208 | installvendorman3dir => '', 209 | ); 210 | } 211 | 212 | # A hash of all Config.pm settings related to installing 213 | # html documents with values set to an empty string. 214 | sub html_reset { 215 | return ( 216 | installhtmldir => '', 217 | installhtml1dir => '', 218 | installhtml3dir => '', 219 | installsitehtml1dir => '', 220 | installsitehtml3dir => '', 221 | installvendorhtml1dir => '', 222 | installvendorhtml3dir => '', 223 | ); 224 | } 225 | 226 | -------------------------------------------------------------------------------- /t/properties/dist_suffix.t: -------------------------------------------------------------------------------- 1 | # sample.t -- a sample test file for Module::Build 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | use DistGen; 7 | 8 | plan tests => 2; 9 | 10 | # Ensure any Module::Build modules are loaded from correct directory 11 | blib_load('Module::Build'); 12 | 13 | #--------------------------------------------------------------------------# 14 | # Create test distribution 15 | #--------------------------------------------------------------------------# 16 | 17 | use DistGen; 18 | my $dist = DistGen->new( name => 'Simple::Name' ); 19 | 20 | $dist->change_build_pl( 21 | module_name => 'Simple::Name', 22 | dist_suffix => 'SUFFIX', 23 | )->regen; 24 | 25 | $dist->chdir_in; 26 | 27 | my $mb = $dist->new_from_context(); 28 | isa_ok( $mb, "Module::Build" ); 29 | is( $mb->dist_dir, "Simple-Name-0.01-SUFFIX", 30 | "dist_suffix set correctly" 31 | ); 32 | 33 | # vim:ts=2:sw=2:et:sta:sts=2 34 | -------------------------------------------------------------------------------- /t/properties/license.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib 't/lib'; 3 | use MBTest; 4 | use DistGen; 5 | 6 | if (eval { require CPAN::Meta; CPAN::Meta->VERSION(2.142060) }) { 7 | plan('no_plan'); 8 | require CPAN::Meta::YAML; 9 | require Parse::CPAN::Meta; 10 | } 11 | else { 12 | plan(skip_all => 'No or old CPAN::Meta'); 13 | } 14 | 15 | # Ensure any Module::Build modules are loaded from correct directory 16 | blib_load('Module::Build'); 17 | 18 | #--------------------------------------------------------------------------# 19 | # Create test distribution 20 | #--------------------------------------------------------------------------# 21 | 22 | { 23 | my $dist = DistGen->new( 24 | name => 'Simple::Name', 25 | version => '0.01', 26 | license => 'perl' 27 | ); 28 | 29 | $dist->regen; 30 | $dist->chdir_in; 31 | 32 | my $mb = $dist->new_from_context(); 33 | isa_ok( $mb, "Module::Build" ); 34 | is( $mb->license, 'perl', 35 | "license 'perl' is valid" 36 | ); 37 | 38 | my $meta = $mb->get_metadata( fatal => 0 ); 39 | 40 | is_deeply( $meta->{license} => [ 'perl_5' ], "META license will be 'perl'" ); 41 | is_deeply( $meta->{resources}{license}, [ "http://dev.perl.org/licenses/" ], 42 | "META license URL is correct" 43 | ); 44 | 45 | } 46 | 47 | { 48 | my $dist = DistGen->new( 49 | name => 'Simple::Name', 50 | version => '0.01', 51 | license => 'VaporWare' 52 | ); 53 | 54 | $dist->regen; 55 | $dist->chdir_in; 56 | 57 | my $mb = $dist->new_from_context(); 58 | isa_ok( $mb, "Module::Build" ); 59 | is( $mb->license, 'VaporWare', 60 | "license 'VaporWare' is valid" 61 | ); 62 | 63 | my $meta = $mb->get_metadata( fatal => 0 ); 64 | 65 | is_deeply( $meta->{license} => [ 'unrestricted' ], "META license will be 'unrestricted'" ); 66 | is_deeply( $meta->{resources}{license}, [ "http://example.com/vaporware/" ], 67 | "META license URL is correct" 68 | ); 69 | 70 | } 71 | 72 | # Test with alpha number 73 | # vim:ts=2:sw=2:et:sta:sts=2 74 | -------------------------------------------------------------------------------- /t/properties/module_name.t: -------------------------------------------------------------------------------- 1 | # sample.t -- a sample test file for Module::Build 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | use DistGen; 7 | 8 | plan tests => 4; 9 | 10 | # Ensure any Module::Build modules are loaded from correct directory 11 | blib_load('Module::Build'); 12 | 13 | my $dist; 14 | 15 | #--------------------------------------------------------------------------# 16 | # try getting module_name from dist_name 17 | #--------------------------------------------------------------------------# 18 | 19 | $dist = DistGen->new( 20 | name => "Not::So::Simple", 21 | distdir => 'Random-Name', 22 | )->chdir_in; 23 | 24 | $dist->change_build_pl( 25 | dist_name => 'Not-So-Simple', 26 | dist_version => 1, 27 | )->regen; 28 | 29 | my $mb = $dist->new_from_context(); 30 | isa_ok( $mb, "Module::Build" ); 31 | is( $mb->module_name, "Not::So::Simple", 32 | "module_name guessed from dist_name" 33 | ); 34 | 35 | #--------------------------------------------------------------------------# 36 | # Try getting module_name from dist_version_from 37 | #--------------------------------------------------------------------------# 38 | 39 | $dist->add_file( 'lib/Simple/Name.pm', << 'END_PACKAGE' ); 40 | package Simple::Name; 41 | our $VERSION = 1.23; 42 | 1; 43 | END_PACKAGE 44 | 45 | $dist->change_build_pl( 46 | dist_name => 'Random-Name', 47 | dist_version_from => 'lib/Simple/Name.pm', 48 | dist_abstract => "Don't complain about missing abstract", 49 | )->regen( clean => 1 ); 50 | 51 | $mb = $dist->new_from_context(); 52 | isa_ok( $mb, "Module::Build" ); 53 | is( $mb->module_name, "Simple::Name", 54 | "module_name guessed from dist_version_from" 55 | ); 56 | 57 | # vim:ts=2:sw=2:et:sta:sts=2 58 | -------------------------------------------------------------------------------- /t/properties/needs_compiler.t: -------------------------------------------------------------------------------- 1 | # sample.t -- a sample test file for Module::Build 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | use DistGen; 7 | 8 | plan tests => 27; 9 | 10 | # Ensure any Module::Build modules are loaded from correct directory 11 | blib_load('Module::Build'); 12 | 13 | my $dist = DistGen->new->regen->chdir_in; 14 | 15 | # get a Module::Build object and test with it 16 | my $mb; 17 | stderr_of(sub { 18 | ok( $mb = $dist->new_from_context, "Default Build.PL" ); 19 | }); 20 | 21 | ok( ! $mb->needs_compiler, "needs_compiler is false" ); 22 | ok( ! exists $mb->{properties}{build_requires}{'ExtUtils::CBuilder'}, 23 | "ExtUtils::CBuilder is not in build_requires" 24 | ); 25 | 26 | #--------------------------------------------------------------------------# 27 | # try with c_source as a string 28 | #--------------------------------------------------------------------------# 29 | $dist->change_build_pl({ 30 | module_name => $dist->name, 31 | license => 'perl', 32 | c_source => 'src', 33 | }); 34 | $dist->regen; 35 | stderr_of(sub { 36 | ok( $mb = $dist->new_from_context, 37 | "Build.PL with string c_source" 38 | ); 39 | }); 40 | is( $mb->c_source, 'src', "c_source is set" ); 41 | ok( $mb->needs_compiler, "needs_compiler is true" ); 42 | ok( exists $mb->{properties}{build_requires}{'ExtUtils::CBuilder'}, 43 | "ExtUtils::CBuilder was added to build_requires" 44 | ); 45 | 46 | #--------------------------------------------------------------------------# 47 | # try with c_source as an array 48 | #--------------------------------------------------------------------------# 49 | $dist->change_build_pl({ 50 | module_name => $dist->name, 51 | license => 'perl', 52 | c_source => ['src'], 53 | }); 54 | $dist->regen; 55 | stderr_of(sub { 56 | ok( $mb = $dist->new_from_context, 57 | "Build.PL with non-empty array c_source" 58 | ); 59 | }); 60 | is_deeply( $mb->c_source, ['src'], "c_source is set" ); 61 | ok( $mb->needs_compiler, "needs_compiler is true" ); 62 | ok( exists $mb->{properties}{build_requires}{'ExtUtils::CBuilder'}, 63 | "ExtUtils::CBuilder was added to build_requires" 64 | ); 65 | 66 | #--------------------------------------------------------------------------# 67 | # try with c_source as an empty array 68 | #--------------------------------------------------------------------------# 69 | $dist->change_build_pl({ 70 | module_name => $dist->name, 71 | license => 'perl', 72 | c_source => [], 73 | }); 74 | $dist->regen; 75 | stderr_of(sub { 76 | ok( $mb = $dist->new_from_context, 77 | "Build.PL with empty array c_source" 78 | ); 79 | }); 80 | is_deeply( $mb->c_source, [], "c_source is set" ); 81 | ok( ! $mb->needs_compiler, "needs_compiler is false" ); 82 | ok( ! exists $mb->{properties}{build_requires}{'ExtUtils::CBuilder'}, 83 | "ExtUtils::CBuilder is not in build_requires" 84 | ); 85 | 86 | #--------------------------------------------------------------------------# 87 | # try with xs files 88 | #--------------------------------------------------------------------------# 89 | $dist = DistGen->new(dir => 'MBTest', xs => 1); 90 | $dist->regen; 91 | $dist->chdir_in; 92 | 93 | stderr_of(sub { 94 | ok( $mb = $dist->new_from_context, 95 | "Build.PL with xs files" 96 | ); 97 | }); 98 | ok( $mb->needs_compiler, "needs_compiler is true" ); 99 | ok( exists $mb->{properties}{build_requires}{'ExtUtils::CBuilder'}, 100 | "ExtUtils::CBuilder was added to build_requires" 101 | ); 102 | 103 | #--------------------------------------------------------------------------# 104 | # force needs_compiler off, despite xs modules 105 | #--------------------------------------------------------------------------# 106 | 107 | $dist->change_build_pl({ 108 | module_name => $dist->name, 109 | license => 'perl', 110 | needs_compiler => 0, 111 | }); 112 | $dist->regen; 113 | 114 | stderr_of(sub { 115 | ok( $mb = $dist->new_from_context , 116 | "Build.PL with xs files, but needs_compiler => 0" 117 | ); 118 | }); 119 | is( $mb->needs_compiler, 0, "needs_compiler is false" ); 120 | ok( ! exists $mb->{properties}{build_requires}{'ExtUtils::CBuilder'}, 121 | "ExtUtils::CBuilder is not in build_requires" 122 | ); 123 | 124 | #--------------------------------------------------------------------------# 125 | # don't override specific EU::CBuilder build_requires 126 | #--------------------------------------------------------------------------# 127 | 128 | $dist->change_build_pl({ 129 | module_name => $dist->name, 130 | license => 'perl', 131 | build_requires => { 'ExtUtils::CBuilder' => 0.2 }, 132 | }); 133 | $dist->regen; 134 | 135 | stderr_of(sub { 136 | ok( $mb = $dist->new_from_context , 137 | "Build.PL with xs files, build_requires EU::CB 0.2" 138 | ); 139 | }); 140 | ok( $mb->needs_compiler, "needs_compiler is true" ); 141 | is( $mb->build_requires->{'ExtUtils::CBuilder'}, 0.2, 142 | "build_requires for ExtUtils::CBuilder is correct version" 143 | ); 144 | 145 | #--------------------------------------------------------------------------# 146 | # falsify compiler and test error handling 147 | #--------------------------------------------------------------------------# 148 | 149 | # clear $ENV{CC} so we are sure to fail to find our fake compiler :-) 150 | local $ENV{CC}; 151 | 152 | my $err = stderr_of( sub { 153 | $mb = $dist->new_from_context( config => { cc => "adfasdfadjdjk" } ) 154 | }); 155 | ok( $mb, "Build.PL while hiding compiler" ); 156 | like( $err, qr/no compiler detected/, 157 | "hidden compiler resulted in warning message during Build.PL" 158 | ); 159 | eval { $mb->dispatch('build') }; 160 | like( $@, qr/no compiler detected/, 161 | "hidden compiler resulted in fatal message during Build" 162 | ); 163 | 164 | 165 | # vim:ts=2:sw=2:et:sta:sts=2 166 | -------------------------------------------------------------------------------- /t/properties/release_status.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib 't/lib'; 3 | use MBTest; 4 | use DistGen; 5 | 6 | if ( $] lt 5.008001 ) { 7 | plan skip_all => "dotted-version numbers are buggy before 5.8.1"; 8 | } else { 9 | plan 'no_plan'; 10 | } 11 | 12 | # Ensure any Module::Build modules are loaded from correct directory 13 | blib_load('Module::Build'); 14 | 15 | #--------------------------------------------------------------------------# 16 | # Create test distribution 17 | #--------------------------------------------------------------------------# 18 | 19 | { 20 | my $dist = DistGen->new( name => 'Simple::Name', version => '0.01' ); 21 | 22 | $dist->change_build_pl( 23 | module_name => 'Simple::Name', 24 | )->regen; 25 | 26 | $dist->chdir_in; 27 | 28 | my $mb = $dist->new_from_context(); 29 | isa_ok( $mb, "Module::Build" ); 30 | is( $mb->release_status, "stable", 31 | "regular version has release_status 'stable'" 32 | ); 33 | } 34 | 35 | { 36 | my $dist = DistGen->new( name => 'Simple::Name', version => 'v1.2.3' ); 37 | 38 | $dist->change_build_pl( 39 | module_name => 'Simple::Name', 40 | )->regen; 41 | 42 | $dist->chdir_in; 43 | 44 | my $mb = $dist->new_from_context(); 45 | isa_ok( $mb, "Module::Build" ); 46 | is( $mb->release_status, "stable", 47 | "dotted-decimal version has release_status 'stable'" 48 | ); 49 | } 50 | 51 | { 52 | my $dist = DistGen->new( name => 'Simple::Name', version => q{'0.01_01'} ); 53 | 54 | $dist->change_build_pl( 55 | module_name => 'Simple::Name', 56 | )->regen; 57 | 58 | $dist->chdir_in; 59 | 60 | my $mb = $dist->new_from_context(); 61 | isa_ok( $mb, "Module::Build" ); 62 | is( $mb->release_status, "testing", 63 | "alpha version has release_status 'testing'" 64 | ); 65 | } 66 | 67 | { 68 | my $dist = DistGen->new( name => 'Simple::Name', version => q{'0.01_01'} ); 69 | 70 | $dist->change_build_pl( 71 | module_name => 'Simple::Name', 72 | release_status => 'unstable', 73 | )->regen; 74 | 75 | $dist->chdir_in; 76 | 77 | my $mb = $dist->new_from_context(); 78 | isa_ok( $mb, "Module::Build" ); 79 | is( $mb->release_status, "unstable", 80 | "explicit 'unstable' keeps release_status 'unstable'" 81 | ); 82 | } 83 | 84 | { 85 | my $dist = DistGen->new( name => 'Simple::Name', version => '0.01' ); 86 | 87 | $dist->change_build_pl( 88 | module_name => 'Simple::Name', 89 | release_status => 'testing', 90 | )->regen; 91 | 92 | $dist->chdir_in; 93 | 94 | my $mb = $dist->new_from_context(); 95 | isa_ok( $mb, "Module::Build" ); 96 | is( $mb->dist_suffix, "TRIAL", 97 | "regular version marked 'testing' gets 'TRIAL' suffix" 98 | ); 99 | } 100 | 101 | { 102 | my $dist = DistGen->new( name => 'Simple::Name', version => 'v1.2.3' ); 103 | 104 | $dist->change_build_pl( 105 | module_name => 'Simple::Name', 106 | release_status => 'testing', 107 | )->regen; 108 | 109 | $dist->chdir_in; 110 | 111 | my $mb = $dist->new_from_context(); 112 | isa_ok( $mb, "Module::Build" ); 113 | is( $mb->dist_suffix, "TRIAL", 114 | "dotted version marked 'testing' gets 'TRIAL' suffix" 115 | ); 116 | } 117 | 118 | { 119 | my $dist = DistGen->new( name => 'Simple::Name', version => '0.01' ); 120 | 121 | $dist->change_build_pl( 122 | module_name => 'Simple::Name', 123 | release_status => 'unstable', 124 | )->regen; 125 | 126 | $dist->chdir_in; 127 | 128 | my $mb = $dist->new_from_context(); 129 | isa_ok( $mb, "Module::Build" ); 130 | is( $mb->dist_suffix, "TRIAL", 131 | "regular version marked 'unstable' gets 'TRIAL' suffix" 132 | ); 133 | } 134 | 135 | { 136 | my $dist = DistGen->new( name => 'Simple::Name', version => '0.01' ); 137 | 138 | $dist->change_build_pl( 139 | module_name => 'Simple::Name', 140 | release_status => 'beta', 141 | )->regen; 142 | 143 | $dist->chdir_in; 144 | 145 | my $output = stdout_stderr_of sub { $dist->run_build_pl() }; 146 | like( $output, qr/Illegal value 'beta' for release_status/i, 147 | "Got error message for illegal release_status" 148 | ); 149 | } 150 | 151 | { 152 | my $dist = DistGen->new( name => 'Simple::Name', version => q{'0.01_01'} ); 153 | 154 | $dist->change_build_pl( 155 | module_name => 'Simple::Name', 156 | release_status => 'stable', 157 | )->regen; 158 | 159 | $dist->chdir_in; 160 | 161 | my $output = stdout_stderr_of sub { $dist->run_build_pl() }; 162 | like( $output, qr/Illegal value 'stable' with version '0.01_01'/i, 163 | "Got error message for illegal 'stable' with alpha version" 164 | ); 165 | } 166 | 167 | { 168 | my $dist = DistGen->new( name => 'Simple::Name', version => q{'0.01_01'} ); 169 | 170 | $dist->change_build_pl( 171 | module_name => 'Simple::Name', 172 | dist_version => '1.23beta1', 173 | )->regen; 174 | 175 | $dist->chdir_in; 176 | 177 | my $mb = $dist->new_from_context(); 178 | isa_ok( $mb, "Module::Build" ); 179 | is( $mb->dist_suffix, "", 180 | "non-standard dist_version does not get a suffix" 181 | ); 182 | is( $mb->release_status, "stable", 183 | "non-standard dist_version defaults to stable release_status" 184 | ); 185 | } 186 | 187 | # Test with alpha number 188 | # vim:ts=2:sw=2:et:sta:sts=2 189 | -------------------------------------------------------------------------------- /t/properties/requires.t: -------------------------------------------------------------------------------- 1 | # sample.t -- a sample test file for Module::Build 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | use DistGen; 7 | 8 | plan tests => 4; 9 | 10 | # Ensure any Module::Build modules are loaded from correct directory 11 | blib_load('Module::Build'); 12 | 13 | my ($dist, $mb, $prereqs); 14 | 15 | #--------------------------------------------------------------------------# 16 | # try undefined prereq version 17 | #--------------------------------------------------------------------------# 18 | 19 | $dist = DistGen->new( name => 'Simple::Requires' ); 20 | 21 | $dist->change_build_pl( 22 | module_name => 'Simple::Requires', 23 | requires => { 24 | 'File::Basename' => undef, 25 | }, 26 | )->regen; 27 | 28 | $dist->chdir_in; 29 | 30 | $mb = $dist->new_from_context(); 31 | isa_ok( $mb, "Module::Build" ); 32 | 33 | $prereqs = $mb->_normalize_prereqs; 34 | is($prereqs->{runtime}{requires}{'File::Basename'}, 0, "undef prereq converted to 0"); 35 | 36 | #--------------------------------------------------------------------------# 37 | # try empty string prereq version 38 | #--------------------------------------------------------------------------# 39 | 40 | $dist->change_build_pl( 41 | module_name => 'Simple::Requires', 42 | requires => { 43 | 'File::Basename' => '', 44 | }, 45 | )->regen; 46 | 47 | $mb = $dist->new_from_context(); 48 | isa_ok( $mb, "Module::Build" ); 49 | 50 | $prereqs = $mb->_normalize_prereqs; 51 | is($prereqs->{runtime}{requires}{'File::Basename'}, 0, "empty string prereq converted to 0"); 52 | 53 | 54 | # vim:ts=2:sw=2:et:sta:sts=2 55 | -------------------------------------------------------------------------------- /t/resume.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib 't/lib'; 3 | use MBTest; 4 | plan tests => 3; # or 'no_plan' 5 | use DistGen; 6 | 7 | # Ensure any Module::Build modules are loaded from correct directory 8 | blib_load('Module::Build'); 9 | 10 | # create dist object in a temp directory 11 | # enter the directory and generate the skeleton files 12 | my $dist = DistGen->new->chdir_in; 13 | $dist->add_file('mylib/MBUtil.pm', << "---"); 14 | package MBUtil; 15 | sub foo { 42 } 16 | 1; 17 | --- 18 | 19 | $dist->add_file('Build.PL', << "---"); 20 | use strict; 21 | use lib 'mylib'; 22 | use MBUtil; 23 | use Module::Build; 24 | 25 | die unless MBUtil::foo() == 42; 26 | 27 | my \$builder = Module::Build->new( 28 | module_name => '$dist->{name}', 29 | license => 'perl', 30 | ); 31 | 32 | \$builder->create_build_script(); 33 | --- 34 | 35 | $dist->regen; 36 | 37 | # get a Module::Build object and test with it 38 | my $mb = $dist->new_from_context(); # quiet by default 39 | isa_ok( $mb, "Module::Build" ); 40 | is( $mb->dist_name, "Simple", "dist_name is 'Simple'" ); 41 | ok( ( grep { /mylib/ } @INC ), "resume added \@INC addition to \@INC"); 42 | 43 | # vim:ts=2:sw=2:et:sta:sts=2 44 | -------------------------------------------------------------------------------- /t/runthrough.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 29; 6 | 7 | blib_load('Module::Build'); 8 | blib_load('Module::Build::ConfigData'); 9 | 10 | ######################### 11 | 12 | my $tmp = MBTest->tmpdir; 13 | 14 | use DistGen; 15 | my $dist = DistGen->new(); 16 | $dist->change_build_pl 17 | ({ 18 | module_name => 'Simple', 19 | scripts => [ 'script' ], 20 | license => 'perl', 21 | requires => { 'File::Spec' => 0 }, 22 | }); 23 | 24 | $dist->add_file( 'MANIFEST.SKIP', <<'---' ); 25 | ^MYMETA.yml$ 26 | --- 27 | $dist->add_file( 'script', <<'---' ); 28 | #!perl -w 29 | print "Hello, World!\n"; 30 | --- 31 | $dist->add_file( 'lib/Simple/Script.PL', <<'---' ); 32 | #!perl -w 33 | 34 | my $filename = shift; 35 | open FH, "> $filename" or die "Can't create $filename: $!"; 36 | print FH "Contents: $filename\n"; 37 | close FH; 38 | --- 39 | $dist->regen; 40 | 41 | $dist->chdir_in; 42 | 43 | 44 | ######################### 45 | 46 | my $mb = Module::Build->new_from_context; 47 | ok $mb; 48 | is $mb->license, 'perl'; 49 | 50 | # Make sure cleanup files added before create_build_script() get respected 51 | $mb->add_to_cleanup('before_script'); 52 | 53 | eval {$mb->create_build_script}; 54 | is $@, ''; 55 | ok -e $mb->build_script; 56 | 57 | my $dist_dir = 'Simple-0.01'; 58 | 59 | # VMS in traditional mode needs the $dist_dir name to not have a '.' in it 60 | # as this is a directory delimiter. In extended character set mode the dot 61 | # is permitted for Unix format file specifications. 62 | if ($^O eq 'VMS') { 63 | my $Is_VMS_noefs = 1; 64 | my $vms_efs = 0; 65 | if (eval 'require VMS::Feature') { 66 | $vms_efs = VMS::Feature::current("efs_charset"); 67 | } else { 68 | my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; 69 | $vms_efs = $efs_charset =~ /^[ET1]/i; 70 | } 71 | $Is_VMS_noefs = 0 if $vms_efs; 72 | if ($Is_VMS_noefs) { 73 | $dist_dir = 'Simple-0_01'; 74 | } 75 | } 76 | 77 | is $mb->dist_dir, $dist_dir; 78 | 79 | # The 'cleanup' file doesn't exist yet 80 | ok grep {$_ eq 'before_script'} $mb->cleanup; 81 | 82 | $mb->add_to_cleanup('save_out'); 83 | 84 | # The 'cleanup' file now exists 85 | ok grep {$_ eq 'before_script'} $mb->cleanup; 86 | ok grep {$_ eq 'save_out' } $mb->cleanup; 87 | 88 | { 89 | # Make sure verbose=>1 works 90 | my $all_ok = 1; 91 | my $output = eval { 92 | stdout_of( sub { $mb->dispatch('test', verbose => 1) } ) 93 | }; 94 | $all_ok &&= is($@, ''); 95 | $all_ok &&= like($output, qr/all tests successful/i); 96 | 97 | # This is the output of lib/Simple/Script.PL 98 | $all_ok &&= ok(-e $mb->localize_file_path('lib/Simple/Script')); 99 | 100 | unless ($all_ok) { 101 | # We use diag() so Test::Harness doesn't get confused. 102 | diag("vvvvvvvvvvvvvvvvvvvvv Simple/t/basic.t output vvvvvvvvvvvvvvvvvvvvv"); 103 | diag($output); 104 | diag("^^^^^^^^^^^^^^^^^^^^^ Simple/t/basic.t output ^^^^^^^^^^^^^^^^^^^^^"); 105 | } 106 | } 107 | 108 | { 109 | my $output = eval { 110 | stdout_stderr_of( sub { $mb->dispatch('disttest') } ) 111 | }; 112 | is $@, ''; 113 | 114 | # After a test, the distdir should contain a blib/ directory 115 | ok -e File::Spec->catdir('Simple-0.01', 'blib'); 116 | 117 | stdout_stderr_of ( sub { eval {$mb->dispatch('distdir')} } ); 118 | is $@, ''; 119 | 120 | # The 'distdir' should contain a lib/ directory 121 | ok -e File::Spec->catdir('Simple-0.01', 'lib'); 122 | 123 | # The freshly run 'distdir' should never contain a blib/ directory, or 124 | # else it could get into the tarball 125 | ok ! -e File::Spec->catdir('Simple-0.01', 'blib'); 126 | 127 | SKIP: { 128 | skip 'CPAN::Meta 2.142060+ not installed', 1 if not eval { require CPAN::Meta; CPAN::Meta->VERSION(2.142060) }; 129 | # Make sure all of the above was done by the new version of Module::Build 130 | open(my $fh, '<', File::Spec->catfile($dist->dirname, 'META.yml')); 131 | my $contents = do {local $/; <$fh>}; 132 | $contents =~ /Module::Build version ([0-9_.]+)/m; 133 | cmp_ok $1, '==', $mb->VERSION, "Check version used to create META.yml: $1 == " . $mb->VERSION; 134 | } 135 | 136 | SKIP: { 137 | skip( "Archive::Tar 1.08+ not installed", 1 ) 138 | unless eval { require Archive::Tar && Archive::Tar->VERSION(1.08); 1 }; 139 | $mb->add_to_cleanup($mb->dist_dir . ".tar.gz"); 140 | eval {$mb->dispatch('dist')}; 141 | is $@, ''; 142 | } 143 | 144 | } 145 | 146 | { 147 | # Make sure the 'script' file was recognized as a script. 148 | my $scripts = $mb->script_files; 149 | ok $scripts->{script}; 150 | 151 | # Check that a shebang line is rewritten 152 | my $blib_script = File::Spec->catfile( qw( blib script script ) ); 153 | ok -e $blib_script; 154 | 155 | SKIP: { 156 | skip("We do not rewrite shebang on VMS", 1) if $^O eq 'VMS'; 157 | open(my $fh, '<', $blib_script); 158 | my $first_line = <$fh>; 159 | isnt $first_line, "#!perl -w\n", "should rewrite the shebang line"; 160 | } 161 | } 162 | 163 | 164 | eval {$mb->dispatch('realclean')}; 165 | is $@, ''; 166 | 167 | ok ! -e $mb->build_script; 168 | ok ! -e $mb->config_dir; 169 | ok ! -e $mb->dist_dir; 170 | 171 | SKIP: { 172 | skip( 'Windows-only test', 4 ) unless $^O =~ /^MSWin/; 173 | 174 | my $script_data = <<'---'; 175 | @echo off 176 | echo Hello, World! 177 | --- 178 | 179 | $dist = DistGen->new(); 180 | $dist->change_build_pl({ 181 | module_name => 'Simple', 182 | scripts => [ 'bin/script.bat' ], 183 | license => 'perl', 184 | }); 185 | 186 | $dist->add_file( 'bin/script.bat', $script_data ); 187 | 188 | $dist->regen; 189 | $dist->chdir_in; 190 | 191 | $mb = Module::Build->new_from_context; 192 | ok $mb; 193 | 194 | eval{ $mb->dispatch('build') }; 195 | is $@, ''; 196 | 197 | my $script_file = File::Spec->catfile( qw(blib script), 'script.bat' ); 198 | ok -f $script_file, "Native batch file copied to 'scripts'"; 199 | 200 | my $out = slurp( $script_file ); 201 | is $out, $script_data, ' unmodified by pl2bat'; 202 | 203 | } 204 | 205 | -------------------------------------------------------------------------------- /t/sample.t: -------------------------------------------------------------------------------- 1 | # sample.t -- a sample test file for Module::Build 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 2; # or 'no_plan' 6 | use DistGen; 7 | 8 | # Ensure any Module::Build modules are loaded from correct directory 9 | blib_load('Module::Build'); 10 | 11 | # create dist object in a temp directory 12 | # enter the directory and generate the skeleton files 13 | my $dist = DistGen->new->chdir_in->regen; 14 | 15 | # get a Module::Build object and test with it 16 | my $mb = $dist->new_from_context(); # quiet by default 17 | isa_ok( $mb, "Module::Build" ); 18 | is( $mb->dist_name, "Simple", "dist_name is 'Simple'" ); 19 | 20 | # vim:ts=2:sw=2:et:sta:sts=2 21 | -------------------------------------------------------------------------------- /t/script_dist.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*- 3 | # vim:ts=8:sw=2:et:sta:sts=2 4 | 5 | use strict; 6 | use lib 't/lib'; 7 | use MBTest 'no_plan'; 8 | 9 | use DistGen qw(undent); 10 | use CPAN::Meta::YAML; 11 | 12 | blib_load('Module::Build'); 13 | blib_load('Module::Build::ConfigData'); 14 | 15 | # XXX DistGen shouldn't be assuming module-ness? 16 | my $dist = DistGen->new(dir => MBTest->tmpdir); 17 | $dist->add_file('bin/foo', undent(<<' ---')); 18 | #!/usr/bin/perl 19 | 20 | package bin::foo; 21 | $VERSION = 0.01; 22 | 23 | =head1 NAME 24 | 25 | foo - does stuff 26 | 27 | =head1 AUTHOR 28 | 29 | A. U. Thor, a.u.thor@a.galaxy.far.far.away 30 | 31 | =cut 32 | 33 | print "hello world\n"; 34 | --- 35 | 36 | my %details = ( 37 | dist_name => 'bin-foo', 38 | dist_version_from => 'bin/foo', 39 | dist_author => ['A. U. Thor, a.u.thor@a.galaxy.far.far.away'], 40 | dist_version => '0.01', 41 | ); 42 | my %meta_provides = ( 43 | 'foo' => { 44 | file => 'bin/foo', 45 | version => '0.01', 46 | } 47 | ); 48 | $dist->change_build_pl({ 49 | # TODO need to get all of this data out of the program itself 50 | ! $ENV{EXTRA_TEST} ? ( 51 | %details, meta_merge => { provides => \%meta_provides, }, 52 | ) : (), 53 | program_name => 'bin/foo', 54 | license => 'perl', 55 | }); 56 | 57 | # hmm... the old assumption of what a dist looks like is wrong here 58 | $dist->remove_file('lib/Simple.pm'); $dist->regen; 59 | 60 | $dist->chdir_in; 61 | rmdir('lib'); 62 | 63 | #system('konsole'); 64 | my $mb = Module::Build->new_from_context; 65 | ok($mb); 66 | is($mb->program_name, 'bin/foo'); 67 | is($mb->license, 'perl'); 68 | is($mb->dist_name, 'bin-foo'); 69 | is($mb->dist_version, '0.01'); 70 | is_deeply($mb->dist_author, 71 | ['A. U. Thor, a.u.thor@a.galaxy.far.far.away']); 72 | my $result; 73 | stdout_stderr_of( sub { $result = $mb->dispatch('distmeta') } ); 74 | ok $result; 75 | 76 | if (eval { require CPAN::Meta; CPAN::Meta->VERSION(2.142060); }) { 77 | my $yml = CPAN::Meta::YAML->read_string(slurp('META.yml'))->[0]; 78 | is_deeply($yml->{provides}, \%meta_provides); 79 | } 80 | 81 | $dist->chdir_original if $dist->did_chdir; 82 | -------------------------------------------------------------------------------- /t/signature.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | 7 | if ( have_module( 'Module::Signature' ) 8 | && $INC{'Module/Signature.pm'} =~ m{t/lib/Module/Signature\.pm} 9 | ) { 10 | plan tests => 12; 11 | } else { 12 | plan skip_all => "Mock Module::Signature not loadable"; 13 | } 14 | 15 | blib_load('Module::Build'); 16 | 17 | ######################### 18 | 19 | my $tmp = MBTest->tmpdir; 20 | 21 | use DistGen; 22 | my $dist = DistGen->new( dir => $tmp ); 23 | $dist->change_build_pl 24 | ({ 25 | module_name => $dist->name, 26 | license => 'perl', 27 | sign => 1, 28 | auto_configure_requires => 0, 29 | quiet => 1, 30 | }); 31 | $dist->regen; 32 | 33 | $dist->chdir_in; 34 | 35 | ######################### 36 | 37 | my $mb = Module::Build->new_from_context; 38 | 39 | { 40 | eval {$mb->dispatch('distdir')}; 41 | my $err = $@; 42 | is $err, ''; 43 | chdir( $mb->dist_dir ) or die "Can't chdir to '@{[$mb->dist_dir]}': $!"; 44 | ok -e 'SIGNATURE'; 45 | 46 | $dist->chdir_in; 47 | } 48 | 49 | { 50 | # Fake out Module::Signature and Module::Build - the first one to 51 | # run should be distmeta. 52 | my @run_order; 53 | { 54 | local $^W; # Skip 'redefined' warnings 55 | local *Module::Signature::sign; 56 | *Module::Signature::sign = sub { push @run_order, 'sign' }; 57 | local *Module::Build::Base::ACTION_distmeta; 58 | *Module::Build::Base::ACTION_distmeta = sub { push @run_order, 'distmeta' }; 59 | eval { $mb->dispatch('distdir') }; 60 | } 61 | is $@, ''; 62 | is $run_order[0], 'distmeta'; 63 | is $run_order[1], 'sign'; 64 | } 65 | 66 | eval { $mb->dispatch('realclean') }; 67 | is $@, ''; 68 | 69 | { 70 | eval {$mb->dispatch('distdir', sign => 0 )}; 71 | is $@, ''; 72 | chdir( $mb->dist_dir ) or die "Can't chdir to '@{[$mb->dist_dir]}': $!"; 73 | ok !-e 'SIGNATURE', './Build distdir --sign 0 does not sign'; 74 | } 75 | 76 | eval { $mb->dispatch('realclean') }; 77 | is $@, ''; 78 | 79 | $dist->chdir_in; 80 | 81 | { 82 | local @ARGV = '--sign=1'; 83 | $dist->change_build_pl({ 84 | module_name => $dist->name, 85 | license => 'perl', 86 | auto_configure_requires => 0, 87 | quiet => 1, 88 | }); 89 | $dist->regen; 90 | 91 | my $mb = Module::Build->new_from_context; 92 | is $mb->{properties}{sign}, 1; 93 | 94 | eval {$mb->dispatch('distdir')}; 95 | my $err = $@; 96 | is $err, ''; 97 | chdir( $mb->dist_dir ) or die "Can't chdir to '@{[$mb->dist_dir]}': $!"; 98 | ok -e 'SIGNATURE', 'Build.PL --sign=1 signs'; 99 | } 100 | 101 | -------------------------------------------------------------------------------- /t/test_file_exts.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 3; 6 | use DistGen; 7 | 8 | blib_load('Module::Build'); 9 | 10 | my $tmp = MBTest->tmpdir; 11 | my $dist = DistGen->new( dir => $tmp ); 12 | 13 | $dist->add_file('t/mytest.s', <<'---' ); 14 | #!perl 15 | use Test::More tests => 2; 16 | ok(1, 'first mytest.s'); 17 | ok(1, 'second mytest.s'); 18 | --- 19 | 20 | $dist->regen; 21 | $dist->chdir_in; 22 | 23 | ######################### 24 | 25 | # So make sure that the test gets run with the alternate extension. 26 | ok my $mb = Module::Build->new( 27 | module_name => $dist->name, 28 | test_file_exts => ['.s'], 29 | quiet => 1, 30 | ), 'Construct build object with test_file_exts parameter'; 31 | 32 | $mb->add_to_cleanup('save_out'); 33 | # Use uc() so we don't confuse the current test output 34 | my $out = uc(stdout_of( 35 | sub {$mb->dispatch('test', verbose => 1)} 36 | )); 37 | 38 | like $out, qr/^OK 1 - FIRST MYTEST[.]S/m, 'Should see first test output'; 39 | like $out, qr/^OK 2 - SECOND MYTEST[.]S/m, 'Should see second test output'; 40 | 41 | # vim:ts=4:sw=4:et:sta 42 | -------------------------------------------------------------------------------- /t/test_reqs.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | use CPAN::Meta 2.110420; 7 | use CPAN::Meta::YAML; 8 | use Parse::CPAN::Meta 1.4401; 9 | 10 | if (eval { require CPAN::Meta; CPAN::Meta->VERSION(2.142060) }) { 11 | plan(tests => 4); 12 | require CPAN::Meta::YAML; 13 | require Parse::CPAN::Meta; 14 | } 15 | else { 16 | plan(skip_all => 'No or old CPAN::Meta'); 17 | } 18 | 19 | 20 | blib_load('Module::Build'); 21 | 22 | my $tmp = MBTest->tmpdir; 23 | 24 | use DistGen; 25 | my $dist = DistGen->new( dir => $tmp ); 26 | $dist->change_file('Build.PL', <<"---"); 27 | use strict; 28 | use Module::Build; 29 | 30 | my \$builder = Module::Build->new( 31 | module_name => '$dist->{name}', 32 | license => 'perl', 33 | requires => { 34 | 'File::Spec' => 0, 35 | }, 36 | test_requires => { 37 | 'Test::More' => 0, 38 | } 39 | ); 40 | 41 | \$builder->create_build_script(); 42 | --- 43 | $dist->regen; 44 | $dist->chdir_in; 45 | $dist->run_build_pl; 46 | my $output = stdout_stderr_of sub { $dist->run_build('distmeta') }; 47 | 48 | for my $file ( qw/MYMETA META/ ) { 49 | my $meta = Parse::CPAN::Meta->load_file($file.".json"); 50 | is_deeply($meta->{prereqs}->{runtime},{ 51 | requires => { 52 | 'File::Spec' => '0', 53 | } 54 | }, "runtime prereqs in $file"); 55 | is_deeply($meta->{prereqs}->{test},{ 56 | requires => { 57 | 'Test::More' => '0', 58 | } 59 | }, "test prereqs in $file"); 60 | } 61 | 62 | -------------------------------------------------------------------------------- /t/test_type.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | BEGIN { 4 | if ($^O eq 'VMS') { 5 | print '1..0 # Child test output confuses harness'; 6 | exit; 7 | } 8 | } 9 | 10 | use strict; 11 | use lib 't/lib'; 12 | use MBTest tests => 7; 13 | 14 | blib_load('Module::Build'); 15 | 16 | my $tmp = MBTest->tmpdir; 17 | 18 | use DistGen; 19 | 20 | my $dist = DistGen->new( dir => $tmp ); 21 | 22 | 23 | $dist->add_file('t/special_ext.st', <<'---' ); 24 | #!perl 25 | use Test::More tests => 2; 26 | ok(1, 'first test in special_ext'); 27 | ok(1, 'second test in special_ext'); 28 | --- 29 | 30 | $dist->regen; 31 | 32 | $dist->chdir_in; 33 | 34 | ######################### 35 | 36 | # Here we make sure we can define an action that will test a particular type 37 | $::x = 0; 38 | my $mb = Module::Build->subclass( 39 | code => q# 40 | sub ACTION_testspecial { 41 | $::x++; 42 | shift->generic_test(type => 'special'); 43 | } 44 | # 45 | )->new( 46 | module_name => $dist->name, 47 | test_types => { special => '.st' } 48 | ); 49 | 50 | ok $mb; 51 | 52 | $mb->dispatch('testspecial'); 53 | is($::x, 1, "called once"); 54 | 55 | 56 | $mb->add_to_cleanup('save_out'); 57 | # Use uc() so we don't confuse the current test output 58 | my $verbose_output = uc(stdout_of( 59 | sub {$mb->dispatch('testspecial', verbose => 1)} 60 | )); 61 | 62 | like($verbose_output, qr/^OK 1 - FIRST TEST IN SPECIAL_EXT/m); 63 | like($verbose_output, qr/^OK 2 - SECOND TEST IN SPECIAL_EXT/m); 64 | 65 | is( $::x, 2, "called again"); 66 | 67 | my $output = uc(stdout_of( 68 | sub {$mb->dispatch('testspecial', verbose => 0)} 69 | )); 70 | like($output, qr/\.\. ?OK/); 71 | 72 | is($::x, 3, "called a third time"); 73 | 74 | # vim:ts=4:sw=4:et:sta 75 | -------------------------------------------------------------------------------- /t/test_types.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 25; 6 | 7 | blib_load('Module::Build'); 8 | 9 | use DistGen; 10 | 11 | my $dist = DistGen->new()->chdir_in; 12 | 13 | $dist->add_file('t/special_ext.st', <<'---'); 14 | #!perl 15 | use Test::More tests => 2; 16 | ok(1, 'first test in special_ext'); 17 | ok(1, 'second test in special_ext'); 18 | --- 19 | 20 | $dist->add_file('t/another_ext.at', <<'---'); 21 | #!perl 22 | use Test::More tests => 2; 23 | ok(1, 'first test in another_ext'); 24 | ok(1, 'second test in another_ext'); 25 | --- 26 | $dist->add_file('t/foo.txt', <<'---'); 27 | #!perl 28 | use Test::More tests => 1; 29 | ok 0, "don't run this non-test file"; 30 | die "don't run this non-test file"; 31 | --- 32 | 33 | $dist->regen; 34 | ######################### 35 | 36 | my $mb = Module::Build->subclass( 37 | code => q# 38 | sub ACTION_testspecial { 39 | shift->generic_test(type => 'special'); 40 | } 41 | 42 | sub ACTION_testanother { 43 | shift->generic_test(type => 'another'); 44 | } 45 | # 46 | )->new( 47 | module_name => $dist->name, 48 | test_types => { 49 | special => '.st', 50 | another => '.at', 51 | }, 52 | ); 53 | 54 | 55 | ok $mb; 56 | 57 | my $special_output = uc(stdout_of( 58 | sub {$mb->dispatch('testspecial', verbose => 1)} 59 | )); 60 | 61 | like($special_output, qr/^OK 1 - FIRST TEST IN SPECIAL_EXT/m, 62 | 'saw expected output from first test'); 63 | like($special_output, qr/^OK 2 - SECOND TEST IN SPECIAL_EXT/m, 64 | 'saw expected output from second test'); 65 | 66 | my $another_output = uc(stdout_of( 67 | sub {$mb->dispatch('testanother', verbose => 1)} 68 | )); 69 | 70 | ok($another_output, 'we have some test output'); 71 | 72 | like($another_output, qr/^OK 1 - FIRST TEST IN ANOTHER_EXT/m, 73 | 'saw expected output from first test'); 74 | like($another_output, qr/^OK 2 - SECOND TEST IN ANOTHER_EXT/m, 75 | 'saw expected output from second test'); 76 | 77 | 78 | my $all_output = uc(stdout_of( 79 | sub {$mb->dispatch('testall', verbose => 1)} 80 | )); 81 | 82 | 0 and warn "\ntestall said >>>\n$all_output\n<<<\n"; 83 | 84 | like($all_output, qr/^OK 1 - FIRST TEST IN SPECIAL_EXT/m, 85 | 'expected output from basic.t'); 86 | like($all_output, qr/^OK 2 - SECOND TEST IN SPECIAL_EXT/m, 87 | 'expected output from basic.t'); 88 | 89 | like($all_output, qr/^OK 1 - FIRST TEST IN ANOTHER_EXT/m); 90 | like($all_output, qr/^OK 2 - SECOND TEST IN ANOTHER_EXT/m); 91 | 92 | # we get a third one from basic.t 93 | is(scalar(@{[$all_output =~ m/OK 1/mg]}), 3 ); 94 | is(scalar(@{[$all_output =~ m/OK/mg]}), 8 ); 95 | is(scalar(@{[$all_output =~ m/ALL TESTS SUCCESSFUL\./mg]}), 1); 96 | 97 | { # once-again 98 | 99 | $dist->revert; 100 | 101 | $dist->add_file('t/foo/special.st', <<'---'); 102 | #!perl 103 | use Test::More tests => 2; 104 | ok(1, 'first test in special_ext'); 105 | ok(1, 'second test in special_ext'); 106 | --- 107 | $dist->add_file('t/foo/basic_foo.t', <<'---'); 108 | use Test::More tests => 1; 109 | use strict; use Simple; 110 | ok 1; 111 | --- 112 | $dist->regen; 113 | 114 | my $mb = Module::Build->subclass( 115 | code => q# 116 | sub ACTION_testspecial { 117 | shift->generic_test(type => 'special'); 118 | } 119 | 120 | sub ACTION_testanother { 121 | shift->generic_test(type => 'another'); 122 | } 123 | # 124 | )->new( 125 | recursive_test_files => 1, 126 | module_name => $dist->name, 127 | test_types => { 128 | special => '.st', 129 | another => '.at', 130 | }, 131 | ); 132 | 133 | ok $mb; 134 | 135 | my $special_output = uc(stdout_of( 136 | sub {$mb->dispatch('testspecial', verbose => 1)} 137 | )); 138 | 139 | like($special_output, qr/^OK 1 - FIRST TEST IN SPECIAL_EXT/m, 140 | 'saw expected output from first test'); 141 | like($special_output, qr/^OK 2 - SECOND TEST IN SPECIAL_EXT/m, 142 | 'saw expected output from second test'); 143 | 144 | my $another_output = uc(stdout_of( 145 | sub {$mb->dispatch('testanother', verbose => 1)} 146 | )); 147 | 148 | ok($another_output, 'we have some test output'); 149 | 150 | like($another_output, qr/^OK 1 - FIRST TEST IN ANOTHER_EXT/m, 151 | 'saw expected output from first test'); 152 | like($another_output, qr/^OK 2 - SECOND TEST IN ANOTHER_EXT/m, 153 | 'saw expected output from second test'); 154 | 155 | 156 | my $all_output = uc(stdout_of( 157 | sub {$mb->dispatch('testall', verbose => 1)} 158 | )); 159 | 160 | like($all_output, qr/^OK 1 - FIRST TEST IN SPECIAL_EXT/m, 161 | 'expected output from basic.t'); 162 | like($all_output, qr/^OK 2 - SECOND TEST IN SPECIAL_EXT/m, 163 | 'expected output from basic.t'); 164 | 165 | like($all_output, qr/^OK 1 - FIRST TEST IN ANOTHER_EXT/m); 166 | like($all_output, qr/^OK 2 - SECOND TEST IN ANOTHER_EXT/m); 167 | 168 | # we get a third one from basic.t 169 | is(scalar(@{[$all_output =~ m/(OK 1)/mg]}), 5 ); 170 | is(scalar(@{[$all_output =~ m/(OK)/mg]}), 13 ); 171 | 172 | } # end once-again 173 | 174 | # vim:ts=4:sw=4:et:sta 175 | -------------------------------------------------------------------------------- /t/tilde.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | # Test ~ expansion from command line arguments. 4 | 5 | use strict; 6 | use lib 't/lib'; 7 | use MBTest tests => 16; 8 | 9 | blib_load('Module::Build'); 10 | 11 | my $tmp = MBTest->tmpdir; 12 | 13 | use DistGen; 14 | my $dist = DistGen->new( dir => $tmp ); 15 | $dist->regen; 16 | 17 | $dist->chdir_in; 18 | 19 | 20 | sub run_sample { 21 | my @args = @_; 22 | 23 | local $Test::Builder::Level = $Test::Builder::Level + 1; 24 | 25 | $dist->clean; 26 | 27 | my $mb; 28 | stdout_of( sub { 29 | $mb = Module::Build->new_from_context( @args ); 30 | } ); 31 | 32 | return $mb; 33 | } 34 | 35 | 36 | my $p = 'install_base'; 37 | 38 | SKIP: { 39 | my $home = $ENV{HOME} ? $ENV{HOME} : undef; 40 | 41 | if ($^O eq 'VMS') { 42 | # Convert the path to UNIX format, trim off the trailing slash 43 | $home = VMS::Filespec::unixify($home); 44 | $home =~ s#/$##; 45 | } 46 | 47 | unless (defined $home) { 48 | my @info = eval { getpwuid $> }; 49 | skip "No home directory for tilde-expansion tests", 15 if $@ 50 | or !defined $info[7]; 51 | $home = $info[7]; 52 | } 53 | 54 | is( run_sample( $p => '~' )->$p(), $home ); 55 | 56 | is( run_sample( $p => '~/fooxzy' )->$p(), "$home/fooxzy" ); 57 | 58 | is( run_sample( $p => '~/ fooxzy')->$p(), "$home/ fooxzy" ); 59 | 60 | is( run_sample( $p => '~/fo o')->$p(), "$home/fo o" ); 61 | 62 | is( run_sample( $p => 'fooxzy~' )->$p(), 'fooxzy~' ); 63 | 64 | is( run_sample( prefix => '~' )->prefix, 65 | $home ); 66 | 67 | # Test when HOME is different from getpwuid(), as in sudo. 68 | { 69 | local $ENV{HOME} = '/wibble/whomp'; 70 | 71 | is( run_sample( $p => '~' )->$p(), "/wibble/whomp" ); 72 | } 73 | 74 | my $mb = run_sample( install_path => { html => '~/html', 75 | lib => '~/lib' } 76 | ); 77 | is( $mb->install_destination('lib'), "$home/lib" ); 78 | # 'html' is translated to 'binhtml' & 'libhtml' 79 | is( $mb->install_destination('binhtml'), "$home/html" ); 80 | is( $mb->install_destination('libhtml'), "$home/html" ); 81 | 82 | $mb = run_sample( install_path => { lib => '~/lib' } ); 83 | is( $mb->install_destination('lib'), "$home/lib" ); 84 | 85 | $mb = run_sample( destdir => '~' ); 86 | is( $mb->destdir, $home ); 87 | 88 | $mb->$p('~'); 89 | is( $mb->$p(), '~', 'API does not expand tildes' ); 90 | 91 | skip "On OS/2 EMX all users are equal", 2 if $^O eq 'os2'; 92 | is( run_sample( $p => '~~' )->$p(), '~~' ); 93 | is( run_sample( $p => '~ fooxzy' )->$p(), '~ fooxzy' ); 94 | } 95 | 96 | # Again, with named users 97 | SKIP: { 98 | my @info = eval { getpwuid $> }; 99 | skip "No home directory for tilde-expansion tests", 1 if $@ 100 | or !defined $info[7] or !defined $info[0]; 101 | my ($me, $home) = @info[0,7]; 102 | 103 | if ($^O eq 'VMS') { 104 | # Convert the path to UNIX format and trim off the trailing slash. 105 | # Also, the fake module we're in has mangled $ENV{HOME} for its own 106 | # purposes; getpwuid doesn't know about that but _detildefy does. 107 | $home = VMS::Filespec::unixify($ENV{HOME}); 108 | $home =~ s#/$##; 109 | } 110 | my $expected = "$home/fooxzy"; 111 | 112 | like( run_sample( $p => "~$me/fooxzy")->$p(), qr(\Q$expected\E)i ); 113 | } 114 | 115 | -------------------------------------------------------------------------------- /t/unit_run_test_harness.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 9; 6 | 7 | blib_load('Module::Build'); 8 | 9 | my $tmp = MBTest->tmpdir; 10 | 11 | use DistGen; 12 | my $dist = DistGen->new( dir => $tmp ); 13 | $dist->regen; 14 | 15 | $dist->chdir_in; 16 | 17 | ######################### 18 | 19 | 20 | # make sure Test::Harness loaded before we define Test::Harness::runtests otherwise we'll 21 | # get another redefined warning inside Test::Harness::runtests 22 | use Test::Harness; 23 | 24 | { 25 | package MB::Subclass; 26 | use base qw(Module::Build); 27 | sub harness_switches { return } 28 | } 29 | 30 | { 31 | local $SIG{__WARN__} = sub { die "Termination after a warning: $_[0]"}; 32 | my $mock1 = { A => 1 }; 33 | my $mock2 = { B => 2 }; 34 | 35 | no warnings qw[redefine once]; 36 | 37 | # This runs run_test_harness with Test::Harness::switches = undef and harness_switches() returning empty list, 38 | # ensure there are no warnings, and output is empty too 39 | { 40 | my $mb = MB::Subclass->new( module_name => $dist->name ); 41 | local *Test::Harness::runtests = sub { 42 | is shift(), $mock1, "runtests ran with expected parameters"; 43 | is shift(), $mock2, "runtests ran with expected parameters"; 44 | is $Test::Harness::switches, '', "switches are undef"; 45 | is $Test::Harness::Switches, '', "switches are undef"; 46 | }; 47 | 48 | # $Test::Harness::switches and $Test::Harness::switches are aliases, but we pretend we don't know this 49 | local $Test::Harness::switches = ''; 50 | local $Test::Harness::switches = ''; 51 | $mb->run_test_harness([$mock1, $mock2]); 52 | 53 | ok 1, "run_test_harness should not produce warning if Test::Harness::[Ss]witches are undef and harness_switches() return empty list"; 54 | } 55 | 56 | # This runs run_test_harness with Test::Harness::switches = '' and harness_switches() returning empty list, 57 | # ensure there are no warnings, and switches are empty string 58 | { 59 | my $mb = MB::Subclass->new( module_name => $dist->name ); 60 | local *Test::Harness::runtests = sub { 61 | is shift(), $mock1, "runtests ran with expected parameters"; 62 | is shift(), $mock2, "runtests ran with expected parameters"; 63 | is $Test::Harness::switches, '', "switches are empty string"; 64 | is $Test::Harness::Switches, '', "switches are empty string"; 65 | }; 66 | 67 | # $Test::Harness::switches and $Test::Harness::switches are aliases, but we pretend we don't know this 68 | local $Test::Harness::switches = ''; 69 | local $Test::Harness::switches = ''; 70 | $mb->run_test_harness([$mock1, $mock2]); 71 | } 72 | 73 | } 74 | -------------------------------------------------------------------------------- /t/use_tap_harness.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use Test::More; 5 | use lib 't/lib'; 6 | if (eval { require TAP::Harness && TAP::Harness->VERSION(3) }) { 7 | plan tests => 9; 8 | } else { 9 | plan skip_all => 'TAP::Harness 3+ not installed' 10 | } 11 | 12 | use MBTest; 13 | use DistGen; 14 | 15 | blib_load('Module::Build'); 16 | my $tmp = MBTest->tmpdir; 17 | my $dist = DistGen->new( dir => $tmp ); 18 | $dist->regen; 19 | $dist->chdir_in; 20 | 21 | ######################### 22 | 23 | # Make sure that TAP::Harness properly does its thing. 24 | $dist->change_build_pl( 25 | module_name => $dist->name, 26 | use_tap_harness => 1, 27 | quiet => 1, 28 | ); 29 | $dist->regen; 30 | 31 | ok my $mb = $dist->new_from_context, 32 | 'Construct build object with test_file_exts parameter'; 33 | 34 | $mb->add_to_cleanup('save_out'); 35 | # Use uc() so we don't confuse the current test output 36 | my $out = uc(stdout_of( 37 | sub {$mb->dispatch('test', verbose => 1)} 38 | )); 39 | 40 | like $out, qr/^OK 1/m, 'Should see first test output'; 41 | like $out, qr/^ALL TESTS SUCCESSFUL/m, 'Should see test success message'; 42 | 43 | ######################### 44 | 45 | # Make sure that arguments are passed through to TAP::Harness. 46 | $dist->change_build_pl( 47 | module_name => $dist->name, 48 | use_tap_harness => 1, 49 | tap_harness_args => { verbosity => 0 }, 50 | quiet => 1, 51 | ); 52 | $dist->regen; 53 | 54 | ok $mb = $dist->new_from_context, 55 | 'Construct build object with test_file_exts parameter'; 56 | 57 | $mb->add_to_cleanup('save_out'); 58 | # Use uc() so we don't confuse the current test output 59 | $out = uc(stdout_of( 60 | sub {$mb->dispatch('test', verbose => 1)} 61 | )); 62 | 63 | unlike $out, qr/^OK 1/m, 'Should not see first test output'; 64 | like $out, qr/^ALL TESTS SUCCESSFUL/m, 'Should see test success message'; 65 | 66 | #--------------------------------------------------------------------------# 67 | # test that a failing test dies 68 | #--------------------------------------------------------------------------# 69 | 70 | $dist->change_build_pl( 71 | module_name => $dist->name, 72 | use_tap_harness => 1, 73 | tap_harness_args => { verbosity => 1 }, 74 | quiet => 1, 75 | ); 76 | $dist->change_file('t/basic.t',<<"---"); 77 | use Test::More tests => 1; 78 | use strict; 79 | 80 | use $dist->{name}; 81 | ok 0; 82 | --- 83 | $dist->regen; 84 | 85 | ok $mb = $dist->new_from_context, 86 | 'Construct build object after setting tests to fail'; 87 | # Use uc() so we don't confuse the current test output 88 | $out = stdout_stderr_of( sub { $dist->run_build('test')} ); 89 | ok( $?, "'Build test' had non-zero exit code" ); 90 | like( $out, qr{Errors in testing\. Cannot continue\.}, 91 | "Saw emulated Test::Harness die() message" 92 | ); 93 | 94 | # vim:ts=4:sw=4:et:sta 95 | -------------------------------------------------------------------------------- /t/versions.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest tests => 2; 6 | 7 | blib_load('Module::Build'); 8 | 9 | my $tmp = MBTest->tmpdir; 10 | 11 | use DistGen; 12 | my $dist = DistGen->new( dir => $tmp ); 13 | $dist->regen; 14 | 15 | ######################### 16 | 17 | my @mod = split( /::/, $dist->name ); 18 | my $file = File::Spec->catfile( $dist->dirname, 'lib', @mod ) . '.pm'; 19 | is( Module::Build->version_from_file( $file ), '0.01', 'version_from_file' ); 20 | 21 | ok( Module::Build->compare_versions( '1.01_01', '>', '1.01' ), 'compare: 1.0_01 > 1.0' ); 22 | -------------------------------------------------------------------------------- /t/write_default_maniskip.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | use MBTest 'no_plan'; 8 | use DistGen; 9 | use Cwd; 10 | 11 | blib_load('Module::Build'); 12 | 13 | { 14 | my $cwd = Cwd::cwd; 15 | chdir MBTest->tmpdir(); 16 | 17 | my $build = Module::Build->new( 18 | module_name => "Foo::Bar", 19 | dist_name => "Foo-Bar", 20 | dist_version => '1.23', 21 | ); 22 | 23 | my $skip = "mskip.txt"; # for compatibility 24 | $build->_write_default_maniskip($skip); 25 | 26 | ok -r $skip, "Default maniskip written"; 27 | my $have = slurp($skip); 28 | 29 | my $head; 30 | if( $build->_eumanifest_has_include ) { 31 | $head = "#!include_default\n"; 32 | } 33 | else { 34 | $head = slurp($build->_default_maniskip); 35 | } 36 | 37 | like $have, qr/^\Q$head\E/, "default MANIFEST.SKIP used"; 38 | like $have, qr/^# Avoid Module::Build generated /ms, "Module::Build specific entries"; 39 | like $have, qr/Foo-Bar-/, "distribution tarball entry"; 40 | 41 | DistGen::chdir_all($cwd); 42 | } 43 | -------------------------------------------------------------------------------- /t/xs.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use lib 't/lib'; 5 | use MBTest; 6 | use Config; 7 | 8 | my $tmp; 9 | 10 | blib_load('Module::Build'); 11 | 12 | { 13 | my ($have_c_compiler, $tmp_exec) = check_compiler(); 14 | 15 | if ( !$have_c_compiler ) { 16 | plan skip_all => 'No compiler found'; 17 | } elsif ( !$tmp_exec ) { 18 | plan skip_all => 'Compiler is dysfunctional'; 19 | } elsif ( $^O eq 'VMS' ) { 20 | plan skip_all => 'Child test output confuses harness'; 21 | } elsif ( !$Config{usedl} ) { 22 | plan skip_all => 'Perl not compiled for dynamic loading' 23 | } else { 24 | plan tests => 22; 25 | } 26 | require Cwd; 27 | $tmp = MBTest->tmpdir( $tmp_exec ? () : (DIR => Cwd::cwd) ); 28 | } 29 | 30 | 31 | 32 | ######################### 33 | 34 | use DistGen; 35 | my $dist = DistGen->new( dir => $tmp, xs => 1 )->chdir_in->regen; 36 | 37 | my $mb = $dist->new_from_context; 38 | 39 | eval {$mb->dispatch('clean')}; 40 | is $@, ''; 41 | 42 | eval {$mb->dispatch('build')}; 43 | is $@, ''; 44 | 45 | { 46 | # Make sure it actually works: that we can call methods in the XS module 47 | 48 | # Unfortunately, We must do this is a subprocess because some OS will not 49 | # release the handle on a dynamic lib until the attaching process terminates 50 | 51 | ok $mb->run_perl_command(['-Mblib', '-M'.$dist->name, '-e1']); 52 | 53 | like stdout_of( sub {$mb->run_perl_command([ 54 | '-Mblib', '-M'.$dist->name, 55 | '-we', "print @{[$dist->name]}::okay()"])}), qr/ok$/; 56 | 57 | like stdout_of( sub {$mb->run_perl_command([ 58 | '-Mblib', '-M'.$dist->name, 59 | '-we', "print @{[$dist->name]}::version()"])}), qr/0.01$/; 60 | 61 | like stdout_of( sub {$mb->run_perl_command([ 62 | '-Mblib', '-M'.$dist->name, 63 | '-we', "print @{[$dist->name]}::xs_version()"])}), qr/0.01$/; 64 | 65 | } 66 | 67 | { 68 | # Try again in a subprocess 69 | eval {$mb->dispatch('clean')}; 70 | is $@, ''; 71 | 72 | 73 | $mb->create_build_script; 74 | my $script = $mb->build_script; 75 | ok -e $script; 76 | 77 | eval {$mb->run_perl_script($script)}; 78 | is $@, ''; 79 | } 80 | 81 | # We can't be verbose in the sub-test, because Test::Harness will 82 | # think that the output is for the top-level test. 83 | stdout_stderr_of( sub { eval {$mb->dispatch('test')} }); 84 | is $@, ''; 85 | 86 | eval {$mb->dispatch('clean')}; 87 | is $@, ''; 88 | 89 | 90 | SKIP: { 91 | skip( "skipping a Unixish-only tests", 1 ) 92 | unless $mb->is_unixish; 93 | 94 | $mb->{config}->push(ld => "FOO=BAR ".$mb->config('ld')); 95 | eval {$mb->dispatch('build')}; 96 | is $@, ''; 97 | $mb->{config}->pop('ld'); 98 | } 99 | 100 | eval {$mb->dispatch('realclean')}; 101 | is $@, ''; 102 | 103 | # Make sure blib/ is gone after 'realclean' 104 | ok ! -e 'blib'; 105 | 106 | ######################################## 107 | 108 | # Try a XS distro with a deep namespace 109 | 110 | 111 | $dist->reset( name => 'Simple::With::Deep::Name', dir => $tmp, xs => 1 ); 112 | $dist->chdir_in->regen; 113 | 114 | $mb = $dist->new_from_context; 115 | 116 | eval { $mb->dispatch('build') }; 117 | is $@, ''; 118 | 119 | stdout_stderr_of( sub { eval { $mb->dispatch('test') } } ); 120 | is $@, ''; 121 | 122 | eval { $mb->dispatch('clean') }; 123 | 124 | eval { $mb->dispatch('build', 'pureperl_only' => 1) }; 125 | like $@, qr/\ACan\'t build xs files under --pureperl-only/, 'Can\'t build xs under pureperl'; 126 | 127 | eval { $mb->dispatch('build', pureperl_only => 1, allow_pureperl => 1) }; 128 | is $@, '', 'Can\'t build xs under pureperl, unless allow_pureperl'; 129 | 130 | eval { $mb->dispatch('realclean') }; 131 | is $@, ''; 132 | 133 | ######################################## 134 | 135 | # Try a XS distro using a flat directory structure 136 | # and a 'dist_name' instead of a 'module_name' 137 | 138 | $dist->reset( name => 'Dist-Name', dir => $tmp, xs => 1 )->chdir_in; 139 | 140 | $dist->remove_file('lib/Dist-Name.pm'); 141 | $dist->remove_file('lib/Dist-Name.xs'); 142 | 143 | $dist->change_build_pl 144 | ({ 145 | dist_name => 'Dist-Name', 146 | dist_version_from => 'Simple.pm', 147 | pm_files => { 'Simple.pm' => 'lib/Simple.pm' }, 148 | xs_files => { 'Simple.xs' => 'lib/Simple.xs' }, 149 | }); 150 | 151 | $dist->add_file('Simple.xs', <<"---"); 152 | #include "EXTERN.h" 153 | #include "perl.h" 154 | #include "XSUB.h" 155 | 156 | MODULE = Simple PACKAGE = Simple 157 | 158 | SV * 159 | okay() 160 | CODE: 161 | RETVAL = newSVpv( "ok", 0 ); 162 | OUTPUT: 163 | RETVAL 164 | --- 165 | 166 | $dist->add_file( 'Simple.pm', <<"---" ); 167 | package Simple; 168 | 169 | use strict; 170 | use warnings; 171 | 172 | our \$VERSION = '0.01'; 173 | 174 | require Exporter; 175 | require DynaLoader; 176 | 177 | our \@ISA = qw( Exporter DynaLoader ); 178 | our \@EXPORT_OK = qw( okay ); 179 | 180 | bootstrap Simple \$VERSION; 181 | 182 | 1; 183 | 184 | __END__ 185 | 186 | =head1 NAME 187 | 188 | Simple - Perl extension for blah blah blah 189 | 190 | =head1 DESCRIPTION 191 | 192 | Stub documentation for Simple. 193 | 194 | =head1 AUTHOR 195 | 196 | A. U. Thor, a.u.thor\@a.galaxy.far.far.away 197 | 198 | =cut 199 | --- 200 | $dist->change_file('t/basic.t', <<"---"); 201 | use Test::More tests => 2; 202 | use strict; 203 | 204 | use Simple; 205 | ok( 1 ); 206 | 207 | ok( Simple::okay() eq 'ok' ); 208 | --- 209 | 210 | $dist->regen; 211 | 212 | $mb = $dist->new_from_context; 213 | 214 | eval { $mb->dispatch('build') }; 215 | is $@, ''; 216 | 217 | stdout_of( sub { eval { $mb->dispatch('test') } } ); 218 | is $@, ''; 219 | 220 | eval { $mb->dispatch('realclean') }; 221 | is $@, ''; 222 | 223 | --------------------------------------------------------------------------------