File Coverage

lib/ExtUtils/Typemaps/STL/List.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::List;
2              
3 1     1   906 use strict;
  1         3  
  1         38  
4 1     1   6 use warnings;
  1         2  
  1         84  
5 1     1   6 use ExtUtils::Typemaps;
  1         2  
  1         1149  
6              
7             our $VERSION = '1.05';
8              
9             our @ISA = qw(ExtUtils::Typemaps);
10              
11             =head1 NAME
12              
13             ExtUtils::Typemaps::STL::List - A set of typemaps for STL std::lists
14              
15             =head1 SYNOPSIS
16              
17             use ExtUtils::Typemaps::STL::List;
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::List->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 lists.
31             These are:
32              
33             TYPEMAP
34             std::list T_STD_LIST_DOUBLE
35             std::list* T_STD_LIST_DOUBLE_PTR
36            
37             std::list T_STD_LIST_INT
38             std::list* T_STD_LIST_INT_PTR
39            
40             std::list T_STD_LIST_UINT
41             std::list* T_STD_LIST_UINT_PTR
42            
43             std::list T_STD_LIST_STD_STRING
44             std::list* T_STD_LIST_STD_STRING_PTR
45            
46             std::list T_STD_LIST_CSTRING
47             std::list* T_STD_LIST_CSTRING_PTR
48              
49             All of these mean that the lists 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 list type maps initialized.
61              
62             =cut
63              
64             sub new {
65 3     3 1 1076 my $class = shift;
66              
67 3         21 my $self = $class->SUPER::new(@_);
68 3         71 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::list();
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}.push_back(Sv!SHORTTYPE!V(*elem));
79             else
80             ${var}[i].push_back(!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::list();
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).push_back(Sv!SHORTTYPE!V(*elem));
98             else
99             (*$var).push_back(!DEFAULT!);
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         8 my $output_tmpl = <<'HERE';
110             !TYPENAME!
111             AV* av = newAV();
112             $arg = newRV_noinc((SV*)av);
113             const unsigned int len = $var.size(); // Technically may be linear...
114             av_extend(av, len-1);
115             unsigned int i = 0;
116             std::list::const_iterator lend = $var.cend();
117             std::list::const_iterator lit = $var.cbegin();
118             for (; lit != lend; ++lit) {
119             av_store(av, i++, newSV!SHORTTYPELC!v(*lit));
120             }
121              
122             !TYPENAME!_PTR
123             AV* av = newAV();
124             $arg = newRV_noinc((SV*)av);
125             const unsigned int len = $var->size(); // Technically may be linear...
126             av_extend(av, len-1);
127             unsigned int i = 0;
128             std::list::const_iterator lend = (*$var).cend();
129             std::list::const_iterator lit = (*$var).cbegin();
130             for (; lit != lend; ++lit) {
131             av_store(av, i++, newSV!SHORTTYPELC!v(*lit));
132             }
133              
134             HERE
135              
136 3         6 my ($output_code, $input_code);
137             # TYPENAME, TYPE, SHORTTYPE, SHORTTYPELC, DEFAULT
138 3         23 foreach my $type ([qw(T_STD_LIST_DOUBLE double N n 0.)],
139             [qw(T_STD_LIST_INT int I i 0)],
140             [qw(T_STD_LIST_UINT), "unsigned int", qw(U u 0)])
141             {
142 9         28 my @type = @$type;
143 9         13 my $otmpl = $output_tmpl;
144 9         19 my $itmpl = $input_tmpl;
145              
146 9         15 for ($otmpl, $itmpl) {
147 18         132 s/!TYPENAME!/$type[0]/g;
148 18         128 s/!TYPE!/$type[1]/g;
149 18         98 s/!SHORTTYPE!/$type[2]/g;
150 18         132 s/!SHORTTYPELC!/$type[3]/g;
151 18         89 s/!DEFAULT!/$type[4]/g;
152             }
153              
154 9         22 $output_code .= $otmpl;
155 9         37 $input_code .= $itmpl;
156             }
157              
158             # add a static part
159 3         16 $output_code .= <<'END_OUTPUT';
160             T_STD_LIST_STD_STRING
161             AV* av = newAV();
162             $arg = newRV_noinc((SV*)av);
163             const unsigned int len = $var.size(); // Technically may be linear...
164             av_extend(av, len-1);
165             unsigned int i = 0;
166             std::list::const_iterator lend = $var.cend();
167             std::list::const_iterator lit = $var.cbegin();
168             for (; lit != lend; ++lit) {
169             const std::string& str = *lit;
170             STRLEN len = str.length();
171             av_store(av, i++, newSVpv(str.c_str(), len));
172             }
173              
174             T_STD_LIST_STD_STRING_PTR
175             AV* av = newAV();
176             $arg = newRV_noinc((SV*)av);
177             const unsigned int len = $var->size(); // Technically may be linear...
178             av_extend(av, len-1);
179             unsigned int i = 0;
180             std::list::const_iterator lend = (*$var).cend();
181             std::list::const_iterator lit = (*$var).cbegin();
182             for (; lit != lend; ++lit) {
183             const std::string& str = *lit;
184             STRLEN len = str.length();
185             av_store(av, i++, newSVpv(str.c_str(), len));
186             }
187              
188             T_STD_LIST_CSTRING
189             AV* av = newAV();
190             $arg = newRV_noinc((SV*)av);
191             const unsigned int len = $var.size();
192             av_extend(av, len-1);
193             unsigned int i = 0;
194             std::list::const_iterator lend = $var.cend();
195             std::list::const_iterator lit = $var.cbegin();
196             for (; lit != lend; ++lit) {
197             av_store(av, i, newSVpv(*lit, (STRLEN)strlen(*lit)));
198             }
199              
200             T_STD_LIST_CSTRING_PTR
201             AV* av = newAV();
202             $arg = newRV_noinc((SV*)av);
203             const unsigned int len = $var->size();
204             av_extend(av, len-1);
205             unsigned int i = 0;
206             std::list::const_iterator lend = (*$var).cend();
207             std::list::const_iterator lit = (*$var).cbegin();
208             for (; lit != lend; ++lit) {
209             av_store(av, i, newSVpv(*lit, (STRLEN)strlen(*lit)));
210             }
211              
212             END_OUTPUT
213              
214             # add a static part to input
215 3         13 $input_code .= <<'END_INPUT';
216             T_STD_LIST_STD_STRING
217             if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
218             AV* av = (AV*)SvRV($arg);
219             const unsigned int alen = av_len(av)+1;
220             $var = std::list();
221             STRLEN len;
222             char* tmp;
223             SV** elem;
224             for (unsigned int i = 0; i < alen; i++) {
225             elem = av_fetch(av, i, 0);
226             if (elem != NULL) {
227             tmp = SvPV(*elem, len);
228             ${var}.push_back(std::string(tmp, len));
229             }
230             else
231             ${var}.push_back(std::string(\"\"));
232             }
233             }
234             else
235             Perl_croak(aTHX_ \"%s: %s is not an array reference\",
236             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
237             \"$var\");
238              
239             T_STD_LIST_STD_STRING_PTR
240             if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
241             AV* av = (AV*)SvRV($arg);
242             const unsigned int alen = av_len(av)+1;
243             $var = new std::list(alen);
244             STRLEN len;
245             char* tmp;
246             SV** elem;
247             for (unsigned int i = 0; i < alen; i++) {
248             elem = av_fetch(av, i, 0);
249             if (elem != NULL) {
250             tmp = SvPV(*elem, len);
251             (*$var).push_back(std::string(tmp, len));
252             }
253             else
254             (*$var).push_back(std::string(\"\"));
255             }
256             }
257             else
258             Perl_croak(aTHX_ \"%s: %s is not an array reference\",
259             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
260             \"$var\");
261              
262             T_STD_LIST_CSTRING
263             if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
264             AV* av = (AV*)SvRV($arg);
265             const unsigned int len = av_len(av)+1;
266             $var = std::list();
267             SV** elem;
268             for (unsigned int i = 0; i < len; i++) {
269             elem = av_fetch(av, i, 0);
270             if (elem != NULL) {
271             ${var}.push_back(SvPV_nolen(*elem));
272             else
273             ${var}.push_back(NULL);
274             }
275             }
276             else
277             Perl_croak(aTHX_ \"%s: %s is not an array reference\",
278             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
279             \"$var\");
280              
281             T_STD_LIST_CSTRING_PTR
282             if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) {
283             AV* av = (AV*)SvRV($arg);
284             const unsigned int len = av_len(av)+1;
285             $var = new std::list();
286             SV** elem;
287             for (unsigned int i = 0; i < len; i++) {
288             elem = av_fetch(av, i, 0);
289             if (elem != NULL) {
290             (*$var).push_back(SvPV_nolen(*elem));
291             else
292             (*$var).push_back(NULL);
293             }
294             }
295             else
296             Perl_croak(aTHX_ \"%s: %s is not an array reference\",
297             ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
298             \"$var\");
299             END_INPUT
300              
301 3         6 my $typemap_code = <<'END_TYPEMAP';
302             TYPEMAP
303             std::list* T_STD_LIST_DOUBLE_PTR
304             std::list T_STD_LIST_DOUBLE
305             std::list* T_STD_LIST_INT_PTR
306             std::list T_STD_LIST_INT
307             std::list* T_STD_LIST_UINT_PTR
308             std::list T_STD_LIST_UINT
309             std::list T_STD_LIST_STD_STRING
310             std::list* T_STD_LIST_STD_STRING_PTR
311             std::list T_STD_LIST_STD_STRING
312             std::list* T_STD_LIST_STD_STRING_PTR
313             std::list T_STD_LIST_CSTRING
314             std::list* T_STD_LIST_CSTRING_PTR
315             list* T_STD_LIST_DOUBLE_PTR
316             list T_STD_LIST_DOUBLE
317             list* T_STD_LIST_INT_PTR
318             list T_STD_LIST_INT
319             list* T_STD_LIST_UINT_PTR
320             list T_STD_LIST_UINT
321             list T_STD_LIST_STD_STRING
322             list* T_STD_LIST_STD_STRING_PTR
323             list T_STD_LIST_STD_STRING
324             list* T_STD_LIST_STD_STRING_PTR
325             list T_STD_LIST_CSTRING
326             list* T_STD_LIST_CSTRING_PTR
327              
328             INPUT
329             END_TYPEMAP
330 3         19 $typemap_code .= $input_code;
331 3         6 $typemap_code .= "\nOUTPUT\n";
332 3         12 $typemap_code .= $output_code;
333 3         7 $typemap_code .= "\n";
334              
335 3         16 $self->add_string(string => $typemap_code);
336              
337 3         46792 return $self;
338             }
339              
340             1;
341              
342             __END__