File Coverage

Av_CharPtrPtr.c
Criterion Covered Total %
statement 19 37 51.3
branch 12 22 54.5
condition n/a
subroutine n/a
pod n/a
total 31 59 52.5


line stmt bran cond sub pod time code
1             /* Modified from API Cookbook A Example 8 */
2              
3             #ifdef __cplusplus
4             extern "C" {
5             #endif
6             #include "EXTERN.h"
7             #include "perl.h"
8             #include "XSUB.h"
9             #include "Av_CharPtrPtr.h" /* XS_*_charPtrPtr() */
10             #ifdef __cplusplus
11             }
12             #endif
13              
14             #if defined(_MSC_VER)
15             #define _CRT_SECURE_NO_DEPRECATE 1
16             #define _CRT_NONSTDC_NO_DEPRECATE 1
17             #endif
18              
19              
20             /* Used by the INPUT typemap for char**.
21             * Will convert a Perl AV* (containing strings) to a C char**.
22             */
23 24           char ** XS_unpack_charPtrPtr(SV* rv )
24             {
25             AV *av;
26             SV **ssv;
27             char **s;
28             int avlen;
29             int x;
30              
31 24 100         if( SvROK( rv ) && (SvTYPE(SvRV(rv)) == SVt_PVAV) )
    50          
32 7           av = (AV*)SvRV(rv);
33             else {
34 17           return( (char**)NULL );
35             }
36              
37             /* is it empty? */
38 7           avlen = av_len(av);
39 7 100         if( avlen < 0 ){
40 2           return( (char**)NULL );
41             }
42              
43             /* av_len+2 == number of strings, plus 1 for an end-of-array sentinel.
44             */
45 5           s = (char **)safemalloc( sizeof(char*) * (avlen + 2) );
46 5 50         if( s == NULL ){
47 0           warn("XS_unpack_charPtrPtr: unable to malloc char**");
48 0           return( (char**)NULL );
49             }
50 12 100         for( x = 0; x <= avlen; ++x ){
51 7           ssv = av_fetch( av, x, 0 );
52 7 50         if( ssv != NULL ){
53 7 50         if( SvPOK( *ssv ) ){
54 7           s[x] = (char *)safemalloc( SvCUR(*ssv) + 1 );
55 7 50         if( s[x] == NULL )
56 0           warn("XS_unpack_charPtrPtr: unable to malloc char*");
57             else
58 7 50         strcpy( s[x], SvPV( *ssv, PL_na ) );
59             }
60             else
61 7           warn("XS_unpack_charPtrPtr: array elem %d was not a string.", x );
62             }
63             else
64 0           s[x] = (char*)NULL;
65             }
66 5           s[x] = (char*)NULL; /* sentinel */
67 5           return( s );
68             }
69              
70             /* Used by the OUTPUT typemap for char**.
71             * Will convert a C char** to a Perl AV*.
72             */
73 0           void XS_pack_charPtrPtr(SV* st, char **s)
74             {
75 0           AV *av = newAV();
76             SV *sv;
77             char **c;
78              
79 0 0         for( c = s; *c != NULL; ++c ){
80 0           sv = newSVpv( *c, 0 );
81 0           av_push( av, sv );
82             }
83 0           sv = newSVrv( st, NULL ); /* upgrade stack SV to an RV */
84 0           SvREFCNT_dec( sv ); /* discard */
85 0           SvRV( st ) = (SV*)av; /* make stack RV point at our AV */
86 0           }
87              
88              
89             /* cleanup the temporary char** from XS_unpack_charPtrPtr */
90 0           void XS_release_charPtrPtr(char **s)
91             {
92             char **c;
93 0 0         for( c = s; *c != NULL; ++c )
94 0           safefree( *c );
95 0           safefree( s );
96 0           }
97