1 #include "EXTERN.h" 2 #include "perl.h" 3 #include "XSUB.h" 4 #include <string.h> /* for memmove() mostly */ 5 #include <errno.h> /* errno values */ 6 #include "queue.h" 7 #include "alloc.h" 8 9 /* this typedef lets the standard T_PTROBJ typemap handle the 10 conversion between perl class and C type and back again */ 11 typedef poe_queue *POE__XS__Queue__Array; 12 13 /* This gives us our new method and correct destruction */ 14 #define pq_new(class) pq_create() 15 #define pq_DESTROY(pq) pq_delete(pq) 16 17 MODULE = POE::XS::Queue::Array PACKAGE = POE::XS::Queue::Array PREFIX = pq_ 18 19 PROTOTYPES: DISABLE 20 21 POE::XS::Queue::Array 22 pq_new(class) 23 24 void 25 pq_DESTROY(pq) 26 POE::XS::Queue::Array pq 27 28 int 29 pq_enqueue(pq, priority, payload) 30 POE::XS::Queue::Array pq 31 double priority 32 SV *payload 33 34 void 35 pq_dequeue_next(pq) 36 POE::XS::Queue::Array pq 37 PREINIT: 38 pq_priority_t priority; 39 pq_id_t id; 40 SV *payload; 41 PPCODE: 42 if (pq_dequeue_next(pq, &priority, &id, &payload)) { 43 EXTEND(SP, 3); 44 PUSHs(sv_2mortal(newSVnv(priority))); 45 PUSHs(sv_2mortal(newSViv(id))); 46 PUSHs(sv_2mortal(payload)); 47 } 48 49 SV * 50 pq_get_next_priority(pq) 51 POE::XS::Queue::Array pq 52 PREINIT: 53 pq_priority_t priority; 54 CODE: 55 if (pq_get_next_priority(pq, &priority)) { 56 RETVAL = newSVnv(priority); /* XS will mortalize this for us */ 57 } 58 else { 59 RETVAL = &PL_sv_undef; 60 } 61 OUTPUT: 62 RETVAL 63 64 int 65 pq_get_item_count(pq) 66 POE::XS::Queue::Array pq 67 68 void 69 pq_remove_item(pq, id, filter) 70 POE::XS::Queue::Array pq 71 int id 72 SV *filter 73 PREINIT: 74 pq_entry removed; 75 PPCODE: 76 if (pq_remove_item(pq, id, filter, &removed)) { 77 EXTEND(SP, 3); 78 PUSHs(sv_2mortal(newSVnv(removed.priority))); 79 PUSHs(sv_2mortal(newSViv(removed.id))); 80 PUSHs(sv_2mortal(removed.payload)); 81 } 82 83 void 84 pq_remove_items(pq, filter, ...) 85 POE::XS::Queue::Array pq 86 SV *filter 87 PREINIT: 88 int max_count; 89 pq_entry *removed_entries = NULL; 90 int removed_count; 91 int i; 92 PPCODE: 93 if (items > 2) 94 max_count = SvIV(ST(2)); 95 else 96 max_count = pq_get_item_count(pq); 97 removed_count = pq_remove_items(pq, filter, max_count, 98 &removed_entries); 99 if (removed_count) { 100 EXTEND(SP, removed_count); 101 for (i = 0; i < removed_count; ++i) { 102 pq_entry *entry = removed_entries + i; 103 AV *av = newAV(); 104 SV *rv; 105 av_extend(av, 2); 106 av_store(av, 0, newSVnv(entry->priority)); 107 av_store(av, 1, newSViv(entry->id)); 108 av_store(av, 2, entry->payload); 109 rv = newRV_noinc((SV *)av); 110 PUSHs(sv_2mortal(rv)); 111 } 112 } 113 if (removed_entries) 114 myfree(removed_entries); 115 116 void 117 pq_adjust_priority(pq, id, filter, delta) 118 POE::XS::Queue::Array pq 119 int id 120 SV *filter 121 double delta 122 PREINIT: 123 pq_priority_t new_priority; 124 PPCODE: 125 if (pq_adjust_priority(pq, id, filter, delta, &new_priority)) { 126 EXTEND(SP, 1); 127 PUSHs(sv_2mortal(newSVnv(new_priority))); 128 } 129 130 void 131 pq_set_priority(pq, id, filter, new_priority) 132 POE::XS::Queue::Array pq 133 int id 134 SV *filter 135 double new_priority 136 PPCODE: 137 if (pq_set_priority(pq, id, filter, new_priority)) { 138 EXTEND(SP, 1); 139 PUSHs(sv_2mortal(newSVnv(new_priority))); 140 } 141 142 void 143 pq_peek_items(pq, filter, ...) 144 POE::XS::Queue::Array pq 145 SV *filter 146 PREINIT: 147 pq_entry *ret_items; 148 int count, i; 149 int max_count; 150 PPCODE: 151 if (items == 3) 152 max_count = SvIV(ST(2)); 153 else 154 max_count = pq_get_item_count(pq); 155 count = pq_peek_items(pq, filter, max_count, &ret_items); 156 if (count) { 157 EXTEND(SP, count); 158 for (i = 0; i < count; ++i) { 159 pq_entry *entry = ret_items + i; 160 AV *av = newAV(); 161 SV *rv; 162 av_extend(av, 2); 163 av_store(av, 0, newSVnv(entry->priority)); 164 av_store(av, 1, newSViv(entry->id)); 165 av_store(av, 2, newSVsv(entry->payload)); 166 rv = newRV_noinc((SV *)av); 167 PUSHs(sv_2mortal(rv)); 168 } 169 myfree(ret_items); 170 } 171 172 void 173 pq_dump(pq) 174 POE::XS::Queue::Array pq 175 176 void 177 pq_verify(pq) 178 POE::XS::Queue::Array pq 179 180 # these are for testing errno is being set correctly for perl when 181 # set from XS 182 void 183 pq__set_errno_xs(value) 184 int value 185 CODE: 186 errno = value; 187 188 void 189 pq__set_errno_queue(value) 190 int value 191