File Coverage

lib/ExtUtils/Typemaps/STL/Vector.pm
Criterion Covered Total %
statement 35 35 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod 1 1 100.0
total 40 40 100.0


line stmt bran cond sub pod time code
1             package ExtUtils::Typemaps::STL::Vector;
2              
3 1     1   1026 use strict;
  1         3  
  1         35  
4 1     1   6 use warnings;
  1         1  
  1         30  
5 1     1   5 use ExtUtils::Typemaps;
  1         2  
  1         440  
6              
7             our $VERSION = '1.05';
8              
9             our @ISA = qw(ExtUtils::Typemaps);
10              
11             =head1 NAME
12              
13             ExtUtils::Typemaps::STL::Vector - A set of typemaps for STL std::vectors
14              
15             =head1 SYNOPSIS
16              
17             use ExtUtils::Typemaps::STL::Vector;
18             # First, read my own type maps:
19             my $private_map = ExtUtils::Typemaps->new(file => 'my.map');
20            
21             # Then, get the object map set and merge it into my maps
22             $private_map->merge(typemap => ExtUtils::Typemaps::STL::Vector->new);
23            
24             # Now, write the combined map to an output file
25             $private_map->write(file => 'typemap');
26              
27             =head1 DESCRIPTION
28              
29             C is an C
30             subclass that provides a set of mappings for C++ STL vectors.
31             These are:
32              
33             TYPEMAP
34             std::vector T_STD_VECTOR_DOUBLE
35             std::vector* T_STD_VECTOR_DOUBLE_PTR
36            
37             std::vector T_STD_VECTOR_INT
38             std::vector* T_STD_VECTOR_INT_PTR
39            
40             std::vector T_STD_VECTOR_UINT
41             std::vector* T_STD_VECTOR_UINT_PTR
42            
43             std::vector T_STD_VECTOR_STD_STRING
44             std::vector* T_STD_VECTOR_STD_STRING_PTR
45            
46             std::vector T_STD_VECTOR_CSTRING
47             std::vector* T_STD_VECTOR_CSTRING_PTR
48              
49             All of these mean that the vectors are converted to references
50             to Perl arrays and vice versa.
51              
52             =head1 METHODS
53              
54             These are the overridden methods:
55              
56             =head2 new
57              
58             Creates a new C object.
59             It acts as any other C object, except that
60             it has the vector type maps initialized.
61              
62             =cut
63              
64             sub new {
65 3     3 1 981 my $class = shift;
66              
67 3         20 my $self = $class->SUPER::new(@_);
68 3         72 my $input_tmpl = <<'HERE';
69             !TYPENAME!
70             if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
71             AV* av = (AV*)SvRV($arg);
72             const unsigned int len = av_len(av)+1;
73             $var = std::vector(len);
74             SV** elem;
75             for (unsigned int i = 0; i < len; i++) {
76             elem = av_fetch(av, i, 0);
77             if (elem != NULL)
78             ${var}[i] = Sv!SHORTTYPE!V(*elem);
79             else
80             ${var}[i] = !DEFAULT!;
81             }
82             }
83             else
84             Perl_croak(aTHX_ \"%s: %s is not an array reference\",
85             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
86             \"$var\");
87              
88             !TYPENAME!_PTR
89             if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
90             AV* av = (AV*)SvRV($arg);
91             const unsigned int len = av_len(av)+1;
92             $var = new std::vector(len);
93             SV** elem;
94             for (unsigned int i = 0; i < len; i++) {
95             elem = av_fetch(av, i, 0);
96             if (elem != NULL)
97             (*$var)[i] = Sv!SHORTTYPE!V(*elem);
98             else
99             (*$var)[i] = 0.;
100             }
101             }
102             else
103             Perl_croak(aTHX_ \"%s: %s is not an array reference\",
104             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
105             \"$var\");
106              
107             HERE
108              
109 3         7 my $output_tmpl = <<'HERE';
110             !TYPENAME!
111             AV* av = newAV();
112             $arg = newRV_noinc((SV*)av);
113             const unsigned int len = $var.size();
114             if (len)
115             av_extend(av, len-1);
116             for (unsigned int i = 0; i < len; i++) {
117             av_store(av, i, newSV!SHORTTYPELC!v(${var}[i]));
118             }
119              
120             !TYPENAME!_PTR
121             AV* av = newAV();
122             $arg = newRV_noinc((SV*)av);
123             const unsigned int len = $var->size();
124             if (len)
125             av_extend(av, len-1);
126             for (unsigned int i = 0; i < len; i++) {
127             av_store(av, i, newSV!SHORTTYPELC!v((*$var)[i]));
128             }
129              
130             HERE
131              
132 3         6 my ($output_code, $input_code);
133             # TYPENAME, TYPE, SHORTTYPE, SHORTTYPELC, DEFAULT
134 3         29 foreach my $type ([qw(T_STD_VECTOR_DOUBLE double N n 0.)],
135             [qw(T_STD_VECTOR_INT int I i 0)],
136             [qw(T_STD_VECTOR_UINT), "unsigned int", qw(U u 0)])
137             {
138 9         25 my @type = @$type;
139 9         14 my $otmpl = $output_tmpl;
140 9         26 my $itmpl = $input_tmpl;
141              
142 9         16 for ($otmpl, $itmpl) {
143 18         154 s/!TYPENAME!/$type[0]/g;
144 18         79 s/!TYPE!/$type[1]/g;
145 18         72 s/!SHORTTYPE!/$type[2]/g;
146 18         100 s/!SHORTTYPELC!/$type[3]/g;
147 18         83 s/!DEFAULT!/$type[4]/g;
148             }
149              
150 9         22 $output_code .= $otmpl;
151 9         39 $input_code .= $itmpl;
152             }
153              
154             # add a static part
155 3         13 $output_code .= <<'END_OUTPUT';
156             T_STD_VECTOR_STD_STRING
157             AV* av = newAV();
158             $arg = newRV_noinc((SV*)av);
159             const unsigned int len = $var.size();
160             if (len)
161             av_extend(av, len-1);
162             for (unsigned int i = 0; i < len; i++) {
163             const std::string& str = ${var}[i];
164             STRLEN len = str.length();
165             av_store(av, i, newSVpv(str.c_str(), len));
166             }
167              
168             T_STD_VECTOR_STD_STRING_PTR
169             AV* av = newAV();
170             $arg = newRV_noinc((SV*)av);
171             const unsigned int len = $var->size();
172             if (len)
173             av_extend(av, len-1);
174             for (unsigned int i = 0; i < len; i++) {
175             const std::string& str = (*$var)[i];
176             STRLEN len = str.length();
177             av_store(av, i, newSVpv(str.c_str(), len));
178             }
179              
180             T_STD_VECTOR_CSTRING
181             AV* av = newAV();
182             $arg = newRV_noinc((SV*)av);
183             const unsigned int len = $var.size();
184             if (len)
185             av_extend(av, len-1);
186             for (unsigned int i = 0; i < len; i++) {
187             STRLEN len = strlen(${var}[i]);
188             av_store(av, i, newSVpv(${var}[i], len));
189             }
190              
191             T_STD_VECTOR_CSTRING_PTR
192             AV* av = newAV();
193             $arg = newRV_noinc((SV*)av);
194             const unsigned int len = $var->size();
195             if (len)
196             av_extend(av, len-1);
197             for (unsigned int i = 0; i < len; i++) {
198             STRLEN len = strlen((*$var)[i]);
199             av_store(av, i, newSVpv((*$var)[i], len));
200             }
201              
202             END_OUTPUT
203              
204             # add a static part to input
205 3         11 $input_code .= <<'END_INPUT';
206             T_STD_VECTOR_STD_STRING
207             if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
208             AV* av = (AV*)SvRV($arg);
209             const unsigned int alen = av_len(av)+1;
210             $var = std::vector(alen);
211             STRLEN len;
212             char* tmp;
213             SV** elem;
214             for (unsigned int i = 0; i < alen; i++) {
215             elem = av_fetch(av, i, 0);
216             if (elem != NULL) {
217             tmp = SvPV(*elem, len);
218             ${var}[i] = std::string(tmp, len);
219             }
220             else
221             ${var}[i] = std::string(\"\");
222             }
223             }
224             else
225             Perl_croak(aTHX_ \"%s: %s is not an array reference\",
226             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
227             \"$var\");
228              
229             T_STD_VECTOR_STD_STRING_PTR
230             if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
231             AV* av = (AV*)SvRV($arg);
232             const unsigned int alen = av_len(av)+1;
233             $var = new std::vector(alen);
234             STRLEN len;
235             char* tmp;
236             SV** elem;
237             for (unsigned int i = 0; i < alen; i++) {
238             elem = av_fetch(av, i, 0);
239             if (elem != NULL) {
240             tmp = SvPV(*elem, len);
241             (*$var)[i] = std::string(tmp, len);
242             }
243             else
244             (*$var)[i] = std::string(\"\");
245             }
246             }
247             else
248             Perl_croak(aTHX_ \"%s: %s is not an array reference\",
249             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
250             \"$var\");
251              
252             T_STD_VECTOR_CSTRING
253             if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
254             AV* av = (AV*)SvRV($arg);
255             const unsigned int len = av_len(av)+1;
256             $var = std::vector(len);
257             SV** elem;
258             for (unsigned int i = 0; i < len; i++) {
259             elem = av_fetch(av, i, 0);
260             if (elem != NULL) {
261             ${var}[i] = SvPV_nolen(*elem);
262             else
263             ${var}[i] = NULL;
264             }
265             }
266             else
267             Perl_croak(aTHX_ \"%s: %s is not an array reference\",
268             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
269             \"$var\");
270              
271             T_STD_VECTOR_CSTRING_PTR
272             if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
273             AV* av = (AV*)SvRV($arg);
274             const unsigned int len = av_len(av)+1;
275             $var = new std::vector(len);
276             SV** elem;
277             for (unsigned int i = 0; i < len; i++) {
278             elem = av_fetch(av, i, 0);
279             if (elem != NULL) {
280             (*$var)[i] = SvPV_nolen(*elem);
281             else
282             (*$var)[i] = NULL;
283             }
284             }
285             else
286             Perl_croak(aTHX_ \"%s: %s is not an array reference\",
287             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
288             \"$var\");
289             END_INPUT
290              
291 3         7 my $typemap_code = <<'END_TYPEMAP';
292             TYPEMAP
293             std::vector* T_STD_VECTOR_DOUBLE_PTR
294             std::vector T_STD_VECTOR_DOUBLE
295             std::vector* T_STD_VECTOR_INT_PTR
296             std::vector T_STD_VECTOR_INT
297             std::vector* T_STD_VECTOR_UINT_PTR
298             std::vector T_STD_VECTOR_UINT
299             std::vector T_STD_VECTOR_STD_STRING
300             std::vector* T_STD_VECTOR_STD_STRING_PTR
301             std::vector T_STD_VECTOR_CSTRING
302             std::vector* T_STD_VECTOR_CSTRING_PTR
303              
304             INPUT
305             END_TYPEMAP
306 3         13 $typemap_code .= $input_code;
307 3         7 $typemap_code .= "\nOUTPUT\n";
308 3         10 $typemap_code .= $output_code;
309 3         5 $typemap_code .= "\n";
310              
311 3         14 $self->add_string(string => $typemap_code);
312              
313 3         26838 return $self;
314             }
315              
316             1;
317              
318             __END__