1package ExtUtils::Typemaps::OutputMap; 2use 5.006001; 3use strict; 4use warnings; 5our $VERSION = '3.51'; 6 7=head1 NAME 8 9ExtUtils::Typemaps::OutputMap - Entry in the OUTPUT section of a typemap 10 11=head1 SYNOPSIS 12 13 use ExtUtils::Typemaps; 14 ... 15 my $output = $typemap->get_output_map('T_NV'); 16 my $code = $output->code(); 17 $output->code("..."); 18 19=head1 DESCRIPTION 20 21Refer to L<ExtUtils::Typemaps> for details. 22 23=head1 METHODS 24 25=cut 26 27=head2 new 28 29Requires C<xstype> and C<code> parameters. 30 31=cut 32 33sub new { 34 my $prot = shift; 35 my $class = ref($prot)||$prot; 36 my %args = @_; 37 38 if (!ref($prot)) { 39 if (not defined $args{xstype} or not defined $args{code}) { 40 die("Need xstype and code parameters"); 41 } 42 } 43 44 my $self = bless( 45 (ref($prot) ? {%$prot} : {}) 46 => $class 47 ); 48 49 $self->{xstype} = $args{xstype} if defined $args{xstype}; 50 $self->{code} = $args{code} if defined $args{code}; 51 $self->{code} =~ s/^(?=\S)/\t/mg; 52 53 return $self; 54} 55 56=head2 code 57 58Returns or sets the OUTPUT mapping code for this entry. 59 60=cut 61 62sub code { 63 $_[0]->{code} = $_[1] if @_ > 1; 64 return $_[0]->{code}; 65} 66 67=head2 xstype 68 69Returns the name of the XS type of the OUTPUT map. 70 71=cut 72 73sub xstype { 74 return $_[0]->{xstype}; 75} 76 77=head2 cleaned_code 78 79Returns a cleaned-up copy of the code to which certain transformations 80have been applied to make it more ANSI compliant. 81 82=cut 83 84sub cleaned_code { 85 my $self = shift; 86 my $code = $self->code; 87 88 # Move C pre-processor instructions to column 1 to be strictly ANSI 89 # conformant. Some pre-processors are fussy about this. 90 $code =~ s/^\s+#/#/mg; 91 $code =~ s/\s*\z/\n/; 92 93 return $code; 94} 95 96=head2 targetable 97 98This is an obscure but effective optimization that used to 99live in C<ExtUtils::ParseXS> directly. Not implementing it 100should never result in incorrect use of typemaps, just less 101efficient code. 102 103In a nutshell, this will check whether the output code 104involves calling C<sv_setiv>, C<sv_setuv>, C<sv_setnv>, C<sv_setpv> or 105C<sv_setpvn> to set the special C<$arg> placeholder to a new value 106B<AT THE END OF THE OUTPUT CODE>. If that is the case, the code is 107eligible for using the C<TARG>-related macros to optimize this. 108Thus the name of the method: C<targetable>. 109 110If this optimization is applicable, C<ExtUtils::ParseXS> will 111emit a C<dXSTARG;> definition at the start of the generated XSUB code, 112and type (see below) dependent code to set C<TARG> and push it on 113the stack at the end of the generated XSUB code. 114 115If the optimization can not be applied, this returns undef. 116If it can be applied, this method returns a hash reference containing 117the following information: 118 119 type: Any of the characters i, u, n, p 120 with_size: Bool indicating whether this is the sv_setpvn variant 121 what: The code that actually evaluates to the output scalar 122 what_size: If "with_size", this has the string length (as code, 123 not constant, including leading comma) 124 125=cut 126 127sub targetable { 128 my $self = shift; 129 return $self->{targetable} if exists $self->{targetable}; 130 131 our $bal; # ()-balanced 132 $bal = qr[ 133 (?: 134 (?>[^()]+) 135 | 136 \( (??{ $bal }) \) 137 )* 138 ]x; 139 my $bal_no_comma = qr[ 140 (?: 141 (?>[^(),]+) 142 | 143 \( (??{ $bal }) \) 144 )+ 145 ]x; 146 147 # matches variations on (SV*) 148 my $sv_cast = qr[ 149 (?: 150 \( \s* SV \s* \* \s* \) \s* 151 )? 152 ]x; 153 154 my $size = qr[ # Third arg (to setpvn) 155 , \s* (??{ $bal }) 156 ]xo; 157 158 my $code = $self->code; 159 160 # We can still bootstrap compile 're', because in code re.pm is 161 # available to miniperl, and does not attempt to load the XS code. 162 use re 'eval'; 163 164 my ($type, $with_size, $arg, $sarg) = 165 ($code =~ 166 m[^ 167 \s+ 168 sv_set([iunp])v(n)? # Type, is_setpvn 169 \s* 170 \( \s* 171 $sv_cast \$arg \s* , \s* 172 ( $bal_no_comma ) # Set from 173 ( $size )? # Possible sizeof set-from 174 \s* \) \s* ; \s* $ 175 ]xo 176 ); 177 178 my $rv = undef; 179 if ($type) { 180 $rv = { 181 type => $type, 182 with_size => $with_size, 183 what => $arg, 184 what_size => $sarg, 185 }; 186 } 187 $self->{targetable} = $rv; 188 return $rv; 189} 190 191=head1 SEE ALSO 192 193L<ExtUtils::Typemaps> 194 195=head1 AUTHOR 196 197Steffen Mueller C<<smueller@cpan.org>> 198 199=head1 COPYRIGHT & LICENSE 200 201Copyright 2009, 2010, 2011, 2012 Steffen Mueller 202 203This program is free software; you can redistribute it and/or 204modify it under the same terms as Perl itself. 205 206=cut 207 2081; 209 210