1 package Module::Build::Platform::Windows;
5 $VERSION = '0.2808_01';
6 $VERSION = eval $VERSION;
13 use Module::Build::Base;
16 @ISA = qw(Module::Build::Base);
19 sub manpage_separator {
23 sub have_forkpipe { 0 }
26 my ($self, $value) = @_;
27 $value =~ s,^~(?= [/\\] | $ ),$ENV{HOME},x
32 sub ACTION_realclean {
35 $self->SUPER::ACTION_realclean();
37 my $basename = basename($0);
38 $basename =~ s/(?:\.bat)?$//i;
40 if ( $basename eq $self->build_script ) {
41 if ( $self->build_bat ) {
42 my $full_progname = $0;
43 $full_progname =~ s/(?:\.bat)?$/.bat/i;
45 # Vodoo required to have a batch file delete itself without error;
46 # Syntax differs between 9x & NT: the later requires a null arg (???)
48 my $null_arg = (Win32::IsWinNT()) ? '""' : '';
49 my $cmd = qq(start $null_arg /min "\%comspec\%" /c del "$full_progname");
51 my $fh = IO::File->new(">> $basename.bat")
52 or die "Can't create $basename.bat: $!";
56 $self->delete_filetree($self->build_script . '.bat');
64 $self->SUPER::make_executable(@_);
66 foreach my $script (@_) {
69 if ( $script =~ /\.(bat|cmd)$/ ) {
70 $self->SUPER::make_executable($script);
73 # Perl script that needs to be wrapped in a batch script
76 if ( $script eq $self->build_script ) {
77 $opts{ntargs} = q(-x -S %0 --build_bat %*);
78 $opts{otherargs} = q(-x -S "%0" --build_bat %1 %2 %3 %4 %5 %6 %7 %8 %9);
81 my $out = eval {$self->pl2bat(in => $script, update => 1, %opts)};
83 $self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@");
85 $self->SUPER::make_executable($out);
91 # This routine was copied almost verbatim from the 'pl2bat' utility
92 # distributed with perl. It requires too much vodoo with shell quoting
93 # differences and shortcomings between the various flavors of Windows
94 # to reliably shell out
99 # NOTE: %0 is already enclosed in doublequotes by cmd.exe, as appropriate
100 $opts{ntargs} = '-x -S %0 %*' unless exists $opts{ntargs};
101 $opts{otherargs} = '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists $opts{otherargs};
103 $opts{stripsuffix} = '/\\.plx?/' unless exists $opts{stripsuffix};
104 $opts{stripsuffix} = ($opts{stripsuffix} =~ m{^/([^/]*[^/\$]|)\$?/?$} ? $1 : "\Q$opts{stripsuffix}\E");
106 unless (exists $opts{out}) {
107 $opts{out} = $opts{in};
108 $opts{out} =~ s/$opts{stripsuffix}$//oi;
109 $opts{out} .= '.bat' unless $opts{in} =~ /\.bat$/i or $opts{in} =~ /^-$/;
113 \@rem = '--*-Perl-*--
115 if "%OS%" == "Windows_NT" goto WinNT
116 perl $opts{otherargs}
120 if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" goto endofperl
121 if %errorlevel% == 9009 echo You do not have Perl in your PATH.
122 if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
128 my $headlines = 2 + ($head =~ tr/\n/\n/);
129 my $tail = "\n__END__\n:endofperl\n";
136 my $start = $Config{startperl};
137 $start = "#!perl" unless $start =~ /^#!.*perl/;
139 my $in = IO::File->new("< $opts{in}") or die "Can't open $opts{in}: $!";
143 foreach my $line ( @file ) {
145 if ( $line =~ /^:endofperl\b/ ) {
146 if (!exists $opts{update}) {
147 warn "$opts{in} has already been converted to a batch file!\n";
152 if ( not $linedone and $line =~ /^#!.*perl/ ) {
153 if (exists $opts{update}) {
154 $skiplines = $linenum - 1;
155 $line .= "#line ".(1+$headlines)."\n";
157 $line .= "#line ".($linenum+$headlines)."\n";
161 if ( $line =~ /^#\s*line\b/ and $linenum == 2 + $skiplines ) {
166 my $out = IO::File->new("> $opts{out}") or die "Can't open $opts{out}: $!";
168 print $out $start, ( $opts{usewarnings} ? " -w" : "" ),
169 "\n#line ", ($headlines+1), "\n" unless $linedone;
170 print $out @file[$skiplines..$#file];
171 print $out $tail unless $taildone;
178 sub split_like_shell {
179 # As it turns out, Windows command-parsing is very different from
180 # Unix command-parsing. Double-quotes mean different things,
181 # backslashes don't necessarily mean escapes, and so on. So we
182 # can't use Text::ParseWords::shellwords() to break a command string
183 # into words. The algorithm below was bashed out by Randy and Ken
184 # (mostly Randy), and there are a lot of regression tests, so we
185 # should feel free to adjust if desired.
187 (my $self, local $_) = @_;
189 return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
192 return @argv unless defined() && length();
195 my( $i, $quote_mode ) = ( 0, 0 );
197 while ( $i < length() ) {
199 my $ch = substr( $_, $i , 1 );
200 my $next_ch = substr( $_, $i+1, 1 );
202 if ( $ch eq '\\' && $next_ch eq '"' ) {
205 } elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
208 } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
209 $quote_mode = !$quote_mode;
212 } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
213 ( $i + 2 == length() ||
214 substr( $_, $i + 2, 1 ) eq ' ' )
215 ) { # for cases like: a"" => [ 'a' ]
219 } elsif ( $ch eq '"' ) {
220 $quote_mode = !$quote_mode;
221 } elsif ( $ch eq ' ' && !$quote_mode ) {
222 push( @argv, $arg ) if $arg;
224 ++$i while substr( $_, $i + 1, 1 ) eq ' ';
232 push( @argv, $arg ) if defined( $arg ) && length( $arg );
242 Module::Build::Platform::Windows - Builder class for Windows platforms
246 The sole purpose of this module is to inherit from
247 C<Module::Build::Base> and override a few methods. Please see
248 L<Module::Build> for the docs.
252 Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
256 perl(1), Module::Build(3)