module-build-checkins Mailing List for Module::Build
Status: Beta
Brought to you by:
kwilliams
You can subscribe to this list here.
2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(82) |
Dec
(58) |
---|---|---|---|---|---|---|---|---|---|---|---|---|
2005 |
Jan
(49) |
Feb
(57) |
Mar
(49) |
Apr
(49) |
May
(2) |
Jun
(147) |
Jul
(60) |
Aug
(55) |
Sep
(51) |
Oct
(68) |
Nov
(61) |
Dec
(44) |
2006 |
Jan
(27) |
Feb
(38) |
Mar
(89) |
Apr
(31) |
May
(17) |
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
From: <kwi...@cv...> - 2006-05-21 05:28:25
|
Author: kwilliams Date: Sat May 20 22:27:59 2006 New Revision: 6328 Added: Module-Build/tags/release-0_2801/ - copied from r6327, /Module-Build/trunk/ Log: I think this is right? |
From: <kwi...@cv...> - 2006-05-21 05:27:45
|
Author: kwilliams Date: Sat May 20 22:27:15 2006 New Revision: 6327 Removed: Module-Build/tags/release-0_2801/ Log: Whoops, extra dir in there |
From: <kwi...@cv...> - 2006-05-21 05:21:57
|
Author: kwilliams Date: Sat May 20 22:21:34 2006 New Revision: 6326 Added: Module-Build/tags/release-0_2801/trunk/ - copied from r6325, /Module-Build/trunk/ Log: New maintenance release to CPAN |
From: <kwi...@cv...> - 2006-05-21 05:20:06
|
Author: kwilliams Date: Sat May 20 22:19:34 2006 New Revision: 6325 Added: Module-Build/tags/release-0_2801/ Log: Tag for new release |
From: <kwi...@cv...> - 2006-05-21 05:09:11
|
Author: kwilliams Date: Sat May 20 22:08:20 2006 New Revision: 6324 Modified: Module-Build/trunk/Changes Module-Build/trunk/lib/Module/Build.pm Log: Version bump Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Sat May 20 22:08:20 2006 @@ -1,6 +1,6 @@ Revision history for Perl extension Module::Build. -0.2801 +0.2801 Sun May 21 00:07:40 CDT 2006 - Module::Build::Compat's emulation of INC is incorrectly prepending a -I to the value of INC. This is incorrect because there should Modified: Module-Build/trunk/lib/Module/Build.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build.pm (original) +++ Module-Build/trunk/lib/Module/Build.pm Sat May 20 22:08:20 2006 @@ -15,7 +15,7 @@ use vars qw($VERSION @ISA); @ISA = qw(Module::Build::Base); -$VERSION = '0.28'; +$VERSION = '0.2801'; $VERSION = eval $VERSION; # Okay, this is the brute-force method of finding out what kind of |
From: <kwi...@cv...> - 2006-05-21 05:07:53
|
Author: kwilliams Date: Sat May 20 22:07:08 2006 New Revision: 6323 Modified: Module-Build/trunk/Changes Log: Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Sat May 20 22:07:08 2006 @@ -6,7 +6,7 @@ a -I to the value of INC. This is incorrect because there should already be a -I on the value. I.E. it's "perl Makefile.PL INC=-Ifoo" not "perl Makefile.PL INC=foo" so Compat should not prefix a -I. - [Patch by Michael Schwern] + [Michael Schwern] - Native batch scripts under Windows should not be converted by pl2bat. [Spotted by Ron Savage] @@ -32,6 +32,8 @@ newlines in the data, now it has a much more extensive escaping mechanism. [Stephen Adkins] + - Revised the docs for --prefix and PREFIX. [Michael Schwern] + 0.28 Thu Apr 27 22:25:00 CDT 2006 - When y_n() or prompt() are called without a default value and the |
From: <kwi...@cv...> - 2006-05-19 02:07:01
|
Author: kwilliams Date: Thu May 18 19:06:04 2006 New Revision: 6314 Modified: Module-Build/trunk/ (props changed) Module-Build/trunk/lib/Module/Build.pm Module-Build/trunk/lib/Module/Build/Cookbook.pm Log: r1907@Scotchie: ken | 2006-05-18 20:58:46 -0500 Apply a patch from Schwern that looks like it improves the documentation and cookbook for --prefix. Modified: Module-Build/trunk/lib/Module/Build.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build.pm (original) +++ Module-Build/trunk/lib/Module/Build.pm Thu May 18 19:06:04 2006 @@ -851,113 +851,29 @@ C<File::Spec> to make the pathnames work correctly on whatever platform you're installing on. -=back - - -=head2 About PREFIX Support - -[version 0.28] - -First, it is necessary to understand the original idea behind -C<PREFIX>. If, for example, the default installation locations for -your machine are F</usr/local/lib/perl5/5.8.5> for modules, -F</usr/local/bin> for executables, F</usr/local/man/man1> and -F</usr/local/man/man3> for manual pages, etc., then they all share the -same "prefix" F</usr/local>. MakeMaker's C<PREFIX> mechanism was -intended as a way to change an existing prefix that happened to occur -in all those paths - essentially a C<< s{/usr/local}{/foo/bar} >> for -each path. - -However, the real world is more complicated than that. The C<PREFIX> -idea is fundamentally broken when your machine doesn't jibe with -C<PREFIX>'s worldview. - - -=over 4 - -=item Why PREFIX is not recommended - -=over 4 - -=item * - -Many systems have Perl configs that make little sense with PREFIX. -For example, OS X, where core modules go in -F</System/Library/Perl/...>, user-installed modules go in -F</Library/Perl/...>, and man pages go in F</usr/share/man/...>. The -PREFIX is thus set to F</>. Install L<Foo::Bar> on OS X with -C<PREFIX=/home/spurkis> and you get things like -F</home/spurkis/Library/Perl/5.8.1/Foo/Bar.pm> and -F</home/spurkis/usr/share/man/man3/Foo::Bar.3pm>. Not too pretty. - -The problem is not limited to Unix-like platforms, either - on Windows -builds (e.g. ActiveState perl 5.8.0), we have user-installed modules -going in F<C:\Perl\site\lib>, user-installed executables going in -F<C:\Perl\bin>, and PREFIX=F<C:\Perl\site>. The prefix just doesn't -apply neatly to the executables. - -=item * - -The PREFIX logic is too complicated and hard to predict for the user. -It's hard to document what exactly is going to happen. You can't give -a user simple instructions like "run perl Makefile.PL PREFIX=~ and -then set PERL5LIB=~/lib/perl5". - -=item * - -The results from PREFIX will change if your configuration of Perl -changes (for example, if you upgrade Perl). This means your modules -will end up in different places. - -=item * - -The results from PREFIX can change with different releases of -MakeMaker. The logic of PREFIX is subtle and it has been altered in -the past (mostly to limit damage in the many "edge cases" when its -behavior was undesirable). - -=item * - -PREFIX imposes decisions made by the person who configured Perl onto -the person installing a module. The person who configured Perl could -have been you or it could have been some guy at Redhat. - -=back - - -=item Alternatives to PREFIX - -Module::Build offers L</install_base> as a simple, predictable, and -user-configurable alternative to ExtUtils::MakeMaker's C<PREFIX>. -What's more, MakeMaker will soon accept C<INSTALL_BASE> -- we strongly -urge you to make the switch. - -Here's a quick comparison of the two when installing modules to your -home directory on a unix box: - -MakeMaker [*]: - - % perl Makefile.PL PREFIX=/home/spurkis - PERL5LIB=/home/spurkis/lib/perl5/5.8.5:/home/spurkis/lib/perl5/site_perl/5.8.5 - PATH=/home/spurkis/bin - MANPATH=/home/spurkis/man - -Module::Build: - - % perl Build.PL install_base=/home/spurkis - PERL5LIB=/home/spurkis/lib/perl5 - PATH=/home/spurkis/bin - MANPATH=/home/spurkis/man - -[*] Note that MakeMaker's behaviour cannot be guaranteed in even this -common scenario, and differs among different versions of MakeMaker. - -In short, using C<install_base> is similar to the following MakeMaker usage: +=item prefix - perl Makefile.PL PREFIX=/home/spurkis LIB=/home/spurkis/lib/perl5 +Provided for compatibility with ExtUtils::MakeMaker's PREFIX argument. +C<prefix> should be used when you wish Module::Build to install your +modules, documentation and scripts in the same place +ExtUtils::MakeMaker does. + +The following are equivalent. + + perl Build.PL --prefix /tmp/foo + perl Makefile.PL PREFIX=/tmp/foo + +Because of the very complex nature of the prefixification logic, the +behavior of PREFIX in MakeMaker has changed subtly over time. +Module::Build's --prefix logic is equivalent to the PREFIX logic found +in ExtUtils::MakeMaker 6.30. + +If you do not need to retain compatibility with ExtUtils::MakeMaker or +are starting a fresh Perl installation we recommand you use +C<install_base> instead (and C<INSTALL_BASE> in ExtUtils::MakeMaker). +See L<Module::Build::Cookbook/Instaling in the same location as +ExtUtils::MakeMaker> for further information. -See L</"INSTALL PATHS"> for details on other -installation options available and how to configure them. =back Modified: Module-Build/trunk/lib/Module/Build/Cookbook.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build/Cookbook.pm (original) +++ Module-Build/trunk/lib/Module/Build/Cookbook.pm Thu May 18 19:06:04 2006 @@ -131,22 +131,69 @@ To install to a non-standard directory (for example, if you don't have permission to install in the system-wide directories), you can use the -C<install_base> or C<prefix> parameters: +C<install_base>: ./Build install --install_base /foo/bar - or - ./Build install --prefix /foo/bar - -Note that these have somewhat different effects - C<prefix> is an -emulation of C<ExtUtils::MakeMaker>'s old C<PREFIX> setting, and -inherits all its nasty gotchas. C<install_base> is more predictable, -and newer versions of C<ExtUtils::MakeMaker> also support it, so it's -often your best choice. See L<Module::Build/"INSTALL PATHS"> for a much more complete discussion of how installation paths are determined. +=head2 Installing in the same location as ExtUtils::MakeMaker + +With the introduction of C<--prefix> in Module::Build 0.28 and +C<INSTALL_BASE> in ExtUtils::MakeMaker 6.31 its easy to get them both +to install to the same locations. + +First, ensure you have at least version 0.28 of Module::Build +installed and 6.31 of ExtUtils::MakeMaker. Prior versions have +differing installation behaviors. + +The following installation flags are equivalent between +ExtUtils::MakeMaker and Module::Build. + + MakeMaker Module::Build + PREFIX=... --prefix ... + INSTALL_BASE=... --install_base ... + DESTDIR=... --destdir ... + LIB=... --install_path lib=... + INSTALLDIRS=... --installdirs ... + INSTALLDIRS=perl --installdirs core + UNINST=... --uninst ... + INC=... --extra_compiler_flags ... + POLLUTE=1 --extra_compiler_flags -DPERL_POLLUTE + +For example, if you are currently installing MakeMaker modules with +this command: + + perl Makefile.PL PREFIX=~ + make test + make install UNINST=1 + +You can install into the same location with Module::Build using this: + + perl Build.PL --prefix ~ + ./Build test + ./Build install --uninst 1 + +=head3 C<prefix> vs C<install_base> + +The behavior of C<prefix> is complicated and depends closely on +how your Perl is configured. The resulting installation locations +will vary from machine to machine and even different installations of +Perl on the same machine. Because of this, its difficult to document +where C<prefix> will place your modules. + +In contrast, C<install_base> has predictable, easy to explain +installation locations. Now that Module::Build and MakeMaker both +have C<install_base> there is little reason to use C<prefix> other +than to preserve your existing installation locations. If you are +starting a fresh Perl installation we encourage you to use +C<install_base>. If you have an existing installation installed via +C<prefix>, consider moving it to an installation structure matching +C<install_base> and using that instead. + + =head2 Running a single test file C<Module::Build> supports running a single test, which enables you to |
From: <ra...@cv...> - 2006-05-16 07:43:31
|
Author: randys Date: Tue May 16 00:42:52 2006 New Revision: 6299 Modified: Module-Build/trunk/Changes Module-Build/trunk/lib/Module/Build/Compat.pm Log: Module::Build::Compat's emulation of INC is incorrectly prepending a -I to the value of INC. Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Tue May 16 00:42:52 2006 @@ -2,6 +2,12 @@ 0.2801 + - Module::Build::Compat's emulation of INC is incorrectly prepending + a -I to the value of INC. This is incorrect because there should + already be a -I on the value. I.E. it's "perl Makefile.PL INC=-Ifoo" + not "perl Makefile.PL INC=foo" so Compat should not prefix a -I. + [Patch by Michael Schwern] + - Native batch scripts under Windows should not be converted by pl2bat. [Spotted by Ron Savage] Modified: Module-Build/trunk/lib/Module/Build/Compat.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build/Compat.pm (original) +++ Module-Build/trunk/lib/Module/Build/Compat.pm Tue May 16 00:42:52 2006 @@ -15,7 +15,7 @@ ( TEST_VERBOSE => 'verbose', VERBINST => 'verbose', - INC => sub { map {('--extra_compiler_flags', "-I$_")} Module::Build->split_like_shell(shift) }, + INC => sub { map {('--extra_compiler_flags', $_)} Module::Build->split_like_shell(shift) }, POLLUTE => sub { ('--extra_compiler_flags', '-DPERL_POLLUTE') }, INSTALLDIRS => sub {local $_ = shift; 'installdirs=' . (/^perl$/ ? 'core' : $_) }, LIB => sub { ('--install_path', 'lib='.shift()) }, |
From: <kwi...@cv...> - 2006-05-12 21:25:47
|
Author: kwilliams Date: Fri May 12 14:25:11 2006 New Revision: 6293 Modified: Module-Build/trunk/Changes Module-Build/trunk/lib/Module/Build/YAML.pm Module-Build/trunk/t/mbyaml.t Log: Some fixes for YAML generation Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Fri May 12 14:25:11 2006 @@ -20,6 +20,12 @@ attended mode are working properly was assuming that we started out in attended mode. [Steve Peters] + - Improved our stand-in YAML generator that we use to generate + META.yaml when authors don't have a copy of YAML.pm installed on + their machine. It was unable to handle things like embedded + newlines in the data, now it has a much more extensive escaping + mechanism. [Stephen Adkins] + 0.28 Thu Apr 27 22:25:00 CDT 2006 - When y_n() or prompt() are called without a default value and the Modified: Module-Build/trunk/lib/Module/Build/YAML.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build/YAML.pm (original) +++ Module-Build/trunk/lib/Module/Build/YAML.pm Fri May 12 14:25:11 2006 @@ -102,25 +102,30 @@ } sub _yaml_value { - # XXX doesn't handle embedded newlines my ($value) = @_; - # undefs and empty strings will become empty strings - if (! defined $value || $value eq "") { - return('""'); + # undefs become ~ + if (! defined $value) { + return("~"); } - # allow simple scalars (without embedded quote chars) to be unquoted - elsif ($value !~ /["'\\]/) { - return($value); + # empty strings will become empty strings + elsif (! defined $value || $value eq "") { + return('""'); } - # strings without double-quotes get double-quoted - elsif ($value !~ /\"/) { - $value =~ s{\\}{\\\\}g; - return qq{"$value"}; + # quote and escape strings with special values + elsif ($value =~ /["'`~\n!\@\#^\&\*\(\)\{\}\[\]\|<>\?]/) { + if ($value !~ /['`~\n!\#^\&\*\(\)\{\}\[\]\|\?]/) { # nothing but " or @ or < or > (email addresses) + return("'" . $value . "'"); + } + else { + $value =~ s/\n/\\n/g; # handle embedded newlines + $value =~ s/"/\\"/g; # handle embedded quotes + return('"' . $value . '"'); + } } - # other strings get single-quoted + # allow simple scalars (without embedded quote chars) to be unquoted + # (includes $%_+=-\;:,./) else { - $value =~ s{([\\'])}{\\$1}g; - return qq{'$value'}; + return($value); } } Modified: Module-Build/trunk/t/mbyaml.t ============================================================================== --- Module-Build/trunk/t/mbyaml.t (original) +++ Module-Build/trunk/t/mbyaml.t Fri May 12 14:25:11 2006 @@ -9,9 +9,12 @@ $dir = "t" if (-d "t"); { - use_ok("Module::Build::YAML"); - my ($expected, $got, $var); - $var = { + use_ok("Module::Build::YAML"); + my ($expected, $got, $var); + ########################################################## + # Test a typical-looking Module::Build structure (alphabetized) + ########################################################## + $var = { 'resources' => { 'license' => 'http://opensource.org/licenses/artistic-license.php' }, @@ -43,11 +46,11 @@ }, 'abstract' => 'A framework for building dynamic widgets or full applications in Javascript' }; - $expected = <<EOF; + $expected = <<'EOF'; --- abstract: A framework for building dynamic widgets or full applications in Javascript author: - - '"Stephen Adkins" <spadkins\@gmail.com>' + - '"Stephen Adkins" <spa...@gm...>' build_requires: App::Build: 0 File::Spec: 0 @@ -72,12 +75,15 @@ $got = &Module::Build::YAML::Dump($var); is($got, $expected, "Dump(): single deep hash"); - $expected = <<EOF; + ########################################################## + # Test a typical-looking Module::Build structure (ordered) + ########################################################## + $expected = <<'EOF'; --- name: js-app version: 0.13 author: - - '"Stephen Adkins" <spadkins\@gmail.com>' + - '"Stephen Adkins" <spa...@gm...>' abstract: A framework for building dynamic widgets or full applications in Javascript license: lgpl resources: @@ -102,13 +108,16 @@ $got = &Module::Build::YAML::Dump($var); is($got, $expected, "Dump(): single deep hash, ordered"); + ########################################################## + # Test that an array turns into multiple documents + ########################################################## $var = [ "e", 2.71828, [ "pi", "is", 3.1416 ], { fun => "under_sun", 6 => undef, "more", undef }, ]; - $expected = <<EOF; + $expected = <<'EOF'; --- e --- @@ -118,14 +127,17 @@ - is - 3.1416 --- -6: "" +6: ~ fun: under_sun -more: "" +more: ~ EOF $got = &Module::Build::YAML::Dump(@$var); is($got, $expected, "Dump(): multiple, various"); - $expected = <<EOF; + ########################################################## + # Test that a single array ref turns into one document + ########################################################## + $expected = <<'EOF'; --- - e - 2.71828 @@ -134,16 +146,115 @@ - is - 3.1416 - - 6: "" + 6: ~ fun: under_sun - more: "" + more: ~ EOF $got = &Module::Build::YAML::Dump($var); is($got, $expected, "Dump(): single array of various"); + ########################################################## + # Test Object-Oriented Flavor of the API + ########################################################## my $y = Module::Build::YAML->new(); $got = $y->Dump($var); is($got, $expected, "Dump(): single array of various (OO)"); + + ########################################################## + # Test Quoting Conditions (newlines, quotes, tildas, undefs) + ########################################################## + $var = { + 'foo01' => '`~!@#$%^&*()_+-={}|[]\\;\':",./?<> +<nl>', + 'foo02' => '~!@#$%^&*()_+-={}|[]\\;:,./<>?', + 'foo03' => undef, + 'foo04' => '~', + }; + $expected = <<'EOF'; +--- +foo01: "`~!@#$%^&*()_+-={}|[]\;':\",./?<>\n<nl>" +foo02: "~!@#$%^&*()_+-={}|[]\;:,./<>?" +foo03: ~ +foo04: "~" +EOF + $got = &Module::Build::YAML::Dump($var); + is($got, $expected, "Dump(): tricky embedded characters"); + + $var = { + 'foo10' => undef, + 'foo40' => '!', + 'foo41' => '@', + 'foo42' => '#', + 'foo43' => '$', + 'foo44' => '%', + 'foo45' => '^', + 'foo47' => '&', + 'foo48' => '*', + 'foo49' => '(', + 'foo50' => ')', + 'foo51' => '_', + 'foo52' => '+', + 'foo53' => '-', + 'foo54' => '=', + 'foo55' => '{', + 'foo56' => '}', + 'foo57' => '|', + 'foo58' => '[', + 'foo59' => ']', + 'foo60' => '\\', + 'foo61' => ';', + 'foo62' => ':', + 'foo63' => ',', + 'foo64' => '.', + 'foo65' => '/', + 'foo66' => '<', + 'foo67' => '>', + 'foo68' => '?', + 'foo69' => '\'', + 'foo70' => '"', + 'foo71' => '`', + 'foo72' => ' +', + }; + $expected = <<'EOF'; +--- +foo10: ~ +foo40: "!" +foo41: '@' +foo42: "#" +foo43: $ +foo44: % +foo45: "^" +foo47: "&" +foo48: "*" +foo49: "(" +foo50: ")" +foo51: _ +foo52: + +foo53: - +foo54: = +foo55: "{" +foo56: "}" +foo57: "|" +foo58: "[" +foo59: "]" +foo60: \ +foo61: ; +foo62: : +foo63: , +foo64: . +foo65: / +foo66: '<' +foo67: '>' +foo68: "?" +foo69: "'" +foo70: '"' +foo71: "`" +foo72: "\n" +EOF + $got = &Module::Build::YAML::Dump($var); + is($got, $expected, "Dump(): tricky embedded characters (singles)"); + } |
From: <kwi...@cv...> - 2006-05-12 17:22:01
|
Author: kwilliams Date: Fri May 12 10:21:13 2006 New Revision: 6289 Modified: Module-Build/trunk/Changes Log: Change log entry Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Fri May 12 10:21:13 2006 @@ -15,6 +15,11 @@ - Fixed a guaranteed failure in t/signature.t when TEST_SIGNATURE was set. [Eric R. Meyers] + - Fixed a test failure that occurred when testing or installing in + unattended mode - the code to test whether unattended mode and + attended mode are working properly was assuming that we started out + in attended mode. [Steve Peters] + 0.28 Thu Apr 27 22:25:00 CDT 2006 - When y_n() or prompt() are called without a default value and the |
From: <ra...@cv...> - 2006-05-12 00:06:36
|
Author: randys Date: Thu May 11 17:06:06 2006 New Revision: 6288 Modified: Module-Build/trunk/Changes Module-Build/trunk/lib/Module/Build/Platform/Windows.pm Module-Build/trunk/t/runthrough.t Log: Native batch scripts should not be converted by pl2bat. Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Thu May 11 17:06:06 2006 @@ -2,6 +2,9 @@ 0.2801 + - Native batch scripts under Windows should not be converted by + pl2bat. [Spotted by Ron Savage] + - Tweaked the way we determine whether a file is executable on Unix. We use this determination to decide whether to make it executable during installation. [Julian Mehnle] Modified: Module-Build/trunk/lib/Module/Build/Platform/Windows.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build/Platform/Windows.pm (original) +++ Module-Build/trunk/lib/Module/Build/Platform/Windows.pm Thu May 11 17:06:06 2006 @@ -54,17 +54,26 @@ $self->SUPER::make_executable(@_); foreach my $script (@_) { - my %opts = (); - if ( $script eq $self->build_script ) { - $opts{ntargs} = q(-x -S %0 --build_bat %*); - $opts{otherargs} = q(-x -S "%0" --build_bat %1 %2 %3 %4 %5 %6 %7 %8 %9); - } - my $out = eval {$self->pl2bat(in => $script, update => 1, %opts)}; - if ( $@ ) { - $self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@"); + # Native batch script + if ( $script =~ /\.(bat|cmd)$/ ) { + $self->SUPER::make_executable($script); + next; + + # Perl script that needs to be wrapped in a batch script } else { - $self->SUPER::make_executable($out); + my %opts = (); + if ( $script eq $self->build_script ) { + $opts{ntargs} = q(-x -S %0 --build_bat %*); + $opts{otherargs} = q(-x -S "%0" --build_bat %1 %2 %3 %4 %5 %6 %7 %8 %9); + } + + my $out = eval {$self->pl2bat(in => $script, update => 1, %opts)}; + if ( $@ ) { + $self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@"); + } else { + $self->SUPER::make_executable($out); + } } } } Modified: Module-Build/trunk/t/runthrough.t ============================================================================== --- Module-Build/trunk/t/runthrough.t (original) +++ Module-Build/trunk/t/runthrough.t Thu May 11 17:06:06 2006 @@ -2,7 +2,7 @@ use strict; use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib'; -use MBTest tests => 28; +use MBTest tests => 32; use Module::Build; use Module::Build::ConfigData; @@ -197,6 +197,47 @@ ok ! -e $mb->config_dir; ok ! -e $mb->dist_dir; +chdir( $cwd ) or die "Can''t chdir to '$cwd': $!"; +$dist->remove; + +SKIP: { + skip( 'Windows only test', 4 ) unless $^O =~ /^MSWin/; + + my $script_data = <<'---'; +@echo off +echo Hello, World! +--- + + $dist = DistGen->new( dir => $tmp ); + $dist->change_file( 'Build.PL', <<'---' ); +use Module::Build; +my $build = new Module::Build( + module_name => 'Simple', + scripts => [ 'bin/script.bat' ], + license => 'perl', +); +$build->create_build_script; +--- + $dist->add_file( 'bin/script.bat', $script_data ); + + $dist->regen; + chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!"; + + $mb = Module::Build->new_from_context; + ok $mb; + + eval{ $mb->dispatch('build') }; + is $@, ''; + + my $script_file = File::Spec->catfile( qw(blib script), 'script.bat' ); + ok -f $script_file, "Native batch file copied to 'scripts'"; + + my $out = slurp( $script_file ); + is $out, $script_data, ' unmodified by pl2bat'; + + chdir( $cwd ) or die "Can''t chdir to '$cwd': $!"; + $dist->remove; +} # cleanup chdir( $cwd ) or die "Can''t chdir to '$cwd': $!"; |
From: <ra...@cv...> - 2006-05-09 07:24:15
|
Author: randys Date: Tue May 9 00:23:55 2006 New Revision: 6274 Modified: Module-Build/trunk/t/extend.t Log: Some tests in t/extend.t which test interactive prompting depend on STDIN being open, particularly Module::Build::Base::_is_interactive() checks the status of STDIN. This will fool some of our tests when, for example, Test::Smoke runs the test suite from a cron job which has no STDIN. Since these tests are not testing the _is_interactive() method itself, we override it to always return true during these tests. Modified: Module-Build/trunk/t/extend.t ============================================================================== --- Module-Build/trunk/t/extend.t (original) +++ Module-Build/trunk/t/extend.t Tue May 9 00:23:55 2006 @@ -230,35 +230,44 @@ $ENV{PERL_MM_USE_DEFAULT} = 1; - eval{ $mb->y_n("Is this a question?") }; - like $@, qr/ERROR:/, 'Do not allow default-less y_n() for unattended builds'; + eval{ $mb->y_n('Is this a question?') }; + like $@, qr/ERROR:/, + 'Do not allow default-less y_n() for unattended builds'; eval{ $ans = $mb->prompt('Is this a question?') }; - like $@, qr/ERROR:/, 'Do not allow default-less prompt() for unattended builds'; + like $@, qr/ERROR:/, + 'Do not allow default-less prompt() for unattended builds'; - $ENV{PERL_MM_USE_DEFAULT} = 0; + # When running Test::Smoke under a cron job, STDIN will be closed which + # will fool our _is_interactive() method causing various failures. + { + local *{Module::Build::_is_interactive} = sub { 1 }; - $ans = $mb->prompt('Is this a question?'); - print "\n"; # fake <enter> after input - is $ans, 'y', "prompt() doesn't require default for interactive builds"; + $ENV{PERL_MM_USE_DEFAULT} = 0; - $ans = $mb->y_n('Say yes'); - print "\n"; # fake <enter> after input - ok $ans, "y_n() doesn't require default for interactive build"; + $ans = $mb->prompt('Is this a question?'); + print "\n"; # fake <enter> after input + is $ans, 'y', "prompt() doesn't require default for interactive builds"; + $ans = $mb->y_n('Say yes'); + print "\n"; # fake <enter> after input + ok $ans, "y_n() doesn't require default for interactive build"; - # Test Defaults - *{Module::Build::_readline} = sub { '' }; - $ans = $mb->prompt("Is this a question"); - is $ans, '', "default for prompt() without a default is ''"; + # Test Defaults + *{Module::Build::_readline} = sub { '' }; - $ans = $mb->prompt("Is this a question", 'y'); - is $ans, 'y', " prompt() with a default"; + $ans = $mb->prompt("Is this a question"); + is $ans, '', "default for prompt() without a default is ''"; + + $ans = $mb->prompt("Is this a question", 'y'); + is $ans, 'y', " prompt() with a default"; + + $ans = $mb->y_n("Is this a question", 'y'); + ok $ans, " y_n() with a default"; + } - $ans = $mb->y_n("Is this a question", 'y'); - ok $ans, " y_n() with a default"; } # cleanup |
From: <kwi...@cv...> - 2006-05-06 22:06:10
|
Author: kwilliams Date: Sat May 6 15:05:46 2006 New Revision: 6023 Modified: Module-Build/trunk/Changes Module-Build/trunk/t/lib/MBTest.pm Log: Fixed a guaranteed failure in t/signature.t when TEST_SIGNATURE was set. Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Sat May 6 15:05:46 2006 @@ -9,6 +9,9 @@ - Replaced a vestigial 'next' with 'return' now that the code is in a subroutine (htmlify_pods()), not a loop. [Ron Savage] + - Fixed a guaranteed failure in t/signature.t when TEST_SIGNATURE was + set. [Eric R. Meyers] + 0.28 Thu Apr 27 22:25:00 CDT 2006 - When y_n() or prompt() are called without a default value and the Modified: Module-Build/trunk/t/lib/MBTest.pm ============================================================================== --- Module-Build/trunk/t/lib/MBTest.pm (original) +++ Module-Build/trunk/t/lib/MBTest.pm Sat May 6 15:05:46 2006 @@ -44,7 +44,7 @@ # We have a few extra exports, but Test::More has a special import() # that won't take extra additions. -my @extra_exports = qw(stdout_of stderr_of slurp find_in_path check_compiler); +my @extra_exports = qw(stdout_of stderr_of slurp find_in_path check_compiler have_module); push @EXPORT, @extra_exports; __PACKAGE__->export(scalar caller, @extra_exports); @@ -105,4 +105,9 @@ return ($have_c_compiler, $mb->feature('C_support')); } +sub have_module { + my $module = shift; + return eval "use $module; 1"; +} + 1; |
From: <kwi...@cv...> - 2006-05-04 00:58:23
|
Author: kwilliams Date: Wed May 3 17:57:59 2006 New Revision: 6018 Modified: Module-Build/trunk/Changes Log: Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Wed May 3 17:57:59 2006 @@ -6,6 +6,9 @@ We use this determination to decide whether to make it executable during installation. [Julian Mehnle] + - Replaced a vestigial 'next' with 'return' now that the code is in a + subroutine (htmlify_pods()), not a loop. [Ron Savage] + 0.28 Thu Apr 27 22:25:00 CDT 2006 - When y_n() or prompt() are called without a default value and the |
From: <kwi...@cv...> - 2006-05-04 00:55:45
|
Author: kwilliams Date: Wed May 3 17:55:22 2006 New Revision: 6017 Modified: Module-Build/trunk/lib/Module/Build/Base.pm Log: Replace a vestigial 'next' with a 'return' now that it's in a subroutine, not a loop. Modified: Module-Build/trunk/lib/Module/Build/Base.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build/Base.pm (original) +++ Module-Build/trunk/lib/Module/Build/Base.pm Wed May 3 17:55:22 2006 @@ -2503,7 +2503,7 @@ my $pods = $self->_find_pods( $self->{properties}{"${type}doc_dirs"}, exclude => [ qr/\.(?:bat|com|html)$/ ] ); - next unless %$pods; # nothing to do + return unless %$pods; # nothing to do unless ( -d $htmldir ) { File::Path::mkpath($htmldir, 0, 0755) |
From: <kwi...@cv...> - 2006-05-02 23:22:02
|
Author: kwilliams Date: Tue May 2 16:21:40 2006 New Revision: 6010 Modified: Module-Build/trunk/Changes Module-Build/trunk/lib/Module/Build/Base.pm Module-Build/trunk/lib/Module/Build/Platform/Unix.pm Log: Use stat() on Unix, -x everywhere else. Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Tue May 2 16:21:40 2006 @@ -1,5 +1,11 @@ Revision history for Perl extension Module::Build. +0.2801 + + - Tweaked the way we determine whether a file is executable on Unix. + We use this determination to decide whether to make it executable + during installation. [Julian Mehnle] + 0.28 Thu Apr 27 22:25:00 CDT 2006 - When y_n() or prompt() are called without a default value and the Modified: Module-Build/trunk/lib/Module/Build/Base.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build/Base.pm (original) +++ Module-Build/trunk/lib/Module/Build/Base.pm Tue May 2 16:21:40 2006 @@ -1272,6 +1272,13 @@ } } +sub is_executable { + # We assume this does the right thing on generic platforms, though + # we do some other more specific stuff on Unixish platforms. + my ($self, $file) = @_; + return -x $file; +} + sub _startperl { shift()->config('startperl') } # Return any directories in @INC which are not in the default @INC for @@ -3955,7 +3962,7 @@ $self->log_info("$file -> $to_path\n") if $args{verbose}; File::Copy::copy($file, $to_path) or die "Can't copy('$file', '$to_path'): $!"; # mode is read-only + (executable if source is executable) - my $mode = 0444 | ( -x $file ? 0111 : 0 ); + my $mode = 0444 | ( $self->is_executable($file) ? 0111 : 0 ); chmod( $mode, $to_path ); return $to_path; Modified: Module-Build/trunk/lib/Module/Build/Platform/Unix.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build/Platform/Unix.pm (original) +++ Module-Build/trunk/lib/Module/Build/Platform/Unix.pm Tue May 2 16:21:40 2006 @@ -13,6 +13,17 @@ $self->SUPER::make_tarball(@_); } +sub is_executable { + # We consider the owner bit to be authoritative on a file, because + # -x will always return true if the user is root and *any* + # executable bit is set. The -x test seems to try to answer the + # question "can I execute this file", but I think we want "is this + # file executable". + + my ($self, $file) = @_; + return +(stat $file)[2] & 0100; +} + sub _startperl { "#! " . shift()->perl } sub _construct { |
From: <kwi...@cv...> - 2006-05-01 03:33:42
|
Author: kwilliams Date: Sun Apr 30 20:32:57 2006 New Revision: 5994 Added: Module-Build/tags/release-0_28/ - copied from r5993, /Module-Build/trunk/ Log: A tag for release 0.28 |
From: <kwi...@cv...> - 2006-04-28 03:25:49
|
Author: kwilliams Date: Thu Apr 27 20:25:30 2006 New Revision: 5979 Modified: Module-Build/trunk/Changes Module-Build/trunk/lib/Module/Build.pm Log: Version bump Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Thu Apr 27 20:25:30 2006 @@ -1,6 +1,6 @@ Revision history for Perl extension Module::Build. -0.27_11 +0.28 Thu Apr 27 22:25:00 CDT 2006 - When y_n() or prompt() are called without a default value and the build seems to be unattended (e.g. in automatic CPAN testing), we Modified: Module-Build/trunk/lib/Module/Build.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build.pm (original) +++ Module-Build/trunk/lib/Module/Build.pm Thu Apr 27 20:25:30 2006 @@ -15,7 +15,7 @@ use vars qw($VERSION @ISA); @ISA = qw(Module::Build::Base); -$VERSION = '0.27_10'; +$VERSION = '0.28'; $VERSION = eval $VERSION; # Okay, this is the brute-force method of finding out what kind of |
From: <kwi...@cv...> - 2006-04-28 02:45:06
|
Author: kwilliams Date: Thu Apr 27 19:44:46 2006 New Revision: 5978 Modified: Module-Build/trunk/t/extend.t Log: Unless I've overlooked a previous decision, prompt() should die (rather than hang) when called in an unattended context with no default. Modified: Module-Build/trunk/t/extend.t ============================================================================== --- Module-Build/trunk/t/extend.t (original) +++ Module-Build/trunk/t/extend.t Thu Apr 27 19:44:46 2006 @@ -231,11 +231,10 @@ $ENV{PERL_MM_USE_DEFAULT} = 1; eval{ $mb->y_n("Is this a question?") }; - like $@, qr/ERROR:/, 'Do not allow y_n() prompts for unattended builds'; + like $@, qr/ERROR:/, 'Do not allow default-less y_n() for unattended builds'; - $ans = $mb->prompt('Is this a question?'); - print "\n"; # fake <enter> after input - is $ans, 'y', "prompt() doesn't require default for unattended builds"; + eval{ $ans = $mb->prompt('Is this a question?') }; + like $@, qr/ERROR:/, 'Do not allow default-less prompt() for unattended builds'; $ENV{PERL_MM_USE_DEFAULT} = 0; |
From: <kwi...@cv...> - 2006-04-28 02:31:19
|
Author: kwilliams Date: Thu Apr 27 19:31:04 2006 New Revision: 5977 Modified: Module-Build/trunk/lib/Module/Build/Base.pm Log: A little more consistency in prompt() and y_n(). Modified: Module-Build/trunk/lib/Module/Build/Base.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build/Base.pm (original) +++ Module-Build/trunk/lib/Module/Build/Base.pm Thu Apr 27 19:31:04 2006 @@ -472,22 +472,26 @@ sub _readline { my $self = shift; + return undef if $self->_is_unattended; - my $answer; - if ( !$self->_is_unattended ) { - $answer = <STDIN>; - chomp $answer if defined $answer; - } - + my $answer = <STDIN>; + chomp $answer if defined $answer; return $answer; } sub prompt { my $self = shift; - my ($mess, $def) = @_; - - die "prompt() called without a prompt message" unless $mess; + my $mess = shift + or die "prompt() called without a prompt message"; + my $def; + if ( $self->_is_unattended && !@_ ) { + die <<EOF; +ERROR: This build seems to be unattended, but there is no default value +for this question. Aborting. +EOF + } + $def = shift if @_; ($def, my $dispdef) = defined $def ? ($def, "[$def] ") : ('', ' '); local $|=1; |
From: <ra...@cv...> - 2006-04-28 02:19:09
|
Author: randys Date: Thu Apr 27 19:18:43 2006 New Revision: 5976 Modified: Module-Build/trunk/Changes Module-Build/trunk/lib/Module/Build/API.pod Module-Build/trunk/lib/Module/Build/Base.pm Module-Build/trunk/t/extend.t Log: Remove ask() method. Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Thu Apr 27 19:18:43 2006 @@ -2,12 +2,6 @@ 0.27_11 - - Add new method ask(), intended to provide a more complete tool for - authors to query users when performing a build. It provides better - support for unattended builds as well as providing better - validation of input. This new method is preferred over prompt() and - y_n(). - - When y_n() or prompt() are called without a default value and the build seems to be unattended (e.g. in automatic CPAN testing), we now die() with an error message rather than silently returning Modified: Module-Build/trunk/lib/Module/Build/API.pod ============================================================================== --- Module-Build/trunk/lib/Module/Build/API.pod (original) +++ Module-Build/trunk/lib/Module/Build/API.pod Thu Apr 27 19:18:43 2006 @@ -819,118 +819,6 @@ the second argument is assigned to the args hash under the key passed as the first argument. -=item ask() - -[version 0.28] - -Asks the user a question and returns the answer as a string. - -The following is a list of arguments. Only C<prompt> and C<default> -are required. - -=over - -=item allow_nonoption_default - -Normally, if an C<options> array is present, then the value of the -C<default> argument must exist in C<options>. Setting -C<allow_nonoption_default> to true allows the C<default> argument to -be set to an arbitrary value. - -Default is false. - -=item default [required] - -This is the default value that will be used if the user presses -E<lt>enterE<gt> or if running an unattended build. - -The value assigned to C<default> must exist in the C<options> argument -if it is present unless the C<allow_nonoption_default> flag is set to -true. If there are no C<options> then C<default> may be set to any -value. - -=item getopts_name - -The name of a command line option. If an option with this name is -given on the command line, the value of the option will be used as the -answer to the prompt. The value will still be subject to the normal -checks for validity. - -=item on_validate - -This is a code reference that can be used to validate or modify the -answer entered by the user. The value the user enters will be passed -in as the first argument, and it will also be stored in the C<$_> -variable. Any modification to the C<$_> variable will be retained as -the new answer. - -The subroutine passed to C<on_validate> must return a value to -indicate how to proceed. - -If the return value is true, then the answer will be accepted as is, -without further testing. In particular, there will be no test to -ensure that the answer is in the C<options> array if any were given. - -If the return value is false, then the answer will be rejected and a -new answer will be requested, regardless of whether the answer would -normally be accepted by the usual checks. - -If the return value is C<undef>, then the answer will be subject to -the normal checks: if there is an C<options> array and the answer is -one of the options, it will be accepted; if it is an open-ended query -without an C<options> array, it will be accepted; otherwise it will be -rejected. - -=item options - -A reference to an array containing a list of valid options. If options -are provided, C<ask()> will not return until a valid option is -entered, or the C<default> is selected by pressing E<lt>enterE<gt> -without entering a value. Option names are case-insensitive, but the -option returned will be normalized to the form used in the argument to -C<options>. It is not necessary for the user to enter the entire -option name; C<ask()> will accept any unambiguous sequence of -characters that will match only one option. Eg. If the options are -C<qw(yes no)> it will accept any of 'y', 'ye', or 'yes' to mean -yes. The complete option name will be returned. - -If no options are provided, C<ask()> will accept any response from the -user. - -=item prompt [required] - -This string will be displayed to the user to indicate that input is -needed. It should indicate the type of input required. - -=item show_default - -A boolean value that indicates whether the default value should be -displayed as part of the prompt. If true and if the default is a -non-empty string, the default will be displayed at the end of the -prompt, after the list of options if present. It will be enclosed in -square brackets. - -Default is true. - -=item show_options - -A boolean value that indicates whether the list of options should be -displayed as part of the prompt. If true and if C<options> contains a -non-empty array, the list of options will be displayed at the end of -the prompt, and before the C<default> value if it is shown. The -options will be separated by slashes and enclosed in parenthesis. - -Default is true. - -=back - -If C<ask()> detects that it is not running interactively and there -is nothing on STDIN or if the PERL_MM_USE_DEFAULT environment variable -is set to true, the C<default> will be used without prompting. This -prevents automated processes from blocking on user input. - -This method may be called as a class or object method. - =item autosplit_file($from, $to) [version 0.28] Modified: Module-Build/trunk/lib/Module/Build/Base.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build/Base.pm (original) +++ Module-Build/trunk/lib/Module/Build/Base.pm Thu Apr 27 19:18:43 2006 @@ -530,144 +530,6 @@ } } -sub ask { - my $self = shift; - my %args = @_; - - # Check argument requirements - croak("ask() called without a prompt message") unless $args{prompt}; - croak("ask() called without a default value") unless exists($args{default}); - - # Set defaults - my $show_options = exists($args{show_options}) ? $args{show_options} : 1; - my $show_default = exists($args{show_default}) ? $args{show_default} : 1; - - my $getopts_name = exists($args{getopts_name}) ? $args{getopts_name} : undef; - - my $allow_nonoption_default = exists($args{allow_nonoption_default}) - ? $args{allow_nonoption_default} : 0; - - my $on_validate = ref( $args{on_validate} ) eq 'CODE' - ? sub { - my $ans_ref = shift; - local $_ = $$ans_ref; - my $ret = $args{on_validate}->($_); - $$ans_ref = $_; - return $ret; - } - : sub { return undef }; - - - # Setup options & abbrevs - my @options = (); - my $disp_options = ''; - my %abbrev_of = (); - my %proper_case_of = (); - - if ( $args{options} && ref($args{options}) eq 'ARRAY' ) { - @options = @{$args{options}}; - if ( @options ) { - require Text::Abbrev; - %abbrev_of = Text::Abbrev::abbrev(map lc, @options); - %proper_case_of = map { lc $_, $_ } @options; - $disp_options = '(' . join('/', @options) . ')'; - } - } - - # Validate the default - my $default; - if ( $allow_nonoption_default || - !$args{options} || - grep( {$_ eq $args{default}} @options ) ) - { - $default = $args{default}; - } else { - croak("The 'default' argument must exist in 'options' array."); - } - - my $disp_default = '[' . $proper_case_of{$abbrev_of{lc $default}} . ']' - if $default && exists($abbrev_of{lc $default}); - - # Format prompt - my $prompt = $args{prompt}; - - # if $prompt ends in new-line, don't insert inital space - my $space = sub { (substr($_[0], -1) eq "\n") ? '' : ' ' }; - - $prompt .= $space->($prompt) . $disp_options - if $disp_options && $show_options; - - $prompt .= $space->($prompt) . $disp_default - if $disp_default && $show_default; - - $prompt .= $space->($prompt); - - - local $|=1; - - # Guess - if ( $getopts_name && ref($self) ) { - - my %cmdline_args = $self->args; - if ( exists( $cmdline_args{$getopts_name} ) ) { - - my $answer = $cmdline_args{$getopts_name} || ''; - print $args{prompt} . $space->($args{prompt}) . "$answer\n"; - - $answer = $proper_case_of{$abbrev_of{lc $answer}} - if exists($abbrev_of{lc $answer}); - - my $is_valid = $on_validate->(\$answer); - if ( $is_valid ) { - return $answer; - } elsif ( defined( $is_valid ) ) { - # defined, but false return: do not continue other checks - } elsif ( @options ) { - if ( exists($abbrev_of{lc $answer}) || $answer eq $default ) { - return $answer; - } else { - warn "Invalid option '$getopts_name=$answer'\n\n"; - } - } else { - return $answer; - } - } - } - - # Get answer - my $answer; - my $needs_answer = 1; - while ( $needs_answer ) { - print $prompt; - $answer = $self->_readline(); - - if ( !defined($answer) || !length($answer) ) { # Ctrl-D || Default - print "$default\n"; - $answer = $default; - $needs_answer = 0; - - } else { - $answer = $proper_case_of{$abbrev_of{lc $answer}} - if exists($abbrev_of{lc $answer}); - - my $is_valid = $on_validate->(\$answer); - if ( $is_valid ) { - $needs_answer = 0; - } elsif ( defined( $is_valid ) ) { - # defined, but false return: do not continue other checks - } elsif ( @options ) { - if ( exists($abbrev_of{lc $answer}) || $answer eq $default ) { - $needs_answer = 0; - } - } else { - $needs_answer = 0; - } - } - } - - return $answer; -} - sub current_action { shift->{action} } sub invoked_action { shift->{invoked_action} } Modified: Module-Build/trunk/t/extend.t ============================================================================== --- Module-Build/trunk/t/extend.t (original) +++ Module-Build/trunk/t/extend.t Thu Apr 27 19:18:43 2006 @@ -2,7 +2,7 @@ use strict; use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib'; -use MBTest tests => 82; +use MBTest tests => 64; use Cwd (); my $cwd = Cwd::cwd; @@ -262,104 +262,6 @@ ok $ans, " y_n() with a default"; } -{ - # Test interactive prompting - - my $ans; - local $ENV{PERL_MM_USE_DEFAULT}; - - local $^W = 0; - local *{Module::Build::_readline} = sub { 'y' }; - - ok my $mb = Module::Build->new( - module_name => $dist->name, - license => 'perl', - args => {login => 'randys', - boolean => 'yes'}, - ); - - eval{ $mb->ask() }; - like $@, qr/called without a prompt/, 'ask() requires a prompt'; - - eval{ $mb->ask(prompt => 'prompt?') }; - like $@, qr/called without a default/, 'ask() requires a default'; - - eval{ $mb->ask(prompt => 'prompt?', default => 'y') }; - print "\n"; - is $@, '', 'default not required in options when options is undefined'; - - eval{ $mb->ask(prompt => 'prompt?', default => 'y', - options => [qw(a b c)]) }; - like $@, qr/'default' argument must exist in 'options' array/, - 'default must exist in options when options is non-empty'; - - eval{ $mb->ask(prompt => 'prompt?', - default => 'y', - allow_nonoption_default => 1) }; - print "\n"; - is $@, '', 'open ended query'; - - eval{ $mb->ask(prompt => 'prompt?', - default => 'y', - options => [qw(a b c)], - allow_nonoption_default => 1) }; - print "\n"; - is $@, '', 'multi-choice with nonoption default'; - - eval{ $mb->ask(prompt => 'prompt?', - default => 'y', - options => [qw(a b c y)] ) }; - print "\n"; - is $@, '', 'multi-choice with option default'; - - undef( $ans ); - eval{ $ans = $mb->ask(prompt => 'login?', - default => 'guest', - getopts_name => 'login', - allow_nonoption_default => 1) }; - print "\n"; - is $@, ''; - is $ans, 'randys', 'get answer from command line option'; - - undef( $ans ); - eval{ $ans = $mb->ask(prompt => 'prompt?', - default => 'yes', - options => [qw(yes no)], - getopts_name => 'boolean' ) }; - print "\n"; - is $@, ''; - is $ans, 'yes', 'get answer from command line option'; - - undef( $ans ); - eval{ $ans = $mb->ask(prompt => 'prompt?', - default => 'yes', - options => [qw(yes no)], - on_validate => sub { s/yes/true/; 1 } ) }; - print "\n"; - is $@, ''; - is $ans, 'true', 'change/validate answer'; - - - - *{Module::Build::_readline} = sub { undef }; - undef( $ans ); - eval{ $ans = $mb->ask(prompt => 'prompt?', - default => 'y', - options => [qw(y n)] ) }; - print "\n"; - is $@, ''; - is $ans, 'y', '<ctrl-d> - default answer'; - - *{Module::Build::_readline} = sub { '' }; - undef( $ans ); - eval{ $ans = $mb->ask(prompt => 'prompt?', - default => 'y', - options => [qw(y n)] ) }; - print "\n"; - is $@, ''; - is $ans, 'y', '<enter> - default answer'; -} - # cleanup chdir( $cwd ) or die "Can''t chdir to '$cwd': $!"; $dist->remove; |
From: <kwi...@cv...> - 2006-04-27 02:36:23
|
Author: kwilliams Date: Wed Apr 26 19:35:58 2006 New Revision: 5967 Modified: Module-Build/trunk/Changes Module-Build/trunk/t/compat.t Log: Fix our screen scraping for recent Test::Harnesses Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Wed Apr 26 19:35:58 2006 @@ -2,12 +2,17 @@ 0.27_11 - - Add new method ask(), that's intended to provide a better tool for + - Add new method ask(), intended to provide a more complete tool for authors to query users when performing a build. It provides better support for unattended builds as well as providing better validation of input. This new method is preferred over prompt() and y_n(). + - When y_n() or prompt() are called without a default value and the + build seems to be unattended (e.g. in automatic CPAN testing), we + now die() with an error message rather than silently returning + undef for prompt(), or looping indefinitely for y_n(). + - When searching for '.modulebuildrc', return the first HOME-like directory that actually contains the file instead of the first existing directory. Document the search locations and the order @@ -24,6 +29,10 @@ - copy_if_modified() now preserves the executable bit of the source file. [Spotted by Julian Mehnle] + - Fixed compatibility of our screen-scraping the Test::Harness output + so we can recognize the most recent Test::Harness version. [Steve + Hay] + - Backing out a requirement added in 0.27_06 on the method y_n() to always include a default. This behavior would cause existing build scripts to start failing. We now fail with a missing default Modified: Module-Build/trunk/t/compat.t ============================================================================== --- Module-Build/trunk/t/compat.t (original) +++ Module-Build/trunk/t/compat.t Wed Apr 26 19:35:58 2006 @@ -143,7 +143,7 @@ $output = stdout_of( sub { $ran_ok = $mb->do_system(@make, 'test', 'TEST_VERBOSE=0') } ); ok $ran_ok; $output =~ s/^/# /gm; # Don't confuse our own test output - like $output, qr/(?:# .+basic\.+ok\s+(?:[\d.]+s\s*)?)# All tests/, + like $output, qr/(?:# .+basic\.+ok\s+(?:[\d.]+\s*m?s\s*)?)# All tests/, 'Should be non-verbose'; $mb->delete_filetree($libdir); |
From: <kwi...@cv...> - 2006-04-20 18:07:16
|
Author: kwilliams Date: Thu Apr 20 11:06:50 2006 New Revision: 5945 Modified: Module-Build/branches/release-0_26_branch/Changes Module-Build/branches/release-0_26_branch/lib/Module/Build/Base.pm Log: Remove errant File::Spec::Unix references in building HTML pages Modified: Module-Build/branches/release-0_26_branch/Changes ============================================================================== --- Module-Build/branches/release-0_26_branch/Changes (original) +++ Module-Build/branches/release-0_26_branch/Changes Thu Apr 20 11:06:50 2006 @@ -9,6 +9,10 @@ 'passthrough' Makefile.PL check properly whether Module::Build was successfully installed. + - Integrated a Windows fix from the mainline branch that corrects an + error building HTML manual pages. + (http://rt.cpan.org/Public/Bug/Display.html?id=18076) + 0.2612 Thu Mar 2 22:27:37 CST 2006 - We now use File::Spec->tmpdir rather than the local _build/ Modified: Module-Build/branches/release-0_26_branch/lib/Module/Build/Base.pm ============================================================================== --- Module-Build/branches/release-0_26_branch/lib/Module/Build/Base.pm (original) +++ Module-Build/branches/release-0_26_branch/lib/Module/Build/Base.pm Thu Apr 20 11:06:50 2006 @@ -1809,9 +1809,9 @@ my @dirs = File::Spec->splitdir( File::Spec->canonpath( $path ) ); pop( @dirs ) if $dirs[-1] eq File::Spec->curdir; - my $fulldir = File::Spec::Unix->catfile($htmldir, @rootdirs, @dirs); - my $outfile = File::Spec::Unix->catfile($fulldir, $name . '.html'); - my $infile = File::Spec::Unix->abs2rel($pod); + my $fulldir = File::Spec->catfile($htmldir, @rootdirs, @dirs); + my $outfile = File::Spec->catfile($fulldir, $name . '.html'); + my $infile = File::Spec->abs2rel($pod); return if $self->up_to_date($infile, $outfile); |
From: <ra...@cv...> - 2006-04-19 09:10:00
|
Author: randys Date: Wed Apr 19 02:09:32 2006 New Revision: 5932 Modified: Module-Build/trunk/lib/Module/Build/API.pod Log: Update docs for ask() a bit. Modified: Module-Build/trunk/lib/Module/Build/API.pod ============================================================================== --- Module-Build/trunk/lib/Module/Build/API.pod (original) +++ Module-Build/trunk/lib/Module/Build/API.pod Wed Apr 19 02:09:32 2006 @@ -844,21 +844,24 @@ This is the default value that will be used if the user presses E<lt>enterE<gt> or if running an unattended build. -The value assigned to C<default> may be different from the options -listed in the C<options> argument. +The value assigned to C<default> must exist in the C<options> argument +if it is present unless the C<allow_nonoption_default> flag is set to +true. If there are no C<options> then C<default> may be set to any +value. =item getopts_name The name of a command line option. If an option with this name is given on the command line, the value of the option will be used as the -answer to the prompt. +answer to the prompt. The value will still be subject to the normal +checks for validity. =item on_validate This is a code reference that can be used to validate or modify the answer entered by the user. The value the user enters will be passed -in as the first argument, and it will also be stored in C<$_> -variable. Any modification to the variable C<$_> will be retained as +in as the first argument, and it will also be stored in the C<$_> +variable. Any modification to the C<$_> variable will be retained as the new answer. The subroutine passed to C<on_validate> must return a value to @@ -866,11 +869,11 @@ If the return value is true, then the answer will be accepted as is, without further testing. In particular, there will be no test to -ensure that the answer is in the C<options> array if any where given. +ensure that the answer is in the C<options> array if any were given. If the return value is false, then the answer will be rejected and a -new answer will be requested, regardless of whether the answer exists -in the C<options> array. +new answer will be requested, regardless of whether the answer would +normally be accepted by the usual checks. If the return value is C<undef>, then the answer will be subject to the normal checks: if there is an C<options> array and the answer is |
From: <ra...@cv...> - 2006-04-19 08:43:21
|
Author: randys Date: Wed Apr 19 01:42:17 2006 New Revision: 5931 Modified: Module-Build/trunk/Build.PL Module-Build/trunk/Changes Module-Build/trunk/lib/Module/Build/API.pod Module-Build/trunk/lib/Module/Build/Base.pm Module-Build/trunk/t/extend.t Log: Initial implementation of the ask() method. Modified: Module-Build/trunk/Build.PL ============================================================================== --- Module-Build/trunk/Build.PL (original) +++ Module-Build/trunk/Build.PL Wed Apr 19 01:42:17 2006 @@ -33,6 +33,7 @@ 'ExtUtils::Mkbootstrap' => 0, 'IO::File' => 0, 'Cwd' => 0, + 'Text::Abbrev' => 0, 'Text::ParseWords' => 0, 'Getopt::Long' => 0, 'Test::Harness' => 0, Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Wed Apr 19 01:42:17 2006 @@ -2,6 +2,12 @@ 0.27_11 + - Add new method ask(), that's intended to provide a better tool for + authors to query users when performing a build. It provides better + support for unattended builds as well as providing better + validation of input. This new method is preferred over prompt() and + y_n(). + - When searching for '.modulebuildrc', return the first HOME-like directory that actually contains the file instead of the first existing directory. Document the search locations and the order Modified: Module-Build/trunk/lib/Module/Build/API.pod ============================================================================== --- Module-Build/trunk/lib/Module/Build/API.pod (original) +++ Module-Build/trunk/lib/Module/Build/API.pod Wed Apr 19 01:42:17 2006 @@ -819,6 +819,115 @@ the second argument is assigned to the args hash under the key passed as the first argument. +=item ask() + +[version 0.28] + +Asks the user a question and returns the answer as a string. + +The following is a list of arguments. Only C<prompt> and C<default> +are required. + +=over + +=item allow_nonoption_default + +Normally, if an C<options> array is present, then the value of the +C<default> argument must exist in C<options>. Setting +C<allow_nonoption_default> to true allows the C<default> argument to +be set to an arbitrary value. + +Default is false. + +=item default [required] + +This is the default value that will be used if the user presses +E<lt>enterE<gt> or if running an unattended build. + +The value assigned to C<default> may be different from the options +listed in the C<options> argument. + +=item getopts_name + +The name of a command line option. If an option with this name is +given on the command line, the value of the option will be used as the +answer to the prompt. + +=item on_validate + +This is a code reference that can be used to validate or modify the +answer entered by the user. The value the user enters will be passed +in as the first argument, and it will also be stored in C<$_> +variable. Any modification to the variable C<$_> will be retained as +the new answer. + +The subroutine passed to C<on_validate> must return a value to +indicate how to proceed. + +If the return value is true, then the answer will be accepted as is, +without further testing. In particular, there will be no test to +ensure that the answer is in the C<options> array if any where given. + +If the return value is false, then the answer will be rejected and a +new answer will be requested, regardless of whether the answer exists +in the C<options> array. + +If the return value is C<undef>, then the answer will be subject to +the normal checks: if there is an C<options> array and the answer is +one of the options, it will be accepted; if it is an open-ended query +without an C<options> array, it will be accepted; otherwise it will be +rejected. + +=item options + +A reference to an array containing a list of valid options. If options +are provided, C<ask()> will not return until a valid option is +entered, or the C<default> is selected by pressing E<lt>enterE<gt> +without entering a value. Option names are case-insensitive, but the +option returned will be normalized to the form used in the argument to +C<options>. It is not necessary for the user to enter the entire +option name; C<ask()> will accept any unambiguous sequence of +characters that will match only one option. Eg. If the options are +C<qw(yes no)> it will accept any of 'y', 'ye', or 'yes' to mean +yes. The complete option name will be returned. + +If no options are provided, C<ask()> will accept any response from the +user. + +=item prompt [required] + +This string will be displayed to the user to indicate that input is +needed. It should indicate the type of input required. + +=item show_default + +A boolean value that indicates whether the default value should be +displayed as part of the prompt. If true and if the default is a +non-empty string, the default will be displayed at the end of the +prompt, after the list of options if present. It will be enclosed in +square brackets. + +Default is true. + +=item show_options + +A boolean value that indicates whether the list of options should be +displayed as part of the prompt. If true and if C<options> contains a +non-empty array, the list of options will be displayed at the end of +the prompt, and before the C<default> value if it is shown. The +options will be separated by slashes and enclosed in parenthesis. + +Default is true. + +=back + +If C<ask()> detects that it is not running interactively and there +is nothing on STDIN or if the PERL_MM_USE_DEFAULT environment variable +is set to true, the C<default> will be used without prompting. This +prevents automated processes from blocking on user input. + +This method may be called as a class or object method. + =item autosplit_file($from, $to) [version 0.28] Modified: Module-Build/trunk/lib/Module/Build/Base.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build/Base.pm (original) +++ Module-Build/trunk/lib/Module/Build/Base.pm Wed Apr 19 01:42:17 2006 @@ -473,13 +473,13 @@ sub _readline { my $self = shift; - my $ans; + my $answer; if ( !$self->_is_unattended ) { - $ans = <STDIN>; - chomp $ans if defined $ans; + $answer = <STDIN>; + chomp $answer if defined $answer; } - return $ans; + return $answer; } sub prompt { @@ -530,6 +530,144 @@ } } +sub ask { + my $self = shift; + my %args = @_; + + # Check argument requirements + croak("ask() called without a prompt message") unless $args{prompt}; + croak("ask() called without a default value") unless exists($args{default}); + + # Set defaults + my $show_options = exists($args{show_options}) ? $args{show_options} : 1; + my $show_default = exists($args{show_default}) ? $args{show_default} : 1; + + my $getopts_name = exists($args{getopts_name}) ? $args{getopts_name} : undef; + + my $allow_nonoption_default = exists($args{allow_nonoption_default}) + ? $args{allow_nonoption_default} : 0; + + my $on_validate = ref( $args{on_validate} ) eq 'CODE' + ? sub { + my $ans_ref = shift; + local $_ = $$ans_ref; + my $ret = $args{on_validate}->($_); + $$ans_ref = $_; + return $ret; + } + : sub { return undef }; + + + # Setup options & abbrevs + my @options = (); + my $disp_options = ''; + my %abbrev_of = (); + my %proper_case_of = (); + + if ( $args{options} && ref($args{options}) eq 'ARRAY' ) { + @options = @{$args{options}}; + if ( @options ) { + require Text::Abbrev; + %abbrev_of = Text::Abbrev::abbrev(map lc, @options); + %proper_case_of = map { lc $_, $_ } @options; + $disp_options = '(' . join('/', @options) . ')'; + } + } + + # Validate the default + my $default; + if ( $allow_nonoption_default || + !$args{options} || + grep( {$_ eq $args{default}} @options ) ) + { + $default = $args{default}; + } else { + croak("The 'default' argument must exist in 'options' array."); + } + + my $disp_default = '[' . $proper_case_of{$abbrev_of{lc $default}} . ']' + if $default && exists($abbrev_of{lc $default}); + + # Format prompt + my $prompt = $args{prompt}; + + # if $prompt ends in new-line, don't insert inital space + my $space = sub { (substr($_[0], -1) eq "\n") ? '' : ' ' }; + + $prompt .= $space->($prompt) . $disp_options + if $disp_options && $show_options; + + $prompt .= $space->($prompt) . $disp_default + if $disp_default && $show_default; + + $prompt .= $space->($prompt); + + + local $|=1; + + # Guess + if ( $getopts_name && ref($self) ) { + + my %cmdline_args = $self->args; + if ( exists( $cmdline_args{$getopts_name} ) ) { + + my $answer = $cmdline_args{$getopts_name} || ''; + print $args{prompt} . $space->($args{prompt}) . "$answer\n"; + + $answer = $proper_case_of{$abbrev_of{lc $answer}} + if exists($abbrev_of{lc $answer}); + + my $is_valid = $on_validate->(\$answer); + if ( $is_valid ) { + return $answer; + } elsif ( defined( $is_valid ) ) { + # defined, but false return: do not continue other checks + } elsif ( @options ) { + if ( exists($abbrev_of{lc $answer}) || $answer eq $default ) { + return $answer; + } else { + warn "Invalid option '$getopts_name=$answer'\n\n"; + } + } else { + return $answer; + } + } + } + + # Get answer + my $answer; + my $needs_answer = 1; + while ( $needs_answer ) { + print $prompt; + $answer = $self->_readline(); + + if ( !defined($answer) || !length($answer) ) { # Ctrl-D || Default + print "$default\n"; + $answer = $default; + $needs_answer = 0; + + } else { + $answer = $proper_case_of{$abbrev_of{lc $answer}} + if exists($abbrev_of{lc $answer}); + + my $is_valid = $on_validate->(\$answer); + if ( $is_valid ) { + $needs_answer = 0; + } elsif ( defined( $is_valid ) ) { + # defined, but false return: do not continue other checks + } elsif ( @options ) { + if ( exists($abbrev_of{lc $answer}) || $answer eq $default ) { + $needs_answer = 0; + } + } else { + $needs_answer = 0; + } + } + } + + return $answer; +} + sub current_action { shift->{action} } sub invoked_action { shift->{invoked_action} } Modified: Module-Build/trunk/t/extend.t ============================================================================== --- Module-Build/trunk/t/extend.t (original) +++ Module-Build/trunk/t/extend.t Wed Apr 19 01:42:17 2006 @@ -2,7 +2,7 @@ use strict; use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib'; -use MBTest tests => 64; +use MBTest tests => 82; use Cwd (); my $cwd = Cwd::cwd; @@ -211,7 +211,7 @@ local $ENV{PERL_MM_USE_DEFAULT}; local $^W = 0; - *{Module::Build::_readline} = sub { 'y' }; + local *{Module::Build::_readline} = sub { 'y' }; ok my $mb = Module::Build->new( module_name => $dist->name, @@ -262,6 +262,104 @@ ok $ans, " y_n() with a default"; } +{ + # Test interactive prompting + + my $ans; + local $ENV{PERL_MM_USE_DEFAULT}; + + local $^W = 0; + local *{Module::Build::_readline} = sub { 'y' }; + + ok my $mb = Module::Build->new( + module_name => $dist->name, + license => 'perl', + args => {login => 'randys', + boolean => 'yes'}, + ); + + eval{ $mb->ask() }; + like $@, qr/called without a prompt/, 'ask() requires a prompt'; + + eval{ $mb->ask(prompt => 'prompt?') }; + like $@, qr/called without a default/, 'ask() requires a default'; + + eval{ $mb->ask(prompt => 'prompt?', default => 'y') }; + print "\n"; + is $@, '', 'default not required in options when options is undefined'; + + eval{ $mb->ask(prompt => 'prompt?', default => 'y', + options => [qw(a b c)]) }; + like $@, qr/'default' argument must exist in 'options' array/, + 'default must exist in options when options is non-empty'; + + eval{ $mb->ask(prompt => 'prompt?', + default => 'y', + allow_nonoption_default => 1) }; + print "\n"; + is $@, '', 'open ended query'; + + eval{ $mb->ask(prompt => 'prompt?', + default => 'y', + options => [qw(a b c)], + allow_nonoption_default => 1) }; + print "\n"; + is $@, '', 'multi-choice with nonoption default'; + + eval{ $mb->ask(prompt => 'prompt?', + default => 'y', + options => [qw(a b c y)] ) }; + print "\n"; + is $@, '', 'multi-choice with option default'; + + undef( $ans ); + eval{ $ans = $mb->ask(prompt => 'login?', + default => 'guest', + getopts_name => 'login', + allow_nonoption_default => 1) }; + print "\n"; + is $@, ''; + is $ans, 'randys', 'get answer from command line option'; + + undef( $ans ); + eval{ $ans = $mb->ask(prompt => 'prompt?', + default => 'yes', + options => [qw(yes no)], + getopts_name => 'boolean' ) }; + print "\n"; + is $@, ''; + is $ans, 'yes', 'get answer from command line option'; + + undef( $ans ); + eval{ $ans = $mb->ask(prompt => 'prompt?', + default => 'yes', + options => [qw(yes no)], + on_validate => sub { s/yes/true/; 1 } ) }; + print "\n"; + is $@, ''; + is $ans, 'true', 'change/validate answer'; + + + + *{Module::Build::_readline} = sub { undef }; + undef( $ans ); + eval{ $ans = $mb->ask(prompt => 'prompt?', + default => 'y', + options => [qw(y n)] ) }; + print "\n"; + is $@, ''; + is $ans, 'y', '<ctrl-d> - default answer'; + + *{Module::Build::_readline} = sub { '' }; + undef( $ans ); + eval{ $ans = $mb->ask(prompt => 'prompt?', + default => 'y', + options => [qw(y n)] ) }; + print "\n"; + is $@, ''; + is $ans, 'y', '<enter> - default answer'; +} + # cleanup chdir( $cwd ) or die "Can''t chdir to '$cwd': $!"; $dist->remove; |