1# typemap for Perl 5 interface to Berkeley DB version 2 & 3
2#
3# SCCS: %I%, %G%     
4#
5# written by Paul Marquess <pmqs@cpan.org>
6#
7#################################### DB SECTION
8#
9# 
10
11SVnull*         T_SV_NULL
12void *			T_PV
13u_int			T_U_INT
14u_int32_t		T_U_INT
15db_timeout_t	T_U_INT
16const char * 		T_PV_NULL
17PV_or_NULL		T_PV_NULL
18IO_or_NULL		T_IO_NULL
19
20AV *			T_AV
21
22BerkeleyDB		T_PTROBJ
23BerkeleyDB::Common	T_PTROBJ_AV
24BerkeleyDB::Hash	T_PTROBJ_AV
25BerkeleyDB::Btree	T_PTROBJ_AV
26BerkeleyDB::Recno	T_PTROBJ_AV
27BerkeleyDB::Queue	T_PTROBJ_AV
28BerkeleyDB::Cursor	T_PTROBJ_AV
29BerkeleyDB::TxnMgr	T_PTROBJ_AV
30BerkeleyDB::Txn		T_PTROBJ_AV
31BerkeleyDB::Log		T_PTROBJ_AV
32BerkeleyDB::Lock	T_PTROBJ_AV
33BerkeleyDB::Env		T_PTROBJ_AV
34
35BerkeleyDB::Raw		T_RAW
36BerkeleyDB::Common::Raw	T_RAW
37BerkeleyDB::Hash::Raw	T_RAW
38BerkeleyDB::Btree::Raw	T_RAW
39BerkeleyDB::Recno::Raw	T_RAW
40BerkeleyDB::Queue::Raw	T_RAW
41BerkeleyDB::Cursor::Raw	T_RAW
42BerkeleyDB::TxnMgr::Raw	T_RAW
43BerkeleyDB::Txn::Raw	T_RAW
44BerkeleyDB::Log::Raw	T_RAW
45BerkeleyDB::Lock::Raw	T_RAW
46BerkeleyDB::Env::Raw	T_RAW
47
48BerkeleyDB::Env::Inner	T_INNER
49BerkeleyDB::Common::Inner	T_INNER
50BerkeleyDB::Txn::Inner	T_INNER
51BerkeleyDB::TxnMgr::Inner	T_INNER
52# BerkeleyDB__Env 	T_PTR
53DBT			T_dbtdatum
54DBT_OPT			T_dbtdatum_opt
55DBT_B			T_dbtdatum_btree
56DBTKEY			T_dbtkeydatum
57DBTKEY_B		T_dbtkeydatum_btree
58DBTKEY_Br		T_dbtkeydatum_btree_r
59DBTKEY_Bpr		T_dbtkeydatum_btree_pr
60DBTYPE			T_U_INT
61DualType		T_DUAL
62BerkeleyDB_type *	T_IV
63BerkeleyDB_ENV_type *	T_IV
64BerkeleyDB_TxnMgr_type * T_IV
65BerkeleyDB_Txn_type *	T_IV
66BerkeleyDB__Cursor_type * T_IV
67DB *			T_IV
68DB_ENV *		T_IV
69
70INPUT
71
72T_AV
73	if (SvROK($arg) && SvTYPE(SvRV($arg)) == SVt_PVAV)
74        /* if (sv_isa($arg, \"${ntype}\")) */
75            $var = (AV*)SvRV($arg);
76        else
77            croak(\"$var is not an array reference\")
78
79T_RAW
80        $var = INT2PTR($type,SvIV($arg)
81
82T_U_INT
83        $var = SvUV($arg)
84
85T_SV_REF_NULL
86	if ($arg == &PL_sv_undef)
87	    $var = NULL ;
88        else if (sv_derived_from($arg, \"${ntype}\")) {
89            IV tmp = SvIV((SV *)GetInternalObject($arg));
90            $var =  INT2PTR($type, tmp);
91        }
92        else
93            croak(\"$var is not of type ${ntype}\")
94
95T_SV_NULL
96	if ($arg == NULL || $arg == &PL_sv_undef)
97	    $var = NULL ;
98	else
99	    $var = $arg ;
100
101T_HV_REF_NULL
102	if ($arg == &PL_sv_undef)
103	    $var = NULL ;
104        else if (sv_derived_from($arg, \"${ntype}\")) {
105            HV * hv = (HV *)GetInternalObject($arg);
106            SV ** svp = hv_fetch(hv, \"db\", 2, FALSE);
107            IV tmp = SvIV(*svp);
108            $var =  INT2PTR($type, tmp);
109        }
110        else
111            croak(\"$var is not of type ${ntype}\")
112
113T_HV_REF
114        if (sv_derived_from($arg, \"${ntype}\")) {
115            HV * hv = (HV *)GetInternalObject($arg);
116            SV ** svp = hv_fetch(hv, \"db\", 2, FALSE);
117            IV tmp = SvIV(*svp);
118            $var =  INT2PTR($type, tmp);
119        }
120        else
121            croak(\"$var is not of type ${ntype}\")
122
123
124T_P_REF
125        if (sv_derived_from($arg, \"${ntype}\")) {
126            IV tmp = SvIV((SV*)SvRV($arg));
127            $var = INT2PTR($type, tmp);
128        }
129        else
130            croak(\"$var is not of type ${ntype}\")
131
132
133T_INNER
134	{
135	    HV * hv = (HV *)SvRV($arg);
136            SV ** svp = hv_fetch(hv, \"db\", 2, FALSE);
137            IV tmp = SvIV(*svp);
138            $var =  INT2PTR($type, tmp);
139	}
140
141T_PV_NULL
142	if ($arg == &PL_sv_undef)
143	    $var = NULL ;
144	else {
145        STRLEN len;
146            $var = ($type)SvPV($arg,len) ;
147	    if (len == 0)
148		$var = NULL ;
149	}
150
151T_IO_NULL
152	if ($arg == &PL_sv_undef)
153	    $var = NULL ; 
154	else 
155            $var = IoOFP(sv_2io($arg))
156
157T_PTROBJ_NULL
158	if ($arg == &PL_sv_undef)
159	    $var = NULL ;
160        else if (sv_derived_from($arg, \"${ntype}\")) {
161            IV tmp = SvIV((SV*)SvRV($arg));
162            $var = INT2PTR($type, tmp);
163        }
164        else
165            croak(\"$var is not of type ${ntype}\")
166
167T_PTROBJ_SELF
168	if ($arg == &PL_sv_undef)
169	    $var = NULL ;
170        else if (sv_derived_from($arg, \"${ntype}\")) {
171            IV tmp = SvIV((SV*)SvRV($arg));
172            $var = INT2PTR($type, tmp);
173        }
174        else
175            croak(\"$var is not of type ${ntype}\")
176
177T_PTROBJ_AV
178        if ($arg == &PL_sv_undef || $arg == NULL)
179            $var = NULL ;
180        else if (sv_derived_from($arg, \"${ntype}\")) {
181            IV tmp = SvIV(getInnerObject($arg)) ;
182            $var = INT2PTR($type, tmp);
183        }
184        else
185            croak(\"$var is not of type ${ntype}\")
186
187T_dbtkeydatum
188	{
189	    SV* my_sv = $arg ;
190	    DBM_ckFilter(my_sv, filter_store_key, \"filter_store_key\");
191	    DBT_clear($var) ;
192            SvGETMAGIC($arg) ;
193	    if (db->recno_or_queue) {
194	        Value = GetRecnoKey(db, SvIV(my_sv)) ; 
195	        $var.data = & Value; 
196	        $var.size = (int)sizeof(db_recno_t);
197	    }
198	    else {
199            STRLEN len;
200	        $var.data = SvPV(my_sv, len);
201	        $var.size = (int)len;
202	    }
203	}
204
205T_dbtkeydatum_btree
206	{
207	    SV* my_sv = $arg ;
208	    DBM_ckFilter(my_sv, filter_store_key, \"filter_store_key\");
209	    DBT_clear($var) ;
210            SvGETMAGIC($arg) ;
211	    if (db->recno_or_queue ||
212		    (db->type == DB_BTREE && flagSet(DB_SET_RECNO))) {
213	        Value = GetRecnoKey(db, SvIV(my_sv)) ; 
214	        $var.data = & Value; 
215	        $var.size = (int)sizeof(db_recno_t);
216	    }
217	    else {
218            STRLEN len;
219	        $var.data = SvPV(my_sv, len);
220	        $var.size = (int)len;
221	    }
222	}
223
224T_dbtkeydatum_btree_r
225	{
226	    SV* my_sv = $arg ;
227	    DBM_ckFilter(my_sv, filter_store_key, \"filter_store_key\");
228	    DBT_clear($var) ;
229            SvGETMAGIC($arg) ;
230	    if (db->recno_or_queue || 
231		    (db->type == DB_BTREE && flagSet(DB_SET_RECNO))) {
232	        Value = GetRecnoKey(db, SvIV(my_sv)) ; 
233	        $var.data = & Value; 
234	        $var.size = (int)sizeof(db_recno_t);
235	    }
236	    else {
237            STRLEN len;
238	        $var.data = SvPV(my_sv, len);
239	        $var.size = (int)len;
240	    }
241	}
242
243T_dbtkeydatum_btree_pr
244	{
245	    SV* my_sv = $arg ;
246	    DBM_ckFilter(my_sv, filter_store_key, \"filter_store_key\");
247	    DBT_clear($var) ;
248            SvGETMAGIC($arg) ;
249	    if (db->recno_or_queue || 
250		    (db->type == DB_BTREE && flagSet(DB_SET_RECNO))) {
251	        Value = GetRecnoKey(db, SvIV(my_sv)) ; 
252	        $var.data = & Value; 
253	        $var.size = (int)sizeof(db_recno_t);
254	    }
255	    else {
256            STRLEN len;
257	        $var.data = SvPV(my_sv, len);
258	        $var.size = (int)len;
259	    }
260	}
261
262T_dbtdatum
263	{
264	    SV* my_sv = $arg ;
265        STRLEN len;
266	    DBM_ckFilter(my_sv, filter_store_value, \"filter_store_value\");
267	    DBT_clear($var) ;
268            SvGETMAGIC($arg) ;
269	    $var.data = SvPV(my_sv, len);
270	    $var.size = (int)len;
271  	    $var.flags = db->partial ;
272    	    $var.dlen  = db->dlen ;
273	    $var.doff  = db->doff ;
274	}
275	
276T_dbtdatum_opt
277	DBT_clear($var) ;
278	if (flagSetBoth()) {
279	   SV* my_sv = $arg ;
280       STRLEN len;
281	   DBM_ckFilter(my_sv, filter_store_value, \"filter_store_value\");
282           SvGETMAGIC($arg) ;
283	   $var.data = SvPV(my_sv, len);
284	   $var.size = (int)len;
285  	   $var.flags = db->partial ;
286    	   $var.dlen  = db->dlen ;
287	   $var.doff  = db->doff ;
288	}
289	
290T_dbtdatum_btree
291	DBT_clear($var) ;
292	if (flagSetBoth()) {
293	    SV* my_sv = $arg ;
294        STRLEN len;
295	    DBM_ckFilter(my_sv, filter_store_value, \"filter_store_value\");
296            SvGETMAGIC($arg) ;
297	    $var.data = SvPV(my_sv, len);
298	    $var.size = (int)len;
299  	    $var.flags = db->partial ;
300    	    $var.dlen  = db->dlen ;
301	    $var.doff  = db->doff ;
302	}
303	
304
305OUTPUT
306
307T_SV_NULL
308        $arg = $var;
309
310T_RAW
311        sv_setiv($arg, PTR2IV($var));
312
313T_SV_REF_NULL
314	sv_setiv($arg, PTR2IV($var));
315
316T_HV_REF_NULL
317	sv_setiv($arg, PTR2IV($var));
318
319T_HV_REF
320	sv_setiv($arg, PTR2IV($var));
321
322T_P_REF
323	sv_setiv($arg, PTR2IV($var));
324
325T_DUAL
326	setDUALerrno($arg, $var) ;
327
328T_U_INT
329        sv_setuv($arg, (UV)$var);
330
331T_PV_NULL
332        sv_setpv((SV*)$arg, $var);
333
334T_dbtkeydatum_btree
335	OutputKey_B($arg, $var)
336T_dbtkeydatum_btree_r
337	OutputKey_Br($arg, $var)
338T_dbtkeydatum_btree_pr
339	OutputKey_Bpr($arg, $var)
340T_dbtkeydatum
341	OutputKey($arg, $var)
342T_dbtdatum
343	OutputValue($arg, $var)
344T_dbtdatum_opt
345	OutputValue($arg, $var)
346T_dbtdatum_btree
347	OutputValue_B($arg, $var)
348
349T_PTROBJ_NULL
350        sv_setref_pv($arg, \"${ntype}\", (void*)$var);
351
352T_PTROBJ_SELF
353        sv_setref_pv($arg, self, (void*)$var);
354