File: typemap

package info (click to toggle)
libfreecontact-perl 0.08-8
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 300 kB
  • sloc: perl: 87; makefile: 11
file content (129 lines) | stat: -rw-r--r-- 3,921 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
#   Copyright (C) 2013 by Laszlo Kajan, Technical University of Munich, Germany
#   
#   This program is free software; you can redistribute it and/or modify
#   it under the same terms as Perl itself, either Perl version 5.10.1 or,
#   at your option, any later version of Perl 5 you may have available.
# Example: /usr/share/perl/5.10.1/ExtUtils/typemap perlobject.map
TYPEMAP
cont_res_t			T_CONT_RES
double*				T_DOUBLE_PTR
freq_vec_t          T_FREQ_VEC
freq_vec_t*         T_FREQ_VEC_PTR
predictor*			O_OBJECT
ali_t				T_ALI
time_res_t*			T_TIME_RES_PTR

INPUT
T_ALI
	{
		if(SvROK($arg) && SvTYPE(SvRV($arg)) == SVt_PVAV)
		{
			// $arg is an array reference to strings - the sequences in the alignment
			AV *arr = (AV*)SvRV($arg);
			I32 seqcnt = av_len(arr)+1; // av_len returns highest index
			if(seqcnt > 0)
			{
				SV** lineptr = av_fetch(arr, 0, false);
				if(lineptr != NULL && SvPOK(*lineptr))
				{
					STRLEN alilen = SvCUR(*lineptr);
					if(alilen <= 0xFFFF)
					{
						$var = $type(alilen);
            
						for(I32 k = 0; k < seqcnt; ++k)
						{
							SV** lineptr = av_fetch(arr, k, false);
							if(lineptr != NULL && SvPOK(*lineptr))
							{
								STRLEN alilen = SvCUR(*lineptr);
								if(alilen <= 0xFFFF)
								{
									const char *al = SvPVbyte(*lineptr, alilen);
									$var.push(std::string(al, alilen));
								}
							}
						}
					}
					else croak(\"${Package}::$func_name() -- $var\->[0] is too long\");
				}
				else croak(\"${Package}::$func_name() -- $var\->[0] is not a character string\");
			}
		}
		else croak(\"${Package}::$func_name() -- $var is not an AV reference\");
	}
T_DOUBLE_PTR
T_FREQ_VEC
	{
		if(SvROK($arg) && SvTYPE(SvRV($arg)) == SVt_PVAV)
		{
			// form vector out of $arg = [ 1, 0.9, 0.7, ... ]
			AV *arr = (AV*)SvRV($arg);
			I32 wcnt = av_len(arr)+1; // av_len returns highest index
			if(wcnt > 0)
			{
				$var = $type(wcnt);
				for(I32 k = 0; k < wcnt; ++k)
				{
					SV** svptr = av_fetch(arr, k, false);
					if(svptr != NULL && SvNIOK(*svptr))
						($var)[k] = SvNV(*svptr);
					else croak(\"${Package}::$func_name() -- $var\[%d\] is not a number\", k);
				}
			}
		}
		else croak(\"${Package}::$func_name() -- $var is not an AV reference\");
	}
T_FREQ_VEC_PTR
T_TIME_RES_PTR

OUTPUT
T_CONT_RES
	if($var.empty()) $arg = &PL_sv_undef;
	else
	{

		// return { 'l1norm' => [ [ 0, 1, 45.786 ], [ 0, 2, 7.993 ], ... ], ... }
		HV* res = (HV*)sv_2mortal((SV*)newHV());
		for(cont_res_t::const_iterator cr_i = $var.begin(), cr_e = $var.end(); cr_i != cr_e; ++cr_i)
		{
			AV* contacts = (AV*)sv_2mortal((SV*)newAV()); av_extend(contacts, cr_i->second.size()-1); // extend to index

			for(std::vector<contact_t>::const_iterator ct_i = cr_i->second.begin(), ct_e = cr_i->second.end(); ct_i != ct_e; ++ct_i)
			{
				AV* ijscore = (AV*)sv_2mortal((SV*)newAV()); av_extend(ijscore, 2); // extend to index

				av_push(ijscore, newSVuv(ct_i->i));
				av_push(ijscore, newSVuv(ct_i->j));
				av_push(ijscore, newSVnv(ct_i->score));
				//
				av_push(contacts, newRV((SV*)ijscore));
			}

			hv_store(res, cr_i->first.c_str(), cr_i->first.length(), newRV((SV*)contacts), 0);
		}

		sv_setsv($arg, newRV((SV*)res));
	}
T_DOUBLE_PTR
	sv_setnv($arg, (double)*$var);
T_FREQ_VEC_PTR
	{
		// return [ 1, 0.9, 0.7, ... ]
		AV* res = (AV*)sv_2mortal((SV*)newAV()); av_extend(res, $var->size()-1); // extend to index

		for(freq_vec_t::const_iterator fv_i = $var->begin(), fv_e = $var->end(); fv_i != fv_e; ++fv_i)
			av_push(res, newSVnv(*fv_i));

		sv_setsv($arg, newRV((SV*)res));
	}
T_TIME_RES_PTR
	if($var && SvROK($arg) && SvTYPE(SvRV($arg)) == SVt_PVHV)
	{
		// return { 'key' => 0.0, ... }
		HV* res = (HV*)SvRV($arg);
		for(time_res_t::const_iterator tr_i = $var->begin(), tr_e = $var->end(); tr_i != tr_e; ++tr_i)
			hv_store(res, tr_i->first.c_str(), tr_i->first.length(), newSVnv(tr_i->second), 0);
	}

# vim:noet:ts=4:ai:syntax=sh: