Algorithm-StringHash-FromCSharp35-XS

 view release on metacpan or  search on metacpan

XS.xs  view on Meta::CPAN

#include "perl.h"
#include "XSUB.h"
#include "ppport.h"

MODULE = Algorithm::StringHash::FromCSharp35::XS		PACKAGE = Algorithm::StringHash::FromCSharp35::XS		

unsigned int GetHashCode(const char * str)
CODE:
    unsigned int    num = 0x15051505;
    unsigned int    num2 = num;
    int length=strlen(str);

    int new_length = length + ( 8 - length % 8) + 128;
    char chPtr[new_length];
    memset(chPtr,0,new_length);
    strcpy(chPtr,str);

    unsigned int  * numPtr = (unsigned int *)chPtr;
    int i=0;
    for(i=length;i>0;i-=4)
    {
        num = (((num << 5) + num) + (num >> 0x1b)) ^ numPtr[0];
        if(i<=2) break;
        num2=(((num2 << 5) + num2) + (num2 >> 0x1b)) ^ numPtr[1];
        numPtr+=2;
    }
    unsigned int ret = (num + (num2 * 0x5d588b65));
    RETVAL = ret;
OUTPUT:
    RETVAL

lib/Algorithm/StringHash/FromCSharp35/XS.pm  view on Meta::CPAN

You can take the implementation if perl if not able to build XS module.

  sub getHashCode
  {
      use bigint;
      no warnings 'uninitialized';
      my $str = shift;
      my @str = split //, $str;
      my $num = 0x15051505;
      my $num2 = $num;
      my $len=length($str);
      my $i = 0;
      my $pos = 0;
      my $field_max = 1<<32;
      for($i=$len;$i>0;$i-=4)
      {
          my $numptr;
          $numptr = (ord($str[$pos*4+3])<<24) + (ord($str[$pos*4+2])<<16) + (ord($str[$pos*4+1])<<8) + ord($str[$pos*4]);
          $num = ((($num << 5) + $num) + ($num >> 0x1b)) ^ $numptr;
          $num %= $field_max;
          if($i<=2) {last;}

ppport.h  view on Meta::CPAN

mess_nocontext|||vn
mess||5.006000|v
method_common|||
mfree||5.007002|n
mg_clear|||
mg_copy|||
mg_dup|||
mg_find|||
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|
missingterm|||
mode_from_discipline|||
modkids|||
mod|||
more_bodies|||

ppport.h  view on Meta::CPAN

reg_named_buff_exists||5.009005|
reg_named_buff_fetch||5.009005|
reg_named_buff_firstkey||5.009005|
reg_named_buff_iter|||
reg_named_buff_nextkey||5.009005|
reg_named_buff_scalar||5.009005|
reg_named_buff|||
reg_namedseq|||
reg_node|||
reg_numbered_buff_fetch|||
reg_numbered_buff_length|||
reg_numbered_buff_store|||
reg_qr_package|||
reg_recode|||
reg_scan_name|||
reg_skipcomment|||
reg_temp_copy|||
reganode|||
regatom|||
regbranch|||
regclass_swash||5.009004|

ppport.h  view on Meta::CPAN

unshare_hek|||
unsharepvn||5.004000|
unwind_handler_stack|||
update_debugger_info|||
upg_version||5.009005|
usage|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
utf8_distance||5.006000|
utf8_hop||5.006000|
utf8_length||5.007001|
utf8_mg_pos_cache_update|||
utf8_to_bytes||5.006001|
utf8_to_uvchr||5.007001|
utf8_to_uvuni||5.007001|
utf8n_to_uvchr|||
utf8n_to_uvuni||5.007001|
utilize|||
uvchr_to_utf8_flags||5.007003|
uvchr_to_utf8|||
uvuni_to_utf8_flags||5.007003|

ppport.h  view on Meta::CPAN

yyerror|||
yylex|||
yyparse|||
yywarn|||
);

if (exists $opt{'list-unsupported'}) {
  my $f;
  for $f (sort { lc $a cmp lc $b } keys %API) {
    next unless $API{$f}{todo};
    print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
  }
  exit 0;
}

# Scan for possible replacement candidates

my(%replace, %need, %hints, %warnings, %depends);
my $replace = 0;
my($hint, $define, $function);

ppport.h  view on Meta::CPAN

/* Older perls (<=5.003) lack AvFILLp */
#ifndef AvFILLp
#  define AvFILLp                        AvFILL
#endif
#ifndef ERRSV
#  define ERRSV                          get_sv("@",FALSE)
#endif

/* Hint: gv_stashpvn
 * This function's backport doesn't support the length parameter, but
 * rather ignores it. Portability can only be ensured if the length
 * parameter is used for speed reasons, but the length can always be
 * correctly computed from the string argument.
 */
#ifndef gv_stashpvn
#  define gv_stashpvn(str,len,create)    gv_stashpv(str,create)
#endif

/* Replace: 1 */
#ifndef get_cv
#  define get_cv                         perl_get_cv
#endif

ppport.h  view on Meta::CPAN

#endif

#define my_strlcat DPPP_(my_my_strlcat)
#define Perl_my_strlcat DPPP_(my_my_strlcat)

#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)

Size_t
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
{
    Size_t used, length, copy;

    used = strlen(dst);
    length = strlen(src);
    if (size > 0 && used < size - 1) {
        copy = (length >= size - used) ? size - used - 1 : length;
        memcpy(dst + used, src, copy);
        dst[used + copy] = '\0';
    }
    return used + length;
}
#endif
#endif

#if !defined(my_strlcpy)
#if defined(NEED_my_strlcpy)
static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
static
#else
extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
#endif

#define my_strlcpy DPPP_(my_my_strlcpy)
#define Perl_my_strlcpy DPPP_(my_my_strlcpy)

#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)

Size_t
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
{
    Size_t length, copy;

    length = strlen(src);
    if (size > 0) {
        copy = (length >= size) ? size - 1 : length;
        memcpy(dst, src, copy);
        dst[copy] = '\0';
    }
    return length;
}

#endif
#endif
#ifndef PERL_PV_ESCAPE_QUOTE
#  define PERL_PV_ESCAPE_QUOTE           0x0001
#endif

#ifndef PERL_PV_PRETTY_QUOTE
#  define PERL_PV_PRETTY_QUOTE           PERL_PV_ESCAPE_QUOTE