File Coverage

CDB_File.xs
Criterion Covered Total %
statement 373 424 87.9
branch 218 318 68.5
condition n/a
subroutine n/a
pod n/a
total 591 742 79.6


line stmt bran cond sub pod time code
1             /*
2              
3             Most of this is reasonably straightforward. The complications arise
4             when we are "iterating" over the CDB file, that is to say, using `keys'
5             or `values' or `each' to retrieve all the data in the file in order.
6             This interface stores extra data to allow us to track iterations: end
7             is a pointer to the end of data in the CDB file, and also a flag which
8             indicates whether we are iterating or not (note that the end of data
9             occurs at a position >= 2048); curkey is a copy of the current key;
10             curpos is the file offset of curkey; and fetch_advance is 0 for
11              
12             FIRSTKEY, fetch, NEXTKEY, fetch, NEXTKEY, fetch, ...
13              
14             but 1 for
15              
16             FIRSTKEY, NEXTKEY, NEXTKEY, ..., fetch, fetch, fetch, ...
17              
18             Don't tell the OO Police, but there are actually two different objects
19             called CDB_File. One is created by TIEHASH, and accessed by the usual
20             tied hash methods (FETCH, FIRSTKEY, etc.). The other is created by new,
21             and accessed by insert and finish.
22              
23             In both cases, the object is a blessed reference to a scalar. The
24             scalar contains either a struct cdbobj or a struct cdbmakeobj.
25              
26             It gets a little messy in DESTROY: since this method will automatically
27             be called for both sorts of object, it distinguishes them by their
28             different sizes.
29              
30             */
31              
32             #ifdef __cplusplus
33             extern "C" {
34             #endif
35              
36             #include "EXTERN.h"
37             #include "perl.h"
38             #include "XSUB.h"
39             #include "ppport.h"
40              
41             #include
42             #include
43             #include
44             #include
45             #include
46             #include
47              
48             #ifdef WIN32
49             #define fsync _commit
50             #endif
51              
52             #ifdef HASMMAP
53             #include
54             #endif
55              
56             /* We need to whistle up an error number for a file that is not a CDB
57             file. The BSDish EFTYPE probably gives the most useful error message;
58             failing that we'll settle for the Single Unix Specification v2 EPROTO;
59             and finally the rather inappropriate, but universally(?) implemented,
60             EINVAL. */
61             #ifdef EFTYPE
62             #else
63             #ifdef EPROTO
64             #define EFTYPE EPROTO
65             #else
66             #define EFTYPE EINVAL
67             #endif
68             #endif
69              
70             #ifdef __cplusplus
71             }
72             #endif
73              
74             #if PERL_VERSION_LE(5,13,7)
75             #define CDB_FILE_HAS_UTF8_HASH_MACROS
76             #endif
77              
78             #if defined(SV_COW_REFCNT_MAX)
79             # define CDB_CAN_COW 1
80             #else
81             # define CDB_CAN_COW 0
82             #endif
83              
84             #if CDB_CAN_COW
85             # define CDB_DO_COW(sv) STMT_START { SvIsCOW_on(sv); CowREFCNT(sv) = 1; } STMT_END
86             #else
87             # define CDB_DO_COW(sv)
88             #endif
89              
90             #define cdb_datapos(c) ((c)->dpos)
91             #define cdb_datalen(c) ((c)->dlen)
92              
93             #define SET_FINDER_LEN(s, l) STMT_START { s.len = l; s.hash = 0; } STMT_END
94              
95             struct t_string_finder {
96             char *pv;
97             STRLEN len;
98             bool is_utf8;
99             bool pv_needs_free;
100             U32 hash;
101             };
102             typedef struct t_string_finder string_finder;
103              
104             struct t_cdb {
105             PerlIO *fh; /* */
106              
107             #ifdef HASMMAP
108             char *map;
109             #endif
110              
111             U32 end; /* If non zero, the file offset of the first byte of hash tables. */
112             bool is_utf8; /* will we be reading in utf8 encoded data? If so we'll set SvUTF8 = true; */
113             string_finder curkey; /* While iterating: the current key; */
114             STRLEN curkey_allocated;
115             U32 curpos; /* the file offset of the current record. */
116             int fetch_advance; /* the kludge */
117             U32 size; /* initialized if map is nonzero */
118             U32 loop; /* number of hash slots searched under this key */
119             U32 khash; /* initialized if loop is nonzero */
120             U32 kpos; /* initialized if loop is nonzero */
121             U32 hpos; /* initialized if loop is nonzero */
122             U32 hslots; /* initialized if loop is nonzero */
123             U32 dpos; /* initialized if cdb_findnext() returns 1 */
124             U32 dlen; /* initialized if cdb_findnext() returns 1 */
125             };
126              
127             typedef struct t_cdb cdb;
128              
129             #define CDB_HPLIST 1000
130              
131             struct cdb_hp { U32 h; U32 p; };
132              
133             struct cdb_hplist {
134             struct cdb_hp hp[CDB_HPLIST];
135             struct cdb_hplist *next;
136             int num;
137             };
138              
139             struct t_cdb_make {
140             PerlIO *f; /* Handle of file being created. */
141             bool is_utf8; /* Coerce the PV to utf8 before writing out the data? */
142             char *fn; /* Final name of file. */
143             char *fntemp; /* Temporary name of file. */
144             char final[2048];
145             char bspace[1024];
146             U32 count[256];
147             U32 start[256];
148             struct cdb_hplist *head;
149             struct cdb_hp *split; /* includes space for hash */
150             struct cdb_hp *hash;
151             U32 numentries;
152             U32 pos;
153             int fd;
154             };
155              
156             typedef struct t_cdb_make cdb_make;
157              
158             static int cdb_read(cdb *c, char *buf, unsigned int len, U32 pos);
159              
160 0           static void writeerror() { croak("Write to CDB_File failed: %s", Strerror(errno)); }
161              
162 2           static void readerror() { croak("Read of CDB_File failed: %s", Strerror(errno)); }
163              
164 0           static void nomem() { croak("Out of memory!"); }
165              
166 299           static inline SV * sv_from_datapos(cdb *c, STRLEN len) {
167             SV *sv;
168             char *buf;
169              
170 299           sv = newSV(len + 1 + CDB_CAN_COW);
171 299           SvPOK_on(sv);
172 299           CDB_DO_COW(sv);
173 299 100         if(c->is_utf8)
174 2           SvUTF8_on(sv);
175 299           buf = SvPVX(sv);
176 299 50         if (cdb_read(c, buf, len, cdb_datapos(c)) == -1)
177 0           readerror();
178 299           buf[len] = '\0';
179 299           SvCUR_set(sv, len);
180              
181 299           return sv;
182             }
183              
184 277           static inline SV * sv_from_curkey (cdb *c) {
185             SV* sv;
186 277           sv = newSV(c->curkey.len + 1 + CDB_CAN_COW);
187 277           sv_setpvn(sv, c->curkey.pv, c->curkey.len);
188 277           CDB_DO_COW(sv);
189 277 50         if(c->is_utf8)
190 0           SvUTF8_on(sv);
191              
192 277           return sv;
193             }
194              
195 16           static int cdb_make_start(cdb_make *c) {
196 16           c->head = 0;
197 16           c->split = 0;
198 16           c->hash = 0;
199 16           c->numentries = 0;
200 16           c->pos = sizeof c->final;
201 16           return PerlIO_seek(c->f, c->pos, SEEK_SET);
202             }
203              
204 285           static int posplus(cdb_make *c, U32 len) {
205 285           U32 newpos = c->pos + len;
206 285 50         if (newpos < len) {
207 0           errno = ENOMEM; return -1;
208             }
209 285           c->pos = newpos;
210 285           return 0;
211             }
212              
213 57           static int cdb_make_addend(cdb_make *c, unsigned int keylen, unsigned int datalen, U32 h) {
214             struct cdb_hplist *head;
215              
216 57           head = c->head;
217 57 100         if (!head || (head->num >= CDB_HPLIST)) {
    50          
218 14           New(0xCDB, head, 1, struct cdb_hplist);
219 14           head->num = 0;
220 14           head->next = c->head;
221 14           c->head = head;
222             }
223 57           head->hp[head->num].h = h;
224 57           head->hp[head->num].p = c->pos;
225 57           ++head->num;
226 57           ++c->numentries;
227 57 50         if (posplus(c, 8) == -1)
228 0           return -1;
229 57 50         if (posplus(c, keylen) == -1)
230 0           return -1;
231 57 50         if (posplus(c, datalen) == -1)
232 0           return -1;
233 57           return 0;
234             }
235              
236             #define CDB_HASHSTART 5381
237              
238             #define cdb_hashadd(hh, cc) ((hh + (hh << 5)) ^ (unsigned char) cc)
239              
240 205           static U32 cdb_hash(char *buf, unsigned int len) {
241             U32 h;
242              
243 205           h = CDB_HASHSTART;
244 954 100         while (len) {
245 749           h = cdb_hashadd(h,*buf++);
246 749           --len;
247             }
248 205           return h;
249             }
250              
251 8534           static void uint32_pack(char s[4], U32 u) {
252 8534           s[0] = u & 255;
253 8534           u >>= 8;
254 8534           s[1] = u & 255;
255 8534           u >>= 8;
256 8534           s[2] = u & 255;
257 8534           s[3] = u >> 8;
258 8534           }
259              
260 2309           static void uint32_unpack(char s[4], U32 *u) {
261             U32 result;
262              
263 2309           result = (unsigned char) s[3];
264 2309           result <<= 8;
265 2309           result += (unsigned char) s[2];
266 2309           result <<= 8;
267 2309           result += (unsigned char) s[1];
268 2309           result <<= 8;
269 2309           result += (unsigned char) s[0];
270              
271 2309           *u = result;
272 2309           }
273              
274 148           static void cdb_findstart(cdb *c) {
275 148           c->loop = 0;
276 148           }
277              
278             #ifdef HASMMAP
279 147           static inline char * cdb_map_addr(cdb *c, STRLEN len, U32 pos) {
280 147 50         if(c->map == NULL) croak("Called cdb_map_addr on a system without mmap");
281              
282 147 50         if ((pos > c->size) || (c->size - pos < len)) {
    50          
283 0           errno = EFTYPE;
284 0           return NULL;
285             }
286 147           return c->map + pos;
287             }
288             #endif
289              
290 2183           static int cdb_read(cdb *c, char *buf, unsigned int len, U32 pos) {
291              
292             #ifdef HASMMAP
293 2183 100         if (c->map) {
294 2182 50         if ((pos > c->size) || (c->size - pos < len)) {
    50          
295 0           errno = EFTYPE;
296 0           return -1;
297             }
298 2182           memcpy(buf, c->map + pos, len);
299 2182           return 0;
300             }
301             #endif
302              
303 1 50         if (PerlIO_seek(c->fh, pos, SEEK_SET) == -1) return -1;
304 1 50         while (len > 0) {
305             int r;
306             do
307 1           r = PerlIO_read(c->fh, buf, len);
308 1 50         while ((r == -1) && (errno == EINTR));
    0          
309 1 50         if (r == -1) return -1;
310 1 50         if (r == 0) {
311 1           errno = EFTYPE;
312 1           return -1;
313             }
314 0           buf += r;
315 0           len -= r;
316             }
317 0           return 0;
318             }
319              
320 470           static bool cdb_key_eq (string_finder *left, string_finder *right) {
321              
322             #if PERL_VERSION_GT(5,13,7)
323 470 50         if( left->is_utf8 != right->is_utf8 ) {
324 0 0         if(left->is_utf8)
325 0           return (bytes_cmp_utf8( (const U8 *) right->pv, right->len, (const U8 *) left->pv, left->len) == 0);
326             else
327 0           return (bytes_cmp_utf8( (const U8 *) left->pv, left->len, (const U8 *) right->pv, right->len) == 0);
328             }
329             #endif
330              
331 470 100         return (left->len == right->len) && memEQ(left->pv, right->pv, right->len);
    100          
332             }
333              
334             #define CDB_MATCH_BUFFER 256
335              
336 147           static int match(cdb *c, string_finder *to_find, U32 pos) {
337             string_finder nextkey;
338              
339             #ifdef HASMMAP
340             /* We don't have to allocate any memory if we're using mmap. */
341 147           nextkey.is_utf8 = c->is_utf8;
342 147           SET_FINDER_LEN(nextkey, to_find->len);
343 147           nextkey.pv = cdb_map_addr(c, to_find->len, pos);
344 147           return cdb_key_eq(&nextkey, to_find);
345             #else
346             /* If we don't have windows, then we have to read the file in */
347             int ret;
348             int len;
349             char static_buffer[CDB_MATCH_BUFFER];
350              
351             nextkey.is_utf8 = c->is_utf8;
352             SET_FINDER_LEN(nextkey, to_find->len);
353             len = nextkey.len;
354              
355             /* We only need to malloc a buffer if len >= 256 */
356             if(len < CDB_MATCH_BUFFER)
357             nextkey.pv = static_buffer;
358             else
359             Newx(nextkey.pv, len, char);
360              
361             if(cdb_read(c, nextkey.pv, len, pos) == -1)
362             return -1;
363              
364             ret = cdb_key_eq(&nextkey, to_find) ? 1 : 0;
365              
366             /* Only free if we had to malloc */
367             if (nextkey.pv != static_buffer)
368             Safefree(nextkey.pv);
369              
370             return ret;
371             #endif
372             }
373              
374 166           static int cdb_findnext(cdb *c, string_finder *to_find) {
375             char buf[8];
376             U32 pos;
377             U32 u;
378             U32 next_key_len;
379            
380             /* Matt: reset these so if a search fails they are zero'd */
381 166           c->dpos = 0;
382 166           c->dlen = 0;
383 166 100         if (!c->loop) {
384 148 50         if(to_find->hash != 0) /* hash cache (except when the value is 0) */
385 0           u = to_find->hash;
386             else
387 148           u = to_find->hash = cdb_hash(to_find->pv, to_find->len);
388              
389              
390 148 100         if (cdb_read(c,buf,8,(u << 3) & 2047) == -1)
391 1           return -1;
392 147           uint32_unpack(buf + 4, &c->hslots);
393 147 100         if (!c->hslots)
394 7           return 0;
395 140           uint32_unpack(buf,&c->hpos);
396 140           c->khash = u;
397 140           u >>= 8;
398 140           u %= c->hslots;
399 140           u <<= 3;
400 140           c->kpos = c->hpos + u;
401             }
402              
403 158 50         while (c->loop < c->hslots) {
404 158 50         if (cdb_read(c,buf,8,c->kpos) == -1)
405 0           return -1;
406 158           uint32_unpack(buf + 4,&pos);
407 158 100         if (!pos)
408 11           return 0;
409 147           c->loop += 1;
410 147           c->kpos += 8;
411 147 100         if (c->kpos == c->hpos + (c->hslots << 3))
412 118           c->kpos = c->hpos;
413 147           uint32_unpack(buf,&u);
414 147 50         if (u == c->khash) {
415 147 50         if (cdb_read(c,buf,8,pos) == -1)
416 0           return -1;
417 147           uint32_unpack(buf, &next_key_len);
418 147 50         if (next_key_len == to_find->len) {
419 147           switch(match(c, to_find, pos + 8)) {
420             case -1:
421 0           return -1;
422             case 0:
423 0           return 0;
424             default:
425 147           uint32_unpack(buf + 4,&c->dlen);
426 147           c->dpos = pos + 8 + next_key_len;
427 147           return 1;
428             }
429             }
430             }
431             }
432              
433 166           return 0;
434             }
435              
436 8           static int cdb_find(cdb *c, string_finder *to_find) {
437 8           cdb_findstart(c);
438 8           return cdb_findnext( c, to_find );
439             }
440              
441             #define CDB_DEFAULT_BUFFER_LEN 256
442             #define CDB_MAX_BUFFER_LEN 1024 * 64
443              
444 555           static inline void CDB_ASSURE_CURKEY_MEM(cdb *c, STRLEN len) {
445             STRLEN newlen;
446              
447             /* Nothing to do. We already have enough memory. */
448 555 100         if (c->curkey_allocated >= len && c->curkey_allocated < CDB_MAX_BUFFER_LEN) return;
    50          
449              
450             /* What's the new size? */
451 7 50         if(len < CDB_MAX_BUFFER_LEN && c->curkey_allocated > CDB_MAX_BUFFER_LEN) {
    50          
452 0           newlen = (len > CDB_DEFAULT_BUFFER_LEN) ? len : CDB_DEFAULT_BUFFER_LEN;
453             }
454             else {
455 7           newlen = len - len % 1024 + 1024; /* Grow by a multiple of 1024. */
456             }
457              
458 7 50         if(c->curkey.pv)
459 0           Renew(c->curkey.pv, newlen, char);
460             else
461 7           Newx (c->curkey.pv, newlen, char);
462              
463 7           c->curkey.pv[newlen-1] = 0;
464              
465 7           c->curkey_allocated = newlen;
466             }
467              
468 56           static void iter_start(cdb *c) {
469             char buf[4];
470              
471 56           c->curpos = 2048;
472 56 50         if (cdb_read(c, buf, 4, 0) == -1)
473 0           readerror();
474 56           uint32_unpack(buf, &c->end);
475              
476 56           SET_FINDER_LEN(c->curkey, 0);
477 56           c->fetch_advance = 0;
478 56           }
479              
480 456           static int iter_key(cdb *c) {
481             char buf[8];
482             U32 klen;
483              
484 456 100         if (c->curpos < c->end) {
485 409 50         if (cdb_read(c, buf, 8, c->curpos) == -1)
486 0           readerror();
487 409           uint32_unpack(buf, &klen);
488              
489 409           SET_FINDER_LEN(c->curkey, klen);
490 409           CDB_ASSURE_CURKEY_MEM(c, klen);
491 409 50         if (cdb_read(c, c->curkey.pv, klen, c->curpos + 8) == -1)
492 0           readerror();
493 409           return 1;
494             }
495 456           return 0;
496             }
497              
498 401           static void iter_advance(cdb *c) {
499             char buf[8];
500             U32 klen, dlen;
501              
502 401 50         if (cdb_read(c, buf, 8, c->curpos) == -1)
503 0           readerror();
504 401           uint32_unpack(buf, &klen);
505 401           uint32_unpack(buf + 4, &dlen);
506 401           c->curpos += 8 + klen + dlen;
507 401           }
508              
509 42           static void iter_end(cdb *c) {
510 42 100         if (c->end != 0) {
511 31           c->end = 0;
512 31           SET_FINDER_LEN(c->curkey, 0);
513             }
514 42           }
515              
516             typedef PerlIO * InputStream;
517              
518             MODULE = CDB_File PACKAGE = CDB_File PREFIX = cdb_
519              
520             PROTOTYPES: DISABLED
521              
522             # Some accessor methods.
523              
524             # WARNING: I don't really understand enough about Perl's guts (file
525             # handles / globs, etc.) to write this code. I think this is right, and
526             # it seems to work, but input from anybody with a deeper
527             # understanding would be most welcome.
528              
529             # Additional: fixed by someone with a deeper understanding ;-) (Matt Sergeant)
530              
531             InputStream
532             cdb_handle(this)
533             cdb * this
534              
535             CODE:
536             /* here we dup the filehandle, because perl space will try and close
537             it when it goes out of scope */
538 1           RETVAL = PerlIO_fdopen(PerlIO_fileno(this->fh), "r");
539             OUTPUT:
540             RETVAL
541              
542             U32
543             cdb_datalen(db)
544             cdb *db
545              
546             CODE:
547 6           RETVAL = cdb_datalen(db);
548              
549             OUTPUT:
550             RETVAL
551              
552             U32
553             cdb_datapos(db)
554             cdb *db
555              
556             CODE:
557 6           RETVAL = cdb_datapos(db);
558              
559             OUTPUT:
560             RETVAL
561              
562             cdb *
563             cdb_TIEHASH(CLASS, filename, option_key="", is_utf8=FALSE)
564             char *CLASS
565             char *filename
566             char *option_key
567             bool is_utf8
568              
569             PREINIT:
570             PerlIO *f;
571 18           bool utf8_chosen = FALSE;
572              
573             CODE:
574 18 100         if(strlen(option_key) == 4 && strnEQ("utf8", option_key, 4) && is_utf8 )
    50          
    100          
575             #ifdef CDB_FILE_HAS_UTF8_HASH_MACROS
576             croak("utf8 CDB_Files are not supported below Perl 5.14");
577             #else
578 1           utf8_chosen = TRUE;
579             #endif
580              
581 18           Newxz(RETVAL, 1, cdb);
582 18           RETVAL->fh = f = PerlIO_open(filename, "rb");
583 18           RETVAL->is_utf8 = utf8_chosen;
584              
585 18 100         if (!f)
586 1           XSRETURN_NO;
587             #ifdef HASMMAP
588             {
589             struct stat st;
590 17           int fd = PerlIO_fileno(f);
591              
592 17           RETVAL->map = 0;
593 17 50         if (fstat(fd, &st) == 0) {
594 17 50         if (st.st_size <= 0xffffffff) {
595             char *x;
596              
597 17           x = mmap(0, st.st_size, PROT_READ, MAP_SHARED, fd, 0);
598 17 100         if (x != (char *)-1) {
599 16           RETVAL->size = st.st_size;
600 16           RETVAL->map = x;
601             }
602             }
603             }
604             }
605             #endif
606             OUTPUT:
607             RETVAL
608              
609             SV *
610             cdb_FETCH(this, k)
611             cdb *this
612             SV *k
613              
614             PREINIT:
615             char buf[8];
616             int found;
617             string_finder to_find;
618              
619             CODE:
620 175 100         if (!SvOK(k)) {
    50          
    50          
621 1           XSRETURN_UNDEF;
622             }
623              
624 174 100         to_find.pv = this->is_utf8 ? SvPVutf8(k, to_find.len) : SvPV(k, to_find.len);
    100          
    50          
625 174           to_find.hash = 0;
626 174 100         to_find.is_utf8 = this->is_utf8 && SvUTF8(k);
    50          
627              
628             /* Already advanced to the key we need. */
629 174 100         if (this->end && cdb_key_eq(&this->curkey, &to_find)) {
    100          
630 156 50         if (cdb_read(this, buf, 8, this->curpos) == -1)
631 0           readerror();
632 156           uint32_unpack(buf + 4, &this->dlen);
633 156           this->dpos = this->curpos + 8 + to_find.len;
634 156 100         if (this->fetch_advance) {
635 126           iter_advance(this);
636 126 100         if (!iter_key(this)) {
637 13           iter_end(this);
638             }
639             }
640 156           found = 1;
641             } else {
642             /* Need to find the key first.. */
643 18           cdb_findstart(this);
644 18           found = cdb_findnext(this, &to_find);
645 18 100         if ((found != 0) && (found != 1)) readerror();
    100          
646             }
647              
648 173 100         if (found) {
649             U32 dlen;
650 171           dlen = cdb_datalen(this);
651 171           RETVAL = sv_from_datapos(this, dlen);
652             }
653             else {
654 2           XSRETURN_UNDEF;
655             }
656             OUTPUT:
657             RETVAL
658              
659             HV *
660             cdb_fetch_all(this)
661             cdb *this
662              
663             PREINIT:
664             U32 dlen;
665             SV *keyvalue;
666             SV *keysv;
667             int found;
668              
669             CODE:
670 12           RETVAL = newHV();
671 12           sv_2mortal((SV *)RETVAL);
672 12           iter_start(this);
673              
674 122 100         while(iter_key(this)) {
675 110           cdb_findstart(this);
676 110           found = cdb_findnext(this, &this->curkey);
677 110 50         if ((found != 0) && (found != 1))
    50          
678 0           readerror();
679              
680 110           dlen = cdb_datalen(this);
681              
682 110           keyvalue = sv_from_datapos(this, dlen);
683 110           keysv = sv_from_curkey(this);
684              
685 110 50         if (! hv_store_ent(RETVAL, keysv, keyvalue, 0)) {
686 0           SvREFCNT_dec(keyvalue);
687             }
688 110           SvREFCNT_dec(keysv);
689 110           iter_advance(this);
690             }
691 12           iter_end(this);
692              
693             OUTPUT:
694             RETVAL
695              
696              
697             AV *
698             cdb_multi_get(this, k)
699             cdb *this
700             SV *k
701              
702             PREINIT:
703             int found;
704             U32 dlen;
705             SV *x;
706             string_finder to_find;
707              
708             CODE:
709 12 50         if (!SvOK(k)) {
    0          
    0          
710 0           XSRETURN_UNDEF;
711             }
712 12           cdb_findstart(this);
713 12           RETVAL = newAV();
714 12           sv_2mortal((SV *)RETVAL);
715              
716 12 50         to_find.pv = this->is_utf8 ? SvPVutf8(k, to_find.len) : SvPV(k, to_find.len);
    0          
    100          
717 12           to_find.hash = 0;
718 12           to_find.is_utf8 = SvUTF8(k);
719              
720             for (;;) {
721 30           found = cdb_findnext(this, &to_find);
722 30 100         if ((found != 0) && (found != 1))
    50          
723 0           readerror();
724 30 100         if (!found)
725 12           break;
726              
727 18           dlen = cdb_datalen(this);
728              
729 18           x = sv_from_datapos(this, dlen);
730 18           av_push(RETVAL, x);
731 18           }
732              
733             OUTPUT:
734             RETVAL
735              
736             int
737             cdb_EXISTS(this, k)
738             cdb *this
739             SV *k
740              
741             PREINIT:
742             string_finder to_find;
743              
744             CODE:
745 9 100         if (!SvOK(k)) {
    50          
    50          
746 1           XSRETURN_NO;
747             }
748              
749 8 50         to_find.pv = this->is_utf8 ? SvPVutf8(k, to_find.len) : SvPV(k, to_find.len);
    0          
    50          
750 8           to_find.hash = 0;
751 8           to_find.is_utf8 = SvUTF8(k);
752              
753 8           RETVAL = cdb_find(this, &to_find);
754 8 100         if (RETVAL != 0 && RETVAL != 1)
    50          
755 0           readerror();
756              
757             OUTPUT:
758             RETVAL
759              
760             void
761             cdb_DESTROY(db)
762             SV *db
763              
764             PREINIT:
765             cdb *this;
766              
767             CODE:
768 18 50         if (sv_isobject(db) && (SvTYPE(SvRV(db)) == SVt_PVMG) ) {
    100          
769 17 50         this = (cdb*)SvIV(SvRV(db));
770              
771 17 100         if (this->curkey.pv)
772 7           Safefree(this->curkey.pv);
773              
774 17           iter_end(this);
775             #ifdef HASMMAP
776 17 100         if (this->map) {
777 16           munmap(this->map, this->size);
778 16           this->map = 0;
779             }
780             #endif
781 17           PerlIO_close(this->fh); /* close() on O_RDONLY cannot fail */
782 17           Safefree(this);
783             }
784              
785             SV *
786             cdb_FIRSTKEY(this)
787             cdb *this
788              
789             CODE:
790 24           iter_start(this);
791 24 100         if (iter_key(this)) {
792 21           RETVAL = sv_from_curkey(this);
793             } else {
794 3           XSRETURN_UNDEF; /* empty database */
795             }
796             OUTPUT:
797             RETVAL
798              
799             SV *
800             cdb_NEXTKEY(this, k)
801             cdb *this
802             SV *k
803              
804             PREINIT:
805             string_finder to_find;
806              
807             CODE:
808 165 50         if (!SvOK(k)) {
    0          
    0          
809 0           XSRETURN_UNDEF;
810             }
811              
812 165 50         to_find.pv = this->is_utf8 ? SvPVutf8(k, to_find.len) : SvPV(k, to_find.len);
    0          
    50          
813 165           to_find.hash = 0;
814 165           to_find.is_utf8 = SvUTF8(k);
815              
816             /* Sometimes NEXTKEY gets called before FIRSTKEY if the hash
817             * gets re-tied so we call iter_start() anyway here */
818 165 100         if (this->end == 0 || !cdb_key_eq(&this->curkey, &to_find))
    50          
819 1           iter_start(this);
820 165           iter_advance(this);
821 165 100         if (iter_key(this)) {
822 146           CDB_ASSURE_CURKEY_MEM(this, this->curkey.len);
823 146           RETVAL = sv_from_curkey(this);
824             } else {
825 19           iter_start(this);
826 19           (void)iter_key(this); /* prepare curkey for FETCH */
827 19           this->fetch_advance = 1;
828 19           XSRETURN_UNDEF;
829             }
830             OUTPUT:
831             RETVAL
832              
833             cdb_make *
834             cdb_new(CLASS, fn, fntemp, option_key="", is_utf8=FALSE)
835             char * CLASS
836             char * fn
837             char * fntemp
838             char * option_key
839             bool is_utf8;
840              
841             PREINIT:
842             cdb_make *cdbmake;
843 17           bool utf8_chosen = FALSE;
844              
845             CODE:
846 17 100         if(strlen(option_key) == 4 && strnEQ("utf8", option_key, 4) && is_utf8 )
    50          
    100          
847             #ifdef CDB_FILE_HAS_UTF8_HASH_MACROS
848             croak("utf8 CDB_Files are not supported below Perl 5.14");
849             #else
850 2           utf8_chosen = TRUE;
851             #endif
852              
853 17           Newxz(cdbmake, 1, cdb_make);
854 17           cdbmake->f = PerlIO_open(fntemp, "wb");
855 17           cdbmake->is_utf8 = utf8_chosen;
856              
857 17 100         if (!cdbmake->f) XSRETURN_UNDEF;
858              
859 16 50         if (cdb_make_start(cdbmake) < 0) XSRETURN_UNDEF;
860              
861             /* Oh, for referential transparency. */
862 16           New(0, cdbmake->fn, strlen(fn) + 1, char);
863 16           New(0, cdbmake->fntemp, strlen(fntemp) + 1, char);
864 16           strcpy(cdbmake->fn, fn);
865 16           strcpy(cdbmake->fntemp, fntemp);
866              
867 16           CLASS = "CDB_File::Maker"; /* OK, so this is a hack */
868              
869 16           RETVAL = cdbmake;
870              
871             OUTPUT:
872             RETVAL
873              
874             MODULE = CDB_File PACKAGE = CDB_File::Maker PREFIX = cdbmaker_
875              
876             void
877             cdbmaker_DESTROY(sv)
878             SV * sv
879              
880             PREINIT:
881             cdb_make * this;
882              
883             CODE:
884 16 50         if (sv_isobject(sv) && (SvTYPE(SvRV(sv)) == SVt_PVMG) ) {
    50          
885 16 50         this = (cdb_make*)SvIV(SvRV(sv));
886 16 50         if(this->f) {
887 0           PerlIO_close(this->f);
888             }
889 16           Safefree(this);
890             }
891              
892             void
893             cdbmaker_insert(this, ...)
894             cdb_make * this
895              
896             PREINIT:
897             char *kp, *vp, packbuf[8];
898             int x;
899             bool is_utf8;
900             STRLEN klen, vlen;
901             U32 h;
902             SV *k;
903             SV *v;
904              
905             PPCODE:
906 50           is_utf8 = this->is_utf8;
907              
908 107 100         for (x = 1; x < items; x += 2) {
909 57           k = ST(x);
910 57           v = ST(x+1);
911              
912 57 100         if(!SvOK(k)) {
    50          
    50          
913 1           Perl_warn(aTHX_ "Use of uninitialized value in hash key");
914 1           k = sv_2mortal(newSVpv("", 0));
915             }
916              
917 57 100         if(!SvOK(v)) {
    50          
    50          
918 2           Perl_warn(aTHX_ "undef values cannot be stored in CDB_File. Storing an empty string instead");
919 2           v = sv_2mortal(newSVpv("", 0));
920             }
921              
922 57 100         kp = is_utf8 ? SvPVutf8(k, klen) : SvPV(k, klen);
    100          
    100          
923 57 100         vp = is_utf8 ? SvPVutf8(v, vlen) : SvPV(v, vlen);
    100          
    100          
924              
925 57           uint32_pack(packbuf, klen);
926 57           uint32_pack(packbuf + 4, vlen);
927              
928 57 50         if (PerlIO_write(this->f, packbuf, 8) < 8)
929 0           writeerror();
930              
931 57           h = cdb_hash(kp, klen);
932 57 50         if (PerlIO_write(this->f, kp, klen) < klen)
933 0           writeerror();
934 57 50         if (PerlIO_write(this->f, vp, vlen) < vlen)
935 0           writeerror();
936              
937 57 50         if (cdb_make_addend(this, klen, vlen, h) == -1)
938 0           nomem();
939             }
940              
941             int
942             cdbmaker_finish(this)
943             cdb_make *this
944              
945             PREINIT:
946             char buf[8];
947             int i;
948             U32 len, u;
949             U32 count, memsize, where;
950             struct cdb_hplist *x, *prev;
951             struct cdb_hp *hp;
952              
953             CODE:
954 4112 100         for (i = 0; i < 256; ++i)
955 4096           this->count[i] = 0;
956              
957 30 100         for (x = this->head; x; x = x->next) {
958 14           i = x->num;
959 71 100         while (i--) {
960 57           ++this->count[255 & x->hp[i].h];
961             }
962             }
963              
964 16           memsize = 1;
965 4112 100         for (i = 0; i < 256; ++i) {
966 4096           u = this->count[i] * 2;
967 4096 100         if (u > memsize)
968 14           memsize = u;
969             }
970              
971 16           memsize += this->numentries; /* no overflow possible up to now */
972 16           u = (U32) 0 - (U32) 1;
973 16           u /= sizeof(struct cdb_hp);
974 16 50         if (memsize > u) {
975 0           errno = ENOMEM;
976 0           XSRETURN_UNDEF;
977             }
978              
979 16 50         New(0xCDB, this->split, memsize, struct cdb_hp);
980              
981 16           this->hash = this->split + this->numentries;
982              
983 16           u = 0;
984 4112 100         for (i = 0; i < 256; ++i) {
985 4096           u += this->count[i]; /* bounded by numentries, so no overflow */
986 4096           this->start[i] = u;
987             }
988              
989 16           prev = 0;
990 30 100         for (x = this->head; x; x = x->next) {
991 14           i = x->num;
992 71 100         while (i--) {
993 57           this->split[--this->start[255 & x->hp[i].h]] = x->hp[i];
994             }
995              
996 14 50         if (prev)
997 0           Safefree(prev);
998 14           prev = x;
999             }
1000              
1001 16 100         if (prev)
1002 14           Safefree(prev);
1003              
1004 4112 100         for (i = 0; i < 256; ++i) {
1005 4096           count = this->count[i];
1006              
1007 4096           len = count + count; /* no overflow possible */
1008 4096           uint32_pack(this->final + 8 * i, this->pos);
1009 4096           uint32_pack(this->final + 8 * i + 4, len);
1010              
1011 4210 100         for (u = 0; u < len; ++u) {
1012 114           this->hash[u].h = this->hash[u].p = 0;
1013             }
1014              
1015 4096           hp = this->split + this->start[i];
1016 4153 100         for (u = 0; u < count; ++u) {
1017 57           where = (hp->h >> 8) % len;
1018 60 100         while (this->hash[where].p) {
1019 3 100         if (++where == len)
1020 2           where = 0;
1021             }
1022              
1023 57           this->hash[where] = *hp++;
1024             }
1025              
1026 4210 100         for (u = 0; u < len; ++u) {
1027 114           uint32_pack(buf, this->hash[u].h);
1028 114           uint32_pack(buf + 4, this->hash[u].p);
1029              
1030 114 50         if (PerlIO_write(this->f, buf, 8) == -1)
1031 0           XSRETURN_UNDEF;
1032              
1033 114 50         if (posplus(this, 8) == -1)
1034 0           XSRETURN_UNDEF;
1035             }
1036             }
1037              
1038 16           Safefree(this->split);
1039              
1040 16 50         if (PerlIO_flush(this->f) == EOF) writeerror();
1041 16           PerlIO_rewind(this->f);
1042              
1043 16 50         if (PerlIO_write(this->f, this->final, sizeof this->final) < sizeof this->final)
1044 0           writeerror();
1045              
1046 16 50         if (PerlIO_flush(this->f) == EOF)
1047 0           writeerror();
1048              
1049 16 50         if (fsync(PerlIO_fileno(this->f)) == -1)
1050 0           XSRETURN_NO;
1051              
1052 16 50         if (PerlIO_close(this->f) == EOF)
1053 0           XSRETURN_NO;
1054 16           this->f=0;
1055              
1056 16 50         if (rename(this->fntemp, this->fn)) {
1057 0           croak("Failed to rename %s to %s.", this->fntemp, this->fn);
1058             }
1059              
1060 16           Safefree(this->fn);
1061 16           Safefree(this->fntemp);
1062              
1063 16           RETVAL = 1;
1064              
1065             OUTPUT:
1066             RETVAL