1################################################################################
2##
3##  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
4##  Version 2.x, Copyright (C) 2001, Paul Marquess.
5##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
6##
7##  This program is free software; you can redistribute it and/or
8##  modify it under the same terms as Perl itself.
9##
10################################################################################
11
12=provides
13
14my_strlcat
15my_strlcpy
16
17=implementation
18
19#if !defined(my_strlcat)
20#if { NEED my_strlcat }
21
22Size_t
23my_strlcat(char *dst, const char *src, Size_t size)
24{
25    Size_t used, length, copy;
26
27    used = strlen(dst);
28    length = strlen(src);
29    if (size > 0 && used < size - 1) {
30        copy = (length >= size - used) ? size - used - 1 : length;
31        memcpy(dst + used, src, copy);
32        dst[used + copy] = '\0';
33    }
34    return used + length;
35}
36#endif
37#endif
38
39#if !defined(my_strlcpy)
40#if { NEED my_strlcpy }
41
42Size_t
43my_strlcpy(char *dst, const char *src, Size_t size)
44{
45    Size_t length, copy;
46
47    length = strlen(src);
48    if (size > 0) {
49        copy = (length >= size) ? size - 1 : length;
50        memcpy(dst, src, copy);
51        dst[copy] = '\0';
52    }
53    return length;
54}
55
56#endif
57#endif
58
59=xsinit
60
61#define NEED_my_strlcat
62#define NEED_my_strlcpy
63
64=xsubs
65
66void
67my_strlfunc()
68        PREINIT:
69                char buf[8];
70                int len;
71        PPCODE:
72                len = my_strlcpy(buf, "foo", sizeof(buf));
73                mXPUSHi(len);
74                mXPUSHs(newSVpv(buf, 0));
75                len = my_strlcat(buf, "bar", sizeof(buf));
76                mXPUSHi(len);
77                mXPUSHs(newSVpv(buf, 0));
78                len = my_strlcat(buf, "baz", sizeof(buf));
79                mXPUSHi(len);
80                mXPUSHs(newSVpv(buf, 0));
81                len = my_strlcpy(buf, "1234567890", sizeof(buf));
82                mXPUSHi(len);
83                mXPUSHs(newSVpv(buf, 0));
84                len = my_strlcpy(buf, "1234", sizeof(buf));
85                mXPUSHi(len);
86                mXPUSHs(newSVpv(buf, 0));
87                len = my_strlcat(buf, "567890123456", sizeof(buf));
88                mXPUSHi(len);
89                mXPUSHs(newSVpv(buf, 0));
90                XSRETURN(12);
91
92=tests plan => 13
93
94my @e = (3, 'foo',
95         6, 'foobar',
96         9, 'foobarb',
97         10, '1234567',
98         4, '1234',
99         16, '1234567',
100        );
101my @r = Devel::PPPort::my_strlfunc();
102
103ok(@e == @r);
104
105for (0 .. $#e) {
106  is($r[$_], $e[$_]);
107}
108