File Coverage

blib/lib/ExtUtils/PL2Bat.pm
Criterion Covered Total %
statement 24 68 35.2
branch 1 34 2.9
condition 0 9 0.0
subroutine 7 8 87.5
pod 1 1 100.0
total 33 120 27.5


line stmt bran cond sub pod time code
1             package ExtUtils::PL2Bat;
2             $ExtUtils::PL2Bat::VERSION = '0.005';
3 1     1   63827 use strict;
  1         9  
  1         26  
4 1     1   5 use warnings;
  1         2  
  1         30  
5              
6 1     1   20 use 5.006;
  1         3  
7              
8 1     1   5 use Config;
  1         1  
  1         51  
9 1     1   5 use Carp qw/croak/;
  1         2  
  1         84  
10              
11             # In core, we can't use any other modules except those that already live in
12             # lib/, so Exporter is not available to us.
13             sub import {
14 1     1   8 my ($self, @functions) = @_;
15 1 50       4 @functions = 'pl2bat' if not @functions;
16 1         2 my $caller = caller;
17 1         3 for my $function (@functions) {
18 1     1   6 no strict 'refs';
  1         2  
  1         639  
19 1         1 *{"$caller\::$function"} = \&{$function};
  1         27  
  1         2  
20             }
21             }
22              
23             sub pl2bat {
24 0     0 1   my %opts = @_;
25              
26             # NOTE: %0 is already enclosed in doublequotes by cmd.exe, as appropriate
27 0 0         $opts{ntargs} = '-x -S %0 %*' unless exists $opts{ntargs};
28 0 0         $opts{otherargs} = '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists $opts{otherargs};
29              
30 0 0         $opts{stripsuffix} = qr/\.plx?/ unless exists $opts{stripsuffix};
31              
32 0 0         if (not exists $opts{out}) {
33 0           $opts{out} = $opts{in};
34 0           $opts{out} =~ s/$opts{stripsuffix}$//i;
35 0 0 0       $opts{out} .= '.bat' unless $opts{in} =~ /\.bat$/i or $opts{in} eq '-';
36             }
37              
38 0           my $head = <<"EOT";
39             \@rem = '--*-Perl-*--
40             \@set "ErrorLevel="
41             \@if "%OS%" == "Windows_NT" \@goto WinNT
42             \@perl $opts{otherargs}
43             \@set ErrorLevel=%ErrorLevel%
44             \@goto endofperl
45             :WinNT
46             \@perl $opts{ntargs}
47             \@set ErrorLevel=%ErrorLevel%
48             \@if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" \@goto endofperl
49             \@if %ErrorLevel% == 9009 \@echo You do not have Perl in your PATH.
50             \@goto endofperl
51             \@rem ';
52             EOT
53              
54 0           $head =~ s/^\s+//gm;
55 0           my $headlines = 2 + ($head =~ tr/\n/\n/);
56 0           my $tail = <<'EOT';
57             __END__
58             :endofperl
59             @set "ErrorLevel=" & @goto _undefined_label_ 2>NUL || @"%COMSPEC%" /d/c @exit %ErrorLevel%
60             EOT
61 0           $tail =~ s/^\s+//gm;
62              
63 0           my $linedone = 0;
64 0           my $taildone = 0;
65 0           my $linenum = 0;
66 0           my $skiplines = 0;
67              
68 0           my $start = $Config{startperl};
69 0 0         $start = '#!perl' unless $start =~ /^#!.*perl/;
70              
71 0 0         open my $in, '<', $opts{in} or croak "Can't open $opts{in}: $!";
72 0           my @file = <$in>;
73 0           close $in;
74              
75 0           foreach my $line ( @file ) {
76 0           $linenum++;
77 0 0         if ( $line =~ /^:endofperl\b/ ) {
78 0 0         if (!exists $opts{update}) {
79 0           warn "$opts{in} has already been converted to a batch file!\n";
80 0           return;
81             }
82 0           $taildone++;
83             }
84 0 0 0       if ( not $linedone and $line =~ /^#!.*perl/ ) {
85 0 0         if (exists $opts{update}) {
86 0           $skiplines = $linenum - 1;
87 0           $line .= '#line '.(1+$headlines)."\n";
88             } else {
89 0           $line .= '#line '.($linenum+$headlines)."\n";
90             }
91 0           $linedone++;
92             }
93 0 0 0       if ( $line =~ /^#\s*line\b/ and $linenum == 2 + $skiplines ) {
94 0           $line = '';
95             }
96             }
97              
98 0 0         open my $out, '>', $opts{out} or croak "Can't open $opts{out}: $!";
99 0           print $out $head;
100 0 0         print $out $start, ( $opts{usewarnings} ? ' -w' : '' ),
    0          
101             "\n#line ", ($headlines+1), "\n" unless $linedone;
102 0           print $out @file[$skiplines..$#file];
103 0 0         print $out $tail unless $taildone;
104 0           close $out;
105              
106 0           return $opts{out};
107             }
108              
109             1;
110              
111             # ABSTRACT: Batch file creation to run perl scripts on Windows
112              
113             __END__