The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

UXYZAB / DBD-Mock-Session-GenerateFixtures-0.10 / local / lib / perl5 / ExtUtils / Helpers / Windows.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
—
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125

              
package ExtUtils::Helpers::Windows;
$ExtUtils::Helpers::Windows::VERSION = '0.028';
use strict;
use warnings FATAL => 'all';
use Exporter 5.57 'import';
our @EXPORT = qw/make_executable split_like_shell detildefy/;
use Config;
use Carp qw/carp croak/;
use ExtUtils::PL2Bat 'pl2bat';
sub make_executable {
        my $script = shift;
        if (-T $script && $script !~ / \. (?:bat|cmd) $ /x) {
                pl2bat(in => $script, update => 1);
        }
        return;
}
sub split_like_shell {
        # As it turns out, Windows command-parsing is very different from
        # Unix command-parsing. Double-quotes mean different things,
        # backslashes don't necessarily mean escapes, and so on.        So we
        # can't use Text::ParseWords::shellwords() to break a command string
        # into words.   The algorithm below was bashed out by Randy and Ken
        # (mostly Randy), and there are a lot of regression tests, so we
        # should feel free to adjust if desired.
        local ($_) = @_;
        my @argv;
        return @argv unless defined && length;
        my $arg = '';
        my ($i, $quote_mode ) = ( 0, 0 );
        while ( $i < length ) {
                my $ch      = substr $_, $i, 1;
                my $next_ch = substr $_, $i+1, 1;
                if ( $ch eq '\\' && $next_ch eq '"' ) {
                        $arg .= '"';
                        $i++;
                } elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
                        $arg .= '\\';
                        $i++;
                } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
                        $quote_mode = !$quote_mode;
                        $arg .= '"';
                        $i++;
                } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
                                ( $i + 2 == length() || substr( $_, $i + 2, 1 ) eq ' ' )
                        ) { # for cases like: a"" => [ 'a' ]
                        push @argv, $arg;
                        $arg = '';
                        $i += 2;
                } elsif ( $ch eq '"' ) {
                        $quote_mode = !$quote_mode;
                } elsif ( $ch =~ /\s/ && !$quote_mode ) {
                        push @argv, $arg if $arg;
                        $arg = '';
                        ++$i while substr( $_, $i + 1, 1 ) =~ /\s/;
                } else {
                        $arg .= $ch;
                }
                $i++;
        }
        push @argv, $arg if defined $arg && length $arg;
        return @argv;
}
sub detildefy {
        my $value = shift;
        $value =~ s{ ^ ~ (?= [/\\] | $ ) }[$ENV{USERPROFILE}]x if $ENV{USERPROFILE};
        return $value;
}
1;
# ABSTRACT: Windows specific helper bits
__END__
=pod
=encoding UTF-8
=head1 NAME
ExtUtils::Helpers::Windows - Windows specific helper bits
=head1 VERSION
version 0.028
=for Pod::Coverage make_executable
split_like_shell
detildefy
=head1 AUTHORS
=over 4
=item *
Ken Williams <kwilliams@cpan.org>
=item *
Leon Timmermans <leont@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut