File Coverage

lib/List/UtilsBy/XS.xs
Criterion Covered Total %
statement 343 357 96.0
branch 245 354 69.2
condition n/a
subroutine n/a
pod n/a
total 588 711 82.7


line stmt bran cond sub pod time code
1             #include "EXTERN.h"
2             #include "perl.h"
3             #include "XSUB.h"
4              
5             #include "ppport.h"
6              
7             struct sort_elem {
8             SV *key;
9             SV *orig;
10             };
11              
12             static I32
13 3           sv_cmp_str_asc(pTHX_ SV *sv1, SV *sv2)
14             {
15             struct sort_elem *se1, *se2;
16              
17 3 50         se1 = (struct sort_elem*)SvIV(sv1);
18 3 50         se2 = (struct sort_elem*)SvIV(sv2);
19              
20 3           return sv_cmp_locale(se1->key, se2->key);
21             }
22              
23             static I32
24 2           sv_cmp_str_desc(pTHX_ SV *sv1, SV *sv2)
25             {
26             struct sort_elem *se1, *se2;
27              
28 2 50         se1 = (struct sort_elem*)SvIV(sv1);
29 2 50         se2 = (struct sort_elem*)SvIV(sv2);
30              
31 2           return sv_cmp_locale(se2->key, se1->key);
32             }
33              
34             static I32
35 29           sv_cmp_number_asc(pTHX_ SV *sv1, SV *sv2)
36             {
37             struct sort_elem *se1, *se2;
38             NV key1, key2;
39              
40 29 50         se1 = (struct sort_elem*)SvIV(sv1);
41 29 50         se2 = (struct sort_elem*)SvIV(sv2);
42              
43 29 100         key1 = SvNV(se1->key);
44 29 100         key2 = SvNV(se2->key);
45              
46 29           return (key1 > key2)
47 29 100         ? 1 : (key1 == key2)
    100          
48             ? 0 : -1;
49             }
50              
51             static I32
52 33           sv_cmp_number_desc(pTHX_ SV *sv1, SV *sv2)
53             {
54             struct sort_elem *se1, *se2;
55             NV key1, key2;
56              
57 33 50         se1 = (struct sort_elem*)SvIV(sv1);
58 33 50         se2 = (struct sort_elem*)SvIV(sv2);
59              
60 33 100         key1 = SvNV(se2->key);
61 33 100         key2 = SvNV(se1->key);
62              
63 33           return (key1 > key2)
64 33 100         ? 1 : (key1 == key2)
    100          
65             ? 0 : -1;
66             }
67              
68             MODULE = List::UtilsBy::XS PACKAGE = List::UtilsBy::XS
69              
70             void
71             sort_by (code, ...)
72             SV *code
73             PROTOTYPE: &@
74             ALIAS:
75             sort_by = 0
76             rev_sort_by = 1
77             CODE:
78             {
79             dMULTICALL;
80             GV *gv;
81             HV *stash;
82             I32 gimme = G_SCALAR;
83             SV **args = &PL_stack_base[ax];
84             int i;
85             AV *tmps;
86             struct sort_elem *elems;
87              
88 9 100         if (items <= 1) {
89 2           XSRETURN_EMPTY;
90             }
91              
92 7           tmps = (AV *)sv_2mortal((SV *)newAV());
93              
94 7           cv = sv_2cv(code, &stash, &gv, 0);
95 7 50         if (cv == Nullcv) {
96 0           croak("Not a subroutine reference");
97             }
98              
99 7 50         PUSH_MULTICALL(cv);
    50          
100 7           SAVESPTR(GvSV(PL_defgv));
101              
102 7 50         Newx(elems, items - 1, struct sort_elem);
103              
104 19 100         for (i = 1; i < items; i++) {
105 12           struct sort_elem *elem = &elems[i - 1];
106              
107 12           GvSV(PL_defgv) = args[i];
108 12           MULTICALL;
109              
110 12           elem->key = newSVsv(*PL_stack_sp);
111 12           elem->orig = newSVsv(args[i]);
112              
113 12           av_push(tmps, newSViv((IV)elem));
114             }
115              
116 7 50         POP_MULTICALL;
    50          
117              
118 7 100         if (ix) {
119 7           sortsv(AvARRAY(tmps), av_len(tmps) + 1, sv_cmp_str_desc);
120             } else {
121 5           sortsv(AvARRAY(tmps), av_len(tmps) + 1, sv_cmp_str_asc);
122             }
123              
124 19 100         for (i = 1; i < items; i++) {
125             struct sort_elem *elem;
126 12 50         elem = (struct sort_elem *)SvIV(*av_fetch(tmps, i-1, 0));
127 12           ST(i-1) = sv_2mortal(elem->orig);
128 12           (void)sv_2mortal(elem->key);
129             }
130              
131 7           Safefree(elems);
132              
133 7           XSRETURN(items - 1);
134             }
135              
136             void
137             nsort_by (code, ...)
138             SV *code
139             PROTOTYPE: &@
140             ALIAS:
141             nsort_by = 0
142             rev_nsort_by = 1
143             CODE:
144             {
145             dMULTICALL;
146             GV *gv;
147             HV *stash;
148             I32 gimme = G_SCALAR;
149             SV **args = &PL_stack_base[ax];
150             int i;
151             AV *tmps;
152             struct sort_elem *elems;
153              
154 14 100         if (items <= 1) {
155 2           XSRETURN_EMPTY;
156             }
157              
158 12           tmps = (AV *)sv_2mortal((SV *)newAV());
159              
160 12           cv = sv_2cv(code, &stash, &gv, 0);
161 12 50         if (cv == Nullcv) {
162 0           croak("Not a subroutine reference");
163             }
164              
165 12 50         PUSH_MULTICALL(cv);
    50          
166 12           SAVESPTR(GvSV(PL_defgv));
167              
168 12 50         Newx(elems, items - 1, struct sort_elem);
169              
170 40 100         for (i = 1; i < items; i++) {
171 28           struct sort_elem *elem = &elems[i - 1];
172              
173 28           GvSV(PL_defgv) = args[i];
174 28           MULTICALL;
175              
176 28           elem->key = newSVsv(*PL_stack_sp);
177 28           elem->orig = newSVsv(args[i]);
178              
179 28           av_push(tmps, newSViv((IV)elem));
180             }
181              
182 12 50         POP_MULTICALL;
    50          
183              
184 12 100         if (ix) {
185 12           sortsv(AvARRAY(tmps), av_len(tmps) + 1, sv_cmp_number_desc);
186             } else {
187 6           sortsv(AvARRAY(tmps), av_len(tmps) + 1, sv_cmp_number_asc);
188             }
189              
190 40 100         for (i = 1; i < items; i++) {
191             struct sort_elem *elem;
192 28 50         elem = (struct sort_elem *)SvIV(*av_fetch(tmps, i-1, 0));
193 28           ST(i-1) = sv_2mortal(elem->orig);
194 28           (void)sv_2mortal(elem->key);
195             }
196              
197 12           Safefree(elems);
198              
199 12           XSRETURN(items - 1);
200             }
201              
202             void
203             min_by (code, ...)
204             SV *code
205             PROTOTYPE: &@
206             ALIAS:
207             min_by = 0
208             max_by = 1
209             nmin_by = 2
210             nmax_by = 3
211             CODE:
212             {
213             dMULTICALL;
214             GV *gv;
215             HV *stash;
216             I32 gimme = G_SCALAR;
217 19           SV **args = &ST(1);
218 19           I32 const len = items - 1;
219             int i;
220             AV *tmps;
221             NV max;
222             IV ret_count = 0;
223             struct sort_elem *elems, *first;
224              
225 19 100         if (len < 1) {
226 2           XSRETURN_EMPTY;
227             }
228              
229 17           tmps = (AV *)sv_2mortal((SV *)newAV());
230              
231 17           cv = sv_2cv(code, &stash, &gv, 0);
232 17 50         if (cv == Nullcv) {
233 0           croak("Not a subroutine reference");
234             }
235              
236 17 50         PUSH_MULTICALL(cv);
    50          
237 17           SAVESPTR(GvSV(PL_defgv));
238              
239 17 50         Newx(elems, items - 1, struct sort_elem);
240              
241 61 100         for (i = 0; i < len; i++) {
242 44           struct sort_elem *elem = &elems[i];
243              
244 44           GvSV(PL_defgv) = args[i];
245 44           MULTICALL;
246              
247 44           elem->key = newSVsv(*PL_stack_sp);
248 44           elem->orig = newSVsv(args[i]);
249              
250 44           av_push(tmps, newSViv((IV)elem));
251             }
252              
253 17 50         POP_MULTICALL;
    50          
254              
255 17 100         if (ix & 0x1) {
256 17           sortsv(AvARRAY(tmps), len, sv_cmp_number_desc);
257             } else {
258 8           sortsv(AvARRAY(tmps), len, sv_cmp_number_asc);
259             }
260              
261 61 100         for(i = 0; i < len; i++) {
262 44           struct sort_elem* elem
263 44 50         = (struct sort_elem*)SvIVx(*av_fetch(tmps, i, TRUE));
264 44           sv_2mortal(elem->key);
265 44           sv_2mortal(elem->orig);
266             }
267              
268 17 50         first = (struct sort_elem *)SvIV(*av_fetch(tmps, 0, 0));
269 17 100         max = SvNV(first->key);
270 17           ST(0) = first->orig;
271             ret_count++;
272              
273 17 50         if (GIMME_V != G_ARRAY) {
    100          
274             goto ret;
275             }
276              
277 9 100         for (i = 2; i < items; i++) {
278             struct sort_elem *elem;
279 7 50         elem = (struct sort_elem *)SvIV(*av_fetch(tmps, i-1, 0));
280              
281 7 50         if (max == SvNV(elem->key)) {
    100          
282 2           ST(ret_count) = elem->orig;
283 2           ret_count++;
284             } else {
285             goto ret;
286             }
287             }
288              
289             ret:
290 17           Safefree(elems);
291 17           XSRETURN(ret_count);
292             }
293              
294             void
295             uniq_by (code, ...)
296             SV *code
297             PROTOTYPE: &@
298             CODE:
299             {
300             dMULTICALL;
301             GV *gv;
302             HV *stash;
303             I32 gimme = G_SCALAR;
304             SV **args = &PL_stack_base[ax];
305             int i;
306             AV *tmps;
307             HV *rh;
308              
309 5 100         if (items <= 1) {
310 1           XSRETURN_EMPTY;
311             }
312              
313 4           tmps = (AV *)sv_2mortal((SV *)newAV());
314 4           rh = (HV *)sv_2mortal((SV *)newHV());
315              
316 4           cv = sv_2cv(code, &stash, &gv, 0);
317 4 50         if (cv == Nullcv) {
318 0           croak("Not a subroutine reference");
319             }
320              
321 4 50         PUSH_MULTICALL(cv);
    50          
322 4           SAVESPTR(GvSV(PL_defgv));
323              
324 14 100         for (i = 1; i < items; i++) {
325             STRLEN len;
326             char *str;
327              
328 10           GvSV(PL_defgv) = args[i];
329 10           MULTICALL;
330              
331 10 100         str = SvPV(*PL_stack_sp, len);
332 10 100         if (!hv_exists(rh, str, len)) {
333 8           av_push(tmps, newSVsv(args[i]));
334 8           (void)hv_store(rh, str, len, newSViv(1), 0);
335             }
336             }
337              
338 4 50         POP_MULTICALL;
    50          
339              
340 12 100         for (i = 0; i <= av_len(tmps); i++) {
341 8           ST(i) = *av_fetch(tmps, i, 0);
342             }
343              
344 4           XSRETURN(av_len(tmps) + 1);
345             }
346              
347             void
348             partition_by (code, ...)
349             SV *code
350             PROTOTYPE: &@
351             CODE:
352             {
353             dMULTICALL;
354             GV *gv;
355             HV *stash;
356             I32 gimme = G_SCALAR;
357             SV **args = &PL_stack_base[ax];
358             int i;
359             HV *rh;
360             HE *iter = NULL;
361              
362 5 100         if (items <= 1) {
363 1           XSRETURN_EMPTY;
364             }
365              
366 4           rh = (HV *)sv_2mortal((SV *)newHV());
367              
368 4           cv = sv_2cv(code, &stash, &gv, 0);
369 4 50         if (cv == Nullcv) {
370 0           croak("Not a subroutine reference");
371             }
372              
373 4 50         PUSH_MULTICALL(cv);
    50          
374 4           SAVESPTR(GvSV(PL_defgv));
375              
376 14 100         for (i = 1; i < items; i++) {
377             STRLEN len;
378             char *str;
379              
380 10           GvSV(PL_defgv) = args[i];
381 10           MULTICALL;
382              
383 10 100         str = SvPV(*PL_stack_sp, len);
384 10 100         if (!hv_exists(rh, str, len)) {
385 6           AV* av = (AV *)sv_2mortal((SV *)newAV());
386 6           av_push(av, newSVsv(args[i]));
387 6           (void)hv_store(rh, str, len, newRV_inc((SV *)av), 0);
388             } else {
389 4           AV *av = (AV *)SvRV(*hv_fetch(rh, str, len, 0));
390 4           av_push(av, newSVsv(args[i]));
391             }
392             }
393              
394 4 50         POP_MULTICALL;
    50          
395              
396 4           hv_iterinit(rh);
397              
398             i = 0;
399 10 100         while ( (iter = hv_iternext( rh )) != NULL ) {
400 6           ST(i) = hv_iterkeysv(iter);
401 6           i++;
402 6           ST(i) = hv_iterval(rh, iter);
403 6           i++;
404             }
405              
406 4           XSRETURN(i);
407             }
408              
409             void
410             count_by (code, ...)
411             SV *code
412             PROTOTYPE: &@
413             CODE:
414             {
415             dMULTICALL;
416             GV *gv;
417             HV *stash;
418             I32 gimme = G_SCALAR;
419             SV **args = &PL_stack_base[ax];
420             int i;
421             HV *rh;
422             HE *iter = NULL;
423              
424 4 100         if (items <= 1) {
425 1           XSRETURN_EMPTY;
426             }
427              
428 3           rh = (HV *)sv_2mortal((SV *)newHV());
429              
430 3           cv = sv_2cv(code, &stash, &gv, 0);
431 3 50         if (cv == Nullcv) {
432 0           croak("Not a subroutine reference");
433             }
434              
435 3 50         PUSH_MULTICALL(cv);
    50          
436 3           SAVESPTR(GvSV(PL_defgv));
437              
438 11 100         for (i = 1; i < items; i++) {
439             STRLEN len;
440             char *str;
441              
442 8           GvSV(PL_defgv) = args[i];
443 8           MULTICALL;
444              
445 8 100         str = SvPV(*PL_stack_sp, len);
446 8 100         if (!hv_exists(rh, str, len)) {
447 5           SV* count = newSViv(1);
448 5           (void)hv_store(rh, str, len, count, 0);
449             } else {
450 3           SV **count = hv_fetch(rh, str, len, 0);
451 3           sv_inc(*count);
452             }
453             }
454              
455 3 50         POP_MULTICALL;
    50          
456              
457 3           hv_iterinit(rh);
458              
459             i = 0;
460 8 100         while ( (iter = hv_iternext( rh )) != NULL ) {
461 5           ST(i) = hv_iterkeysv(iter);
462 5           i++;
463 5           ST(i) = hv_iterval(rh, iter);
464 5           i++;
465             }
466              
467 3           XSRETURN(i);
468             }
469              
470             void
471             zip_by (code, ...)
472             SV *code
473             PROTOTYPE: &@
474             CODE:
475             {
476             dSP;
477             SV **args = &PL_stack_base[ax];
478             AV *tmps, *retvals;
479             I32 i, j, count;
480             I32 len, max_length = -1;
481              
482 7 100         if (items <= 1) {
483 1           XSRETURN_EMPTY;
484             }
485              
486 6           tmps = (AV *)sv_2mortal((SV *)newAV());
487 6           retvals = (AV *)sv_2mortal((SV *)newAV());
488              
489 18 100         for (i = 1; i < items; i++) {
490 12 50         if (!SvROK(args[i]) || (SvTYPE(SvRV(args[i])) != SVt_PVAV)) {
    50          
491 0           croak("arguments should be ArrayRef");
492             }
493              
494 12           len = av_len((AV*)SvRV(args[i]));
495 12 100         if (len > max_length) {
496             max_length = len;
497             }
498              
499 12           av_push(tmps, newSVsv(args[i]));
500             }
501              
502 6           SAVESPTR(GvSV(PL_defgv));
503              
504 20 100         for (i = 0; i <= max_length; i++) {
505 14           ENTER;
506 14           SAVETMPS;
507              
508 14 50         PUSHMARK(sp);
509 40 100         for (j = 1; j < items; j++) {
510 26           AV *av = (AV*)SvRV( *av_fetch(tmps, j-1, 0) );
511              
512 26 100         if (av_exists(av, i)) {
513 25           SV *elem = *av_fetch(av, i, 0);
514 25 50         XPUSHs(sv_2mortal(newSVsv(elem)));
515             } else {
516 1 50         XPUSHs(&PL_sv_undef);
517             }
518             }
519 14           PUTBACK;
520              
521 14           count = call_sv(code, G_ARRAY);
522              
523 14           SPAGAIN;
524              
525 14           len = av_len(retvals);
526 31 100         for (j = 0; j < count; j++) {
527 17           av_store(retvals, len + (count - j), newSVsv(POPs));
528             }
529              
530 14           PUTBACK;
531 14 50         FREETMPS;
532 14           LEAVE;
533             }
534              
535 6           len = av_len(retvals) + 1;
536 23 100         for (i = 0; i < len; i++) {
537 17           ST(i) = *av_fetch(retvals, i, 0);
538             }
539              
540 6           XSRETURN(len);
541             }
542              
543             void
544             unzip_by (code, ...)
545             SV *code
546             PROTOTYPE: &@
547             CODE:
548             {
549             dSP;
550             SV **args = &PL_stack_base[ax];
551             AV *retvals;
552             I32 i, j, count;
553             I32 len, max_len = 0;
554              
555 6 100         if (items <= 1) {
556 1           XSRETURN_EMPTY;
557             }
558              
559 5           retvals = (AV *)sv_2mortal((SV *)newAV());
560              
561 5           SAVESPTR(GvSV(PL_defgv));
562              
563 20 100         for (i = 1; i < items; i++) {
564 15           ENTER;
565 15           SAVETMPS;
566              
567 15 50         PUSHMARK(sp);
568 15 50         XPUSHs(sv_2mortal(newSVsv(args[i])));
569 15           PUTBACK;
570              
571 15           GvSV(PL_defgv) = args[i];
572 15           count = call_sv(code, G_ARRAY);
573              
574 15           SPAGAIN;
575              
576 25 100         for (j = max_len; j < count; j++) {
577 10           AV *tmp = (AV *)sv_2mortal((SV *)newAV());
578 10           av_store(retvals, j, newRV((SV*)tmp));
579             }
580              
581 15 100         if (max_len < count) {
582             max_len = count;
583             }
584              
585 40 100         for (j = count - 1; j >= 0; j--) {
586 25           SV *ret = newSVsv(POPs);
587 25           AV *tmp = (AV *)SvRV((SV*)*av_fetch(retvals, j, 0));
588 25           av_store(tmp, i - 1, ret);
589             }
590              
591 15           PUTBACK;
592 15 50         FREETMPS;
593 15           LEAVE;
594             }
595              
596 5           len = av_len(retvals) + 1;
597 15 100         for (i = 0; i < len; i++) {
598 10           AV *tmp = (AV *)SvRV((SV*)*av_fetch(retvals, i, 0));
599 14 100         for (j = av_len(tmp) + 1; j < (items - 1); j++) {
600 4           av_push(tmp, &PL_sv_undef);
601             }
602             }
603              
604 15 100         for (i = 0; i < len; i++) {
605 10           ST(i) = *av_fetch(retvals, i, 0);
606             }
607              
608 5           XSRETURN(len);
609             }
610              
611             void
612             extract_by (code, ...)
613             SV *code
614             PROTOTYPE: &\@
615             CODE:
616             {
617             dMULTICALL;
618             GV *gv;
619             HV *stash;
620 5 50         I32 gimme = G_SCALAR, ret_gimme = GIMME_V;
621 5           SV **args = &PL_stack_base[ax];
622             IV i, len;
623             AV *ret_vals, *remains, *origs;
624              
625 5 50         if (items <= 1) {
626 0           XSRETURN_EMPTY;
627             }
628              
629 5           ret_vals = (AV *)sv_2mortal((SV *)newAV());
630 5           remains = (AV *)sv_2mortal((SV *)newAV());
631              
632 5           cv = sv_2cv(code, &stash, &gv, 0);
633 5 50         if (cv == Nullcv) {
634 0           croak("Not a subroutine reference");
635             }
636              
637 5 50         if (!SvROK(args[1]) || (SvTYPE(SvRV(args[1])) != SVt_PVAV)) {
    50          
638 0           croak("arguments should be ArrayRef");
639             }
640              
641             origs = (AV*)SvRV(args[1]);
642 5           len = av_len((AV*)SvRV(args[1])) + 1;
643              
644 5 50         PUSH_MULTICALL(cv);
    50          
645 5           SAVESPTR(GvSV(PL_defgv));
646              
647 44 100         for (i = 0; i < len; i++) {
648             SV *val, *arg;
649              
650 39           arg = *av_fetch(origs, i, 0);
651 39           GvSV(PL_defgv) = arg;
652 39           MULTICALL;
653              
654 39           val = newSVsv(*PL_stack_sp);
655 39 50         if (SvTRUE(val)) {
    50          
    0          
    50          
    0          
    0          
    100          
    50          
    50          
    100          
    50          
    100          
    50          
    50          
    100          
    50          
    0          
    100          
    0          
656 18           av_push(ret_vals, newSVsv(arg));
657             } else {
658 21           SV *val = newSVsv(arg);
659 21           SvFLAGS(val) = SvFLAGS(arg);
660 21           av_push(remains, val);
661             }
662             }
663              
664 5 50         POP_MULTICALL;
    50          
665              
666 5           av_clear(origs);
667              
668 5           len = av_len(remains) + 1;
669 26 100         for (i = 0; i < len; i++) {
670 21           SV *val = *av_fetch(remains, i, 0);
671 21           av_push(origs, newSVsv(val));
672             }
673              
674 5 100         if (ret_gimme == G_SCALAR) {
675             len = 1;
676 2           ST(0) = sv_2mortal(newSViv(av_len(ret_vals)+1));
677             } else {
678 3           len = av_len(ret_vals) + 1;
679 3 50         EXTEND(SP, len);
    50          
680 13 100         for (i = 0; i < len; i++) {
681 10           ST(i) = sv_mortalcopy(*av_fetch(ret_vals, i, 0));
682             }
683             }
684              
685 5           XSRETURN(len);
686             }
687              
688             void
689             weighted_shuffle_by (code, ...)
690             SV *code
691             PROTOTYPE: &@
692             CODE:
693             {
694             dMULTICALL;
695             GV *gv;
696             HV *stash;
697             I32 gimme = G_SCALAR;
698             SV **args = &PL_stack_base[ax];
699             I32 i, len;
700             AV *weights, *origs, *retvals;
701              
702 4 100         if (items <= 1) {
703 1           XSRETURN_EMPTY;
704             }
705              
706 3           weights = (AV *)sv_2mortal((SV *)newAV());
707 3           origs = (AV *)sv_2mortal((SV *)newAV());
708 3           retvals = (AV *)sv_2mortal((SV *)newAV());
709              
710 3           cv = sv_2cv(code, &stash, &gv, 0);
711 3 50         if (cv == Nullcv) {
712 0           croak("Not a subroutine reference");
713             }
714              
715 3 50         PUSH_MULTICALL(cv);
    50          
716 3           SAVESPTR(GvSV(PL_defgv));
717              
718 10 100         for (i = 1; i < items; i++) {
719 7           av_push(origs, newSVsv(args[i]));
720              
721 7           GvSV(PL_defgv) = args[i];
722 7           MULTICALL;
723              
724 7           av_push(weights, newSVsv(*PL_stack_sp));
725             }
726              
727 3 50         POP_MULTICALL;
    50          
728              
729             /* Initialize Drand01 if rand() or srand() has
730             not already been called
731             */
732 3 100         if (!PL_srand_called) {
733 1           (void)seedDrand01((Rand_seed_t)seed());
734 3           PL_srand_called = TRUE;
735             }
736              
737 7 100         while ( (av_len(origs) + 1) > 1) {
738             IV total = 0;
739             I32 select;
740             I32 idx;
741             SV *selected, *last;
742              
743 4           len = av_len(weights) + 1;
744 14 100         for (i = 0; i < len; i++) {
745 10 50         total += SvIV(*av_fetch(weights, i, 0));
746             }
747              
748 4           select = (I32)(Drand01() * (double)total);
749             idx = 0;
750 6 50         while (select >= SvIV(*av_fetch(weights, idx, 0))) {
    100          
751 2 50         select -= SvIV(*av_fetch(weights, idx, 0));
752              
753 2 50         if (av_len(weights) > idx) {
754 2           idx++;
755             } else {
756             break;
757             }
758             }
759              
760 4           selected = *av_fetch(origs, idx, 0);
761 4           av_push(retvals, newSVsv(selected));
762              
763 4           last = *av_fetch(origs, av_len(origs), 0);
764 4           av_store(origs, idx, last);
765 4           (void)av_pop(origs);
766              
767 4           last = *av_fetch(weights, av_len(weights), 0);
768 4           av_store(weights, idx, last);
769 4           (void)av_pop(weights);
770             }
771              
772 3           len = av_len(origs) + 1;
773 6 100         for (i = 0 ; i < len; i++) {
774 3           av_push(retvals, av_shift(origs));
775             }
776              
777 10 100         for (i = 1 ; i < items; i++) {
778 7           ST(i-1) = sv_2mortal(newSVsv( *av_fetch(retvals, i-1, 0) ));
779             }
780              
781 3           XSRETURN(items-1);
782             }
783              
784             void
785             bundle_by (code, ...)
786             SV *code
787             PROTOTYPE: &@
788             CODE:
789             {
790             dSP;
791             SV **args = &PL_stack_base[ax];
792             AV *retvals;
793             IV argnum;
794             I32 i, j, count, len, loop;
795              
796 5 50         if (items <= 1) {
797 0           XSRETURN_EMPTY;
798             }
799              
800 5 50         argnum = SvIV(args[1]);
801 5 50         if (argnum <= 0) {
802 0           croak("bundle number is larger than 0");
803             }
804              
805 5           retvals = (AV *)sv_2mortal((SV *)newAV());
806              
807 5           SAVESPTR(GvSV(PL_defgv));
808              
809 16 100         for (i = 2, loop = 0; i < items; i += argnum, loop++) {
810 11           ENTER;
811 11           SAVETMPS;
812              
813 11 50         PUSHMARK(sp);
814 30 100         for (j = 0; j < argnum; j++) {
815 19           I32 index = (loop * argnum) + j + 2;
816 19 50         if (SvOK(args[index])) {
    0          
    0          
817 19 50         XPUSHs(sv_2mortal(newSVsv(args[index])));
818             } else {
819 0 0         XPUSHs(&PL_sv_undef);
820             }
821             }
822 11           PUTBACK;
823              
824 11           count = call_sv(code, G_ARRAY);
825              
826 11           SPAGAIN;
827              
828 11           len = av_len(retvals);
829 26 100         for (j = 0; j < count; j++) {
830 15           av_store(retvals, len + (count - j), newSVsv(POPs));
831             }
832              
833 11           PUTBACK;
834 11 50         FREETMPS;
835 11           LEAVE;
836             }
837              
838 5           len = av_len(retvals) + 1;
839 20 100         for (i = 0; i < len; i++) {
840 15           ST(i) = *av_fetch(retvals, i, 0);
841             }
842              
843 5           XSRETURN(len);
844             }