package AutoXS::Header; use 5.006; use strict; use warnings; our $VERSION = '1.02'; sub WriteAutoXSHeader { my $filename = shift; if (defined $filename and $filename eq 'AutoXS::Header') { $filename = shift; } $filename = 'AutoXS.h' if not defined $filename; open my $fh, '>', $filename or die "Could not open '$filename' for writing: $!"; print $fh "/* AutoXS::Header version '$VERSION' */\n"; print $fh <<'AUTOXSHEADERHEREDOC'; typedef struct { U32 hash; SV* key; } autoxs_hashkey; /* prototype section */ I32 get_hashkey_index(const char* key, const I32 len); I32 _new_hashkey(); void _resize_array(I32** array, unsigned int* len, unsigned int newlen); void _resize_array_init(I32** array, unsigned int* len, unsigned int newlen, I32 init); I32 _new_internal_arrayindex(); I32 get_internal_array_index(I32 object_ary_idx); /* initialization section */ unsigned int AutoXS_no_hashkeys = 0; unsigned int AutoXS_free_hashkey_no = 0; autoxs_hashkey* AutoXS_hashkeys = NULL; HV* AutoXS_reverse_hashkeys = NULL; unsigned int AutoXS_no_arrayindices = 0; unsigned int AutoXS_free_arrayindices_no = 0; I32* AutoXS_arrayindices = NULL; unsigned int AutoXS_reverse_arrayindices_length = 0; I32* AutoXS_reverse_arrayindices = NULL; /* implementation section */ I32 get_hashkey_index(const char* key, const I32 len) { I32 index; /* init */ if (AutoXS_reverse_hashkeys == NULL) AutoXS_reverse_hashkeys = newHV(); index = 0; if ( hv_exists(AutoXS_reverse_hashkeys, key, len) ) { SV** index_sv = hv_fetch(AutoXS_reverse_hashkeys, key, len, 0); /* simply return the index that corresponds to an earlier * use with the same hash key name */ if ( (index_sv == NULL) || (!SvIOK(*index_sv)) ) { /* shouldn't happen */ index = _new_hashkey(); } else /* Note to self: Check that this I32 cast is sane */ return (I32)SvIVX(*index_sv); } else /* does not exist */ index = _new_hashkey(); /* store the new hash key in the reverse lookup table */ hv_store(AutoXS_reverse_hashkeys, key, len, newSViv(index), 0); return index; } /* this is private, call get_hashkey_index instead */ I32 _new_hashkey() { if (AutoXS_no_hashkeys == AutoXS_free_hashkey_no) { unsigned int extend = 1 + AutoXS_no_hashkeys * 2; /*printf("extending hashkey storage by %u\n", extend);*/ unsigned int oldsize = AutoXS_no_hashkeys * sizeof(autoxs_hashkey); /*printf("previous data size %u\n", oldsize);*/ autoxs_hashkey* tmphashkeys = (autoxs_hashkey*) malloc( oldsize + extend * sizeof(autoxs_hashkey) ); memcpy(tmphashkeys, AutoXS_hashkeys, oldsize); free(AutoXS_hashkeys); AutoXS_hashkeys = tmphashkeys; AutoXS_no_hashkeys += extend; } return AutoXS_free_hashkey_no++; } void _resize_array(I32** array, unsigned int* len, unsigned int newlen) { unsigned int oldsize = *len * sizeof(I32); I32* tmparraymap = (I32*) malloc( newlen * sizeof(I32) ); memcpy(tmparraymap, *array, oldsize); free(*array); *array = tmparraymap; *len = newlen; } void _resize_array_init(I32** array, unsigned int* len, unsigned int newlen, I32 init) { unsigned int i; unsigned int oldsize = *len * sizeof(I32); I32* tmparraymap = (I32*) malloc( newlen * sizeof(I32) ); memcpy(tmparraymap, *array, oldsize); free(*array); *array = tmparraymap; for (i = *len; i < newlen; ++i) (*array)[i] = init; *len = newlen; } /* this is private, call get_array_index instead */ I32 _new_internal_arrayindex() { if (AutoXS_no_arrayindices == AutoXS_free_arrayindices_no) { unsigned int extend = 2 + AutoXS_no_arrayindices * 2; /*printf("extending array index storage by %u\n", extend);*/ /*printf("previous data size %u\n", oldsize);*/ _resize_array(&AutoXS_arrayindices, &AutoXS_no_arrayindices, extend); } return AutoXS_free_arrayindices_no++; } I32 get_internal_array_index(I32 object_ary_idx) { I32 new_index; if (AutoXS_reverse_arrayindices_length <= (unsigned int)object_ary_idx) _resize_array_init( &AutoXS_reverse_arrayindices, &AutoXS_reverse_arrayindices_length, object_ary_idx+1, -1 ); /* -1 == "undef" */ if (AutoXS_reverse_arrayindices[object_ary_idx] > -1) return AutoXS_reverse_arrayindices[object_ary_idx]; new_index = _new_internal_arrayindex(); AutoXS_reverse_arrayindices[object_ary_idx] = new_index; return new_index; } AUTOXSHEADERHEREDOC } 1; __END__ =head1 NAME AutoXS::Header - Container for the AutoXS header files =head1 SYNOPSIS # potentially in your Makefile.PL sub MY::post_constants { # Write header as AutoXS.h in current directory return <<'MAKE_FRAG'; linkext :: $(PERL) -MAutoXS::Header -e AutoXS::Header::WriteAutoXSHeader # note the tab character in the previous line! MAKE_FRAG } =head1 DESCRIPTION This module is a simple container for the newest version of the L header file C. =head1 SEE ALSO L =head1 AUTHOR Steffen Mueller, Esmueller@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2008-2009 by Steffen Mueller This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8 or, at your option, any later version of Perl 5 you may have available. =cut