1 package ExtUtils::Constant::Utils;
4 use vars qw($VERSION @EXPORT_OK @ISA $is_perl56);
8 @EXPORT_OK = qw(C_stringify perl_stringify);
11 $is_perl56 = ($] < 5.007 && $] > 5.005_50);
15 ExtUtils::Constant::Utils - helper functions for ExtUtils::Constant
19 use ExtUtils::Constant::Utils qw (C_stringify);
20 $C_code = C_stringify $stuff;
24 ExtUtils::Constant::Utils packages up utility subroutines used by
25 ExtUtils::Constant, ExtUtils::Constant::Base and derived classes. All its
26 functions are explicitly exportable.
32 =item C_stringify NAME
34 A function which returns a 7 bit ASCII correctly \ escaped version of the
35 string passed suitable for C's "" or ''. It will die if passed Unicode
40 # Hopefully make a happy C identifier.
43 return unless defined $_;
45 confess "Wide character in '$_' intended as a C identifier"
46 if tr/\0-\377// != length;
47 # grr 5.6.1 moreso because its regexps will break on data that happens to
48 # be utf8, which includes my 8 bit test cases.
49 $_ = pack 'C*', unpack 'U*', $_ . pack 'U*' if $is_perl56;
51 s/([\"\'])/\\$1/g; # Grr. fix perl mode.
52 s/\n/\\n/g; # Ensure newlines don't end up in octal
57 if (ord('A') == 193) { # EBCDIC has no ^\0-\177 workalike.
58 s/([[:^print:]])/sprintf "\\x{%X}", ord $1/ge;
60 s/([^\0-\177])/sprintf "\\%03o", ord $1/ge;
63 # This will elicit a warning on 5.005_03 about [: :] being reserved unless
65 my $cheat = '([[:^print:]])';
66 s/$cheat/sprintf "\\%03o", ord $1/ge;
69 s/([^A-Za-z0-9_])/POSIX::isprint($1) ? $1 : sprintf "\\%03o", ord $1/ge;
74 =item perl_stringify NAME
76 A function which returns a 7 bit ASCII correctly \ escaped version of the
77 string passed suitable for a perl "" string.
81 # Hopefully make a happy perl identifier.
84 return unless defined $_;
86 s/([\"\'])/\\$1/g; # Grr. fix perl mode.
87 s/\n/\\n/g; # Ensure newlines don't end up in octal
94 if (ord('A') == 193) { # EBCDIC has no ^\0-\177 workalike.
95 s/([[:^print:]])/sprintf "\\x{%X}", ord $1/ge;
97 s/([^\0-\177])/sprintf "\\x{%X}", ord $1/ge;
100 # Grr 5.6.1. And I don't think I can use utf8; to force the regexp
101 # because 5.005_03 will fail.
102 # This is grim, but I also can't split on //
104 foreach my $index (0 .. length ($_) - 1) {
105 my $char = substr ($_, $index, 1);
106 $copy .= ($char le "\177") ? $char : sprintf "\\x{%X}", ord $char;
110 # This will elicit a warning on 5.005_03 about [: :] being reserved unless
112 my $cheat = '([[:^print:]])';
113 s/$cheat/sprintf "\\%03o", ord $1/ge;
115 # Turns out "\x{}" notation only arrived with 5.6
116 s/([^\0-\177])/sprintf "\\x%02X", ord $1/ge;
118 s/([^A-Za-z0-9_])/POSIX::isprint($1) ? $1 : sprintf "\\%03o", ord $1/ge;
130 Nicholas Clark <nick@ccl4.org> based on the code in C<h2xs> by Larry Wall and