[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package Module::Build::Platform::Windows; 2 3 use strict; 4 use vars qw($VERSION); 5 $VERSION = '0.2808_01'; 6 $VERSION = eval $VERSION; 7 8 use Config; 9 use File::Basename; 10 use File::Spec; 11 use IO::File; 12 13 use Module::Build::Base; 14 15 use vars qw(@ISA); 16 @ISA = qw(Module::Build::Base); 17 18 19 sub manpage_separator { 20 return '.'; 21 } 22 23 sub have_forkpipe { 0 } 24 25 sub _detildefy { 26 my ($self, $value) = @_; 27 $value =~ s,^~(?= [/\\] | $ ),$ENV{HOME},x 28 if $ENV{HOME}; 29 return $value; 30 } 31 32 sub ACTION_realclean { 33 my ($self) = @_; 34 35 $self->SUPER::ACTION_realclean(); 36 37 my $basename = basename($0); 38 $basename =~ s/(?:\.bat)?$//i; 39 40 if ( $basename eq $self->build_script ) { 41 if ( $self->build_bat ) { 42 my $full_progname = $0; 43 $full_progname =~ s/(?:\.bat)?$/.bat/i; 44 45 # Vodoo required to have a batch file delete itself without error; 46 # Syntax differs between 9x & NT: the later requires a null arg (???) 47 require Win32; 48 my $null_arg = (Win32::IsWinNT()) ? '""' : ''; 49 my $cmd = qq(start $null_arg /min "\%comspec\%" /c del "$full_progname"); 50 51 my $fh = IO::File->new(">> $basename.bat") 52 or die "Can't create $basename.bat: $!"; 53 print $fh $cmd; 54 close $fh ; 55 } else { 56 $self->delete_filetree($self->build_script . '.bat'); 57 } 58 } 59 } 60 61 sub make_executable { 62 my $self = shift; 63 64 $self->SUPER::make_executable(@_); 65 66 foreach my $script (@_) { 67 68 # Native batch script 69 if ( $script =~ /\.(bat|cmd)$/ ) { 70 $self->SUPER::make_executable($script); 71 next; 72 73 # Perl script that needs to be wrapped in a batch script 74 } else { 75 my %opts = (); 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); 79 } 80 81 my $out = eval {$self->pl2bat(in => $script, update => 1, %opts)}; 82 if ( $@ ) { 83 $self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@"); 84 } else { 85 $self->SUPER::make_executable($out); 86 } 87 } 88 } 89 } 90 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 95 sub pl2bat { 96 my $self = shift; 97 my %opts = @_; 98 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}; 102 103 $opts{stripsuffix} = '/\\.plx?/' unless exists $opts{stripsuffix}; 104 $opts{stripsuffix} = ($opts{stripsuffix} =~ m{^/([^/]*[^/\$]|)\$?/?$} ? $1 : "\Q$opts{stripsuffix}\E"); 105 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} =~ /^-$/; 110 } 111 112 my $head = <<EOT; 113 \@rem = '--*-Perl-*-- 114 \@echo off 115 if "%OS%" == "Windows_NT" goto WinNT 116 perl $opts{otherargs} 117 goto endofperl 118 :WinNT 119 perl $opts{ntargs} 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 123 goto endofperl 124 \@rem '; 125 EOT 126 127 $head =~ s/^\s+//gm; 128 my $headlines = 2 + ($head =~ tr/\n/\n/); 129 my $tail = "\n__END__\n:endofperl\n"; 130 131 my $linedone = 0; 132 my $taildone = 0; 133 my $linenum = 0; 134 my $skiplines = 0; 135 136 my $start = $Config{startperl}; 137 $start = "#!perl" unless $start =~ /^#!.*perl/; 138 139 my $in = IO::File->new("< $opts{in}") or die "Can't open $opts{in}: $!"; 140 my @file = <$in>; 141 $in->close; 142 143 foreach my $line ( @file ) { 144 $linenum++; 145 if ( $line =~ /^:endofperl\b/ ) { 146 if (!exists $opts{update}) { 147 warn "$opts{in} has already been converted to a batch file!\n"; 148 return; 149 } 150 $taildone++; 151 } 152 if ( not $linedone and $line =~ /^#!.*perl/ ) { 153 if (exists $opts{update}) { 154 $skiplines = $linenum - 1; 155 $line .= "#line ".(1+$headlines)."\n"; 156 } else { 157 $line .= "#line ".($linenum+$headlines)."\n"; 158 } 159 $linedone++; 160 } 161 if ( $line =~ /^#\s*line\b/ and $linenum == 2 + $skiplines ) { 162 $line = ""; 163 } 164 } 165 166 my $out = IO::File->new("> $opts{out}") or die "Can't open $opts{out}: $!"; 167 print $out $head; 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; 172 $out->close; 173 174 return $opts{out}; 175 } 176 177 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. 186 187 (my $self, local $_) = @_; 188 189 return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY'); 190 191 my @argv; 192 return @argv unless defined() && length(); 193 194 my $arg = ''; 195 my( $i, $quote_mode ) = ( 0, 0 ); 196 197 while ( $i < length() ) { 198 199 my $ch = substr( $_, $i , 1 ); 200 my $next_ch = substr( $_, $i+1, 1 ); 201 202 if ( $ch eq '\\' && $next_ch eq '"' ) { 203 $arg .= '"'; 204 $i++; 205 } elsif ( $ch eq '\\' && $next_ch eq '\\' ) { 206 $arg .= '\\'; 207 $i++; 208 } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) { 209 $quote_mode = !$quote_mode; 210 $arg .= '"'; 211 $i++; 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' ] 216 push( @argv, $arg ); 217 $arg = ''; 218 $i += 2; 219 } elsif ( $ch eq '"' ) { 220 $quote_mode = !$quote_mode; 221 } elsif ( $ch eq ' ' && !$quote_mode ) { 222 push( @argv, $arg ) if $arg; 223 $arg = ''; 224 ++$i while substr( $_, $i + 1, 1 ) eq ' '; 225 } else { 226 $arg .= $ch; 227 } 228 229 $i++; 230 } 231 232 push( @argv, $arg ) if defined( $arg ) && length( $arg ); 233 return @argv; 234 } 235 236 1; 237 238 __END__ 239 240 =head1 NAME 241 242 Module::Build::Platform::Windows - Builder class for Windows platforms 243 244 =head1 DESCRIPTION 245 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. 249 250 =head1 AUTHOR 251 252 Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org> 253 254 =head1 SEE ALSO 255 256 perl(1), Module::Build(3) 257 258 =cut
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |