view release on metacpan or  search on metacpan

Replace.xs  view on Meta::CPAN

/*
*
* Copyright (c) 2018, cPanel, LLC.
* All rights reserved.
* http://cpanel.net
*
* This is free software; you can redistribute it and/or modify it under the
* same terms as Perl itself.
*
*/

#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
#include <embed.h>

#define IS_SPACE(c) ((c) == ' ' || (c) == '\n' || (c) == '\r' || (c) == '\t' || (c) == '\f' || (c) == '\v')

/*
 * UTF8_SEQ_LEN: given a lead byte c (>= 0x80), return the expected
 * number of bytes in the UTF-8 sequence.  Continuation bytes (0x80-0xBF)
 * return 1 (copy-as-is).
 */
#define UTF8_SEQ_LEN(c) \
  ( (c) >= 0xFC ? 6 : \
    (c) >= 0xF8 ? 5 : \
    (c) >= 0xF0 ? 4 : \
    (c) >= 0xE0 ? 3 : \
    (c) >= 0xC0 ? 2 : 1 )

#define IS_CODEREF(sv) (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV)
#define PROPAGATE_TAINT(from, to) do { if (SvTAINTED(from)) SvTAINTED_on(to); } while (0)

/* croak_sv was introduced in Perl 5.18; provide fallback for older versions */
#if PERL_VERSION < 18
#define croak_sv(sv) croak("%s", SvPV_nolen(sv))
#endif

SV *_replace_str( SV *sv, SV *map );
SV *_trim_sv( SV *sv );
IV _replace_inplace( SV *sv, SV *map );
IV _trim_inplace( SV *sv );

/*
 * ensure_buffer_space: grow the buffer if needed to accommodate additional bytes.
 * Returns the updated string pointer (SvGROW may relocate).
 */
static inline char *ensure_buffer_space(SV *sv, STRLEN *str_size, STRLEN needed) {
  if (*str_size <= needed) {
    while (*str_size <= needed) {
      *str_size *= 2;
    }
    SvGROW(sv, *str_size);
  }
  return SvPVX(sv);
}

/*
 * copy_replacement: copy replacement string into buffer, handling multi-char replacements.
 * Returns the new buffer position.
 */
static inline STRLEN copy_replacement(char *str, STRLEN ix, const char *replace, STRLEN slen) {
  STRLEN j;
  for (j = 0; j < slen - 1; ++j) {
    str[ix++] = replace[j];
  }
  str[ix] = replace[j];
  return ix;
}

/*
 * _build_fast_map: populate a 256-byte identity lookup table, then
 * overwrite entries according to the Perl map array.
 *
 * Returns 1 if every map entry is a 1:1 byte replacement (fast-path
 * eligible).  Returns 0 if any entry requires expansion, deletion,
 * or is otherwise incompatible — the caller should fall through to
 * the general path.
 */
static int _build_fast_map( char fast_map[256], SV **ary, SSize_t map_top ) {
  dTHX;
  int ix;
  SSize_t scan_top = map_top < 255 ? map_top : 255;

  for ( ix = 0; ix < 256; ++ix )
    fast_map[ix] = (char) ix;

  for ( ix = 0; ix <= scan_top; ++ix ) {
    SV *entry;
    if ( !ary[ix] )
      continue;
    entry = ary[ix];
    if ( SvPOK( entry ) ) {
      STRLEN slen;
      char *pv = SvPV( entry, slen );
      if ( slen == 1 ) {
        fast_map[ix] = pv[0];
      } else {
        return 0;
      }
    } else if ( SvIOK( entry ) || SvNOK( entry ) ) {
      IV val = SvIV( entry );
      if ( val >= 0 && val <= 255 ) {
        fast_map[ix] = (char) val;
      }
      /* out-of-range: keep identity (already set) */