← Back to branch summary

~ubuntu-branches/ubuntu/saucy/xmms2/saucy-proposed

« back to all changes in this revision

Viewing changes to src/clients/lib/perl/XMMSClientResultPropDictTie.xs

  • Committer: Bazaar Package Importer
  • Author(s): Florian Ragwitz
  • Date: 2009-05-02 08:31:32 UTC
  • mto: (1.1.6 upstream) (6.1.3 sid)
  • mto: This revision was merged to the branch mainline in revision 23.
  • Revision ID: james.westby@ubuntu.com-20090502083132-y0ulwiqbk4lxfd4z
Import upstream version 0.6DrMattDestruction

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/clients/lib/perl/XMMSClientResultPropDictTie.xs
1
 
#include "perl_xmmsclient.h"
2
 
 
3
 
#define xmmsc_result_propdict_t xmmsc_result_t
4
 
 
5
 
void
6
 
perl_xmmsclient_extract_keys_from_propdict (const void *key,
7
 
                                            xmmsc_result_value_type_t type,
8
 
                                            const void *value,
9
 
                                            const char *source,
10
 
                                            void *user_data)
11
 
{
12
 
        HV *keys = (HV *)user_data;
13
 
 
14
 
        if (!hv_store (keys, key, strlen (key), &PL_sv_undef, 0)) {
15
 
                croak ("Failed to extract propdict keys");
16
 
        }
17
 
}
18
 
 
19
 
HV *
20
 
perl_xmmsclient_get_keys_if_needed (SV *sv)
21
 
{
22
 
        HV *keys;
23
 
        SV **hash_elem;
24
 
        int ret = 0;
25
 
        MAGIC *mg = NULL;
26
 
        xmmsc_result_propdict_t *res = NULL;
27
 
 
28
 
        hash_elem = hv_fetch ((HV *)SvRV (sv), "keys", 4, 0);
29
 
 
30
 
        if (hash_elem == NULL || *hash_elem == NULL) {
31
 
                if (!(mg = perl_xmmsclient_get_magic_from_sv (sv, "Audio::XMMSClient::Result::PropDict::Tie"))) {
32
 
                        croak ("This is a bug!");
33
 
                }
34
 
 
35
 
                res = (xmmsc_result_propdict_t *)mg->mg_ptr;
36
 
 
37
 
                keys = newHV ();
38
 
                ret = xmmsc_result_propdict_foreach (res, perl_xmmsclient_extract_keys_from_propdict, keys);
39
 
 
40
 
                hash_elem = hv_store ((HV *)SvRV (sv), "keys", 4, newRV_noinc ((SV *)keys), 0);
41
 
        }
42
 
 
43
 
        keys = (HV *)SvRV (*hash_elem);
44
 
        return keys;
45
 
}
46
 
 
47
 
MODULE = Audio::XMMSClient::Result::PropDict::Tie       PACKAGE = Audio::XMMSClient::Result::PropDict::Tie
48
 
 
49
 
SV *
50
 
FIRSTKEY (sv)
51
 
                SV *sv
52
 
        PREINIT:
53
 
                HV *keys;
54
 
                HE *iter;
55
 
                char *key;
56
 
                I32 key_len;
57
 
        CODE:
58
 
                keys = perl_xmmsclient_get_keys_if_needed (sv);
59
 
 
60
 
                hv_iterinit (keys);
61
 
                iter = hv_iternext (keys);
62
 
                key  = hv_iterkey (iter, &key_len);
63
 
 
64
 
                RETVAL = newSVpv (key, key_len);
65
 
        OUTPUT:
66
 
                RETVAL
67
 
 
68
 
SV *
69
 
NEXTKEY (sv, lastkey)
70
 
                SV *sv
71
 
        PREINIT:
72
 
                HV *keys;
73
 
                HE *iter;
74
 
                char *key;
75
 
                I32 key_len;
76
 
        CODE:
77
 
                keys = perl_xmmsclient_get_keys_if_needed (sv);
78
 
 
79
 
                iter = hv_iternext (keys);
80
 
 
81
 
                if (iter == NULL) {
82
 
                        RETVAL = &PL_sv_undef;
83
 
                }
84
 
                else {
85
 
                        key  = hv_iterkey (iter, &key_len);
86
 
                        RETVAL = newSVpv (key, key_len);
87
 
                }
88
 
        OUTPUT:
89
 
                RETVAL
90
 
 
91
 
SV *
92
 
FETCH (res, key)
93
 
                xmmsc_result_propdict_t *res
94
 
                char *key
95
 
        PREINIT:
96
 
                int ret = 0;
97
 
                uint32_t uint32_val;
98
 
                int32_t int32_val;
99
 
                const char *string_val;
100
 
                SV **he;
101
 
        CODE:
102
 
                switch (xmmsc_result_get_dict_entry_type (res, key)) {
103
 
                        case XMMS_OBJECT_CMD_ARG_UINT32:
104
 
                                ret = xmmsc_result_get_dict_entry_uint (res, key, &uint32_val);
105
 
 
106
 
                                RETVAL = newSVuv (uint32_val);
107
 
                                break;
108
 
                        case XMMS_OBJECT_CMD_ARG_INT32:
109
 
                                ret = xmmsc_result_get_dict_entry_int (res, key, &int32_val);
110
 
                                RETVAL = newSViv (int32_val);
111
 
                                break;
112
 
                        case XMMS_OBJECT_CMD_ARG_STRING:
113
 
                                ret = xmmsc_result_get_dict_entry_string (res, key, &string_val);
114
 
                                RETVAL = newSVpv (string_val, 0);
115
 
                                break;
116
 
                        default:
117
 
                                XSRETURN_UNDEF;
118
 
                }
119
 
 
120
 
                if (ret != 1) {
121
 
                        XSRETURN_UNDEF;
122
 
                }
123
 
 
124
 
                he = hv_fetch ((HV *)SvRV (ST (0)), "field", 5, 0);
125
 
                if (he && *he) {
126
 
                        char *key;
127
 
                        STRLEN key_len;
128
 
                        HV *perl_constants;
129
 
 
130
 
                        key = SvPV (*he, key_len);
131
 
                        he = hv_fetch ((HV *)SvRV (ST (0)), "constants", 9, 0);
132
 
 
133
 
                        if (!he || !*he) {
134
 
                                croak ("constants not available");
135
 
                        }
136
 
 
137
 
                        perl_constants = (HV *)SvRV (*he);
138
 
 
139
 
                        key = SvPV (RETVAL, key_len);
140
 
                        he = hv_fetch (perl_constants, key, key_len, 0);
141
 
 
142
 
                        if (he && *he) {
143
 
                                sv_2mortal (RETVAL);
144
 
                                RETVAL = newSVsv (*he);
145
 
                        }
146
 
                }
147
 
        OUTPUT:
148
 
                RETVAL
149
 
 
150
 
BOOT:
151
 
        PERL_UNUSED_VAR (items);