[rt #71641] provide a STRLEN typemap entry for older perls
[imager.git] / typemap
1 #i_img *                        T_PTR_NULL
2 Imager::Color           T_PTROBJ
3 Imager::Color::Float    T_PTROBJ
4 Imager::ImgRaw          T_IMAGER_IMAGE
5 Imager::Font::TT        T_PTROBJ
6 Imager::IO              T_PTROBJ
7 Imager::FillHandle      T_PTROBJ
8 Imager::Internal::Hlines T_PTROBJ
9 const char *            T_PV
10 float                   T_FLOAT
11 float*                  T_ARRAY
12 undef_int               T_IV_U
13 undef_neg_int           T_IV_NEGU
14 HASH                    T_HVREF
15 utf8_str                T_UTF8_STR
16 i_img_dim               T_IV
17
18 # these types are for use by Inline, which can't handle types containing ::
19 Imager__Color           T_PTROBJ_INV
20 Imager__Color__Float    T_PTROBJ_INV
21 Imager__ImgRaw          T_IMAGER_IMAGE
22 Imager__FillHandle      T_PTROBJ_INV
23 Imager__IO              T_PTROBJ_INV
24
25 # mostly intended for non-Imager-core use
26 Imager                  T_IMAGER_FULL_IMAGE
27
28 off_t                   T_OFF_T
29
30 # STRLEN isn't in the default typemap in older perls
31 STRLEN                  T_UV
32
33 #############################################################################
34 INPUT
35 T_PTR_NULL
36         if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
37         else $var = NULL
38
39 # the pre-5.8.0 T_AVREF input map was fixed in 5.8.0
40 T_AVREF
41         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
42             $var = (AV*)SvRV($arg);
43         else
44             Perl_croak(aTHX_ \"$var is not an array reference\")
45
46 # handles Imager objects rather than just raw objects
47 T_IMAGER_IMAGE
48         if (sv_derived_from($arg, \"Imager::ImgRaw\")) {
49             IV tmp = SvIV((SV*)SvRV($arg));
50             $var = INT2PTR($type,tmp);
51         }
52         else if (sv_derived_from($arg, \"Imager\") && 
53                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
54             HV *hv = (HV *)SvRV($arg);
55             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
56             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
57                 IV tmp = SvIV((SV*)SvRV(*sv));
58                 $var = INT2PTR($type,tmp);
59             }
60             else
61                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
62         }
63         else
64             Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
65
66 T_IMAGER_FULL_IMAGE
67         if (sv_derived_from($arg, \"Imager\") && 
68                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
69             HV *hv = (HV *)SvRV($arg);
70             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
71             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
72                 IV tmp = SvIV((SV*)SvRV(*sv));
73                 $var = INT2PTR($type,tmp);
74             }
75             else
76                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
77         }
78         else
79             Perl_croak(aTHX_ \"$var is not of type Imager\");
80
81 # same as T_PTROBJ, but replace __ with ::, the opposite of the way
82 # xsubpp's processing works
83 # this is to compensate for Inline's problem with type names containing ::
84 T_PTROBJ_INV
85         if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\")) {
86             IV tmp = SvIV((SV*)SvRV($arg));
87             $var = INT2PTR($type,tmp);
88         }
89         else
90             croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");
91
92 T_OFF_T
93   $var = i_sv_off_t(aTHX_ $arg);
94
95 #############################################################################
96 OUTPUT
97 T_IV_U
98         if ($var == 0) $arg=&PL_sv_undef;
99         else sv_setiv($arg, (IV)$var);
100 T_IV_NEGU
101         if ($var < 0) $arg=&PL_sv_undef;
102         else sv_setiv($arg, (IV)$var);
103 T_PTR_NULL
104         sv_setiv($arg, (IV)$var);
105
106 # same as T_PTROBJ
107 T_IMAGER_IMAGE
108         sv_setref_pv($arg, \"Imager::ImgRaw\", (void*)$var);
109
110 T_PTROBJ_INV
111         sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\", (void*)$var);
112
113 # ugh, the things we do for ease of use
114 # this isn't suitable in some cases
115 T_IMAGER_FULL_IMAGE
116         if ($var) {
117           SV *imobj = NEWSV(0, 0);
118           HV *hv = newHV();
119           sv_setref_pv(imobj, \"Imager::ImgRaw\", $var);
120           hv_store(hv, "IMG", 3, imobj, 0);
121           $arg = sv_2mortal(sv_bless(newRV_noinc((SV*)hv), gv_stashpv("Imager", 1)));
122         }
123         else {
124           $arg = &PL_sv_undef;
125         }
126 T_OFF_T
127         $arg = i_new_sv_off_t(aTHX_ $var);