ext/Devel/PPPort/parts/inc/strlfuncs

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