r2515 - in packages: . libstring-crc32-perl
libstring-crc32-perl/branches libstring-crc32-perl/branches/upstream
libstring-crc32-perl/branches/upstream/current
libstring-crc32-perl/branches/upstream/current/t
Gunnar Wolf
gwolf at costa.debian.org
Sat Apr 8 13:17:39 UTC 2006
Author: gwolf
Date: 2006-04-08 13:17:33 +0000 (Sat, 08 Apr 2006)
New Revision: 2515
Added:
packages/libstring-crc32-perl/
packages/libstring-crc32-perl/branches/
packages/libstring-crc32-perl/branches/upstream/
packages/libstring-crc32-perl/branches/upstream/current/
packages/libstring-crc32-perl/branches/upstream/current/CRC32.pm
packages/libstring-crc32-perl/branches/upstream/current/CRC32.pod
packages/libstring-crc32-perl/branches/upstream/current/CRC32.xs
packages/libstring-crc32-perl/branches/upstream/current/MANIFEST
packages/libstring-crc32-perl/branches/upstream/current/Makefile.PL
packages/libstring-crc32-perl/branches/upstream/current/README
packages/libstring-crc32-perl/branches/upstream/current/crcgen.c
packages/libstring-crc32-perl/branches/upstream/current/t/
packages/libstring-crc32-perl/branches/upstream/current/t/crc.t
packages/libstring-crc32-perl/branches/upstream/current/t/testfile
packages/libstring-crc32-perl/branches/upstream/current/typemap
packages/libstring-crc32-perl/tags/
Log:
[svn-inject] Installing original source of libstring-crc32-perl
Added: packages/libstring-crc32-perl/branches/upstream/current/CRC32.pm
===================================================================
--- packages/libstring-crc32-perl/branches/upstream/current/CRC32.pm 2006-04-07 18:03:25 UTC (rev 2514)
+++ packages/libstring-crc32-perl/branches/upstream/current/CRC32.pm 2006-04-08 13:17:33 UTC (rev 2515)
@@ -0,0 +1,19 @@
+
+package String::CRC32;
+
+require Exporter;
+require DynaLoader;
+
+ at ISA = qw(Exporter DynaLoader);
+
+$VERSION = 1.3;
+
+# Items to export into callers namespace by default
+ at EXPORT = qw(crc32);
+
+# Other items we are prepared to export if requested
+ at EXPORT_OK = qw();
+
+bootstrap String::CRC32;
+
+1;
Added: packages/libstring-crc32-perl/branches/upstream/current/CRC32.pod
===================================================================
--- packages/libstring-crc32-perl/branches/upstream/current/CRC32.pod 2006-04-07 18:03:25 UTC (rev 2514)
+++ packages/libstring-crc32-perl/branches/upstream/current/CRC32.pod 2006-04-08 13:17:33 UTC (rev 2515)
@@ -0,0 +1,61 @@
+=head1 NAME
+
+String::CRC32 - Perl interface for cyclic redundency check generation
+
+=head1 SYNOPSIS
+
+ use String::CRC32;
+
+ $crc = crc32("some string");
+ $crc = crc32("some string", initvalue);
+
+ $somestring = "some string";
+ $crc = crc32($somestring);
+
+ open(SOMEFILE, "location/of/some.file");
+ $crc = crc32(*SOMEFILE);
+ close(SOMEFILE);
+
+=head1 DESCRIPTION
+
+The B<CRC32> module calculates CRC sums of 32 bit lenghts.
+It generates the same CRC values as ZMODEM, PKZIP, PICCHECK and
+many others.
+
+Despite its name, this module is able to compute
+the checksum of files as well as strings.
+
+=head1 EXAMPLES
+
+ $crc = crc32("some string");
+
+ results in the same as
+
+ $crc = crc32(" string", crc32("some"));
+
+This is useful for subsequent CRC checking of substrings.
+
+You may even check files:
+
+ open(SOMEFILE, "location/of/some.file");
+ $crc = crc32(*SOMEFILE);
+ close(SOMEFILE);
+
+A init value may also been supplied in the above example.
+
+=head1 AUTHOR
+
+Soenke J. Peters <peters__perl at opcenter.de>
+
+Please be so kind as to report any bugs/suggestions to the above address.
+
+=head1 COPYRIGHT
+
+CRC algorithm code taken from CRC-32 by Craig Bruce.
+The module stuff is inspired by a similar perl module called
+String::CRC by David Sharnoff & Matthew Dillon.
+Horst Fickenscher told me that it could be useful to supply an init
+value to the crc checking function and so I included this possibility.
+
+The author of this package disclaims all copyrights and
+releases it into the public domain.
Added: packages/libstring-crc32-perl/branches/upstream/current/CRC32.xs
===================================================================
--- packages/libstring-crc32-perl/branches/upstream/current/CRC32.xs 2006-04-07 18:03:25 UTC (rev 2514)
+++ packages/libstring-crc32-perl/branches/upstream/current/CRC32.xs 2006-04-08 13:17:33 UTC (rev 2515)
@@ -0,0 +1,160 @@
+/*
+ Perl Extension for 32bit CRC computations
+ by Soenke J. Peters
+*/
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/*
+ Based on CRC-32 version 1.04 by Craig Bruce, 05-Dec-1994
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifdef GENTABLE
+U32
+crcTable[256];
+
+void
+crcgen( void )
+{
+ U32 crc, poly;
+ int i, j;
+
+ poly = 0xEDB88320L;
+ for (i=0; i<256; i++) {
+ crc = i;
+ for (j=8; j>0; j--) {
+ if (crc&1) {
+ crc = (crc >> 1) ^ poly;
+ } else {
+ crc >>= 1;
+ }
+ }
+ crcTable[i] = crc;
+ }
+}
+#else /* GENTABLE */
+U32
+crcTable[256] = {
+0x0, 0x77073096, 0xee0e612c, 0x990951ba, 0x76dc419, 0x706af48f, 0xe963a535, 0x9e6495a3,
+0xedb8832, 0x79dcb8a4, 0xe0d5e91e, 0x97d2d988, 0x9b64c2b, 0x7eb17cbd, 0xe7b82d07, 0x90bf1d91,
+0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de, 0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7,
+0x136c9856, 0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9, 0xfa0f3d63, 0x8d080df5,
+0x3b6e20c8, 0x4c69105e, 0xd56041e4, 0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b,
+0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3, 0x45df5c75, 0xdcd60dcf, 0xabd13d59,
+0x26d930ac, 0x51de003a, 0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599, 0xb8bda50f,
+0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924, 0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d,
+0x76dc4190, 0x1db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x6b6b51f, 0x9fbfe4a5, 0xe8b8d433,
+0x7807c9a2, 0xf00f934, 0x9609a88e, 0xe10e9818, 0x7f6a0dbb, 0x86d3d2d, 0x91646c97, 0xe6635c01,
+0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed, 0x1b01a57b, 0x8208f4c1, 0xf50fc457,
+0x65b0d9c6, 0x12b7e950, 0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3, 0xfbd44c65,
+0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2, 0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb,
+0x4369e96a, 0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5, 0xaa0a4c5f, 0xdd0d7cc9,
+0x5005713c, 0x270241aa, 0xbe0b1010, 0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f,
+0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17, 0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad,
+0xedb88320, 0x9abfb3b6, 0x3b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x4db2615, 0x73dc1683,
+0xe3630b12, 0x94643b84, 0xd6d6a3e, 0x7a6a5aa8, 0xe40ecf0b, 0x9309ff9d, 0xa00ae27, 0x7d079eb1,
+0xf00f9344, 0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb, 0x196c3671, 0x6e6b06e7,
+0xfed41b76, 0x89d32be0, 0x10da7a5a, 0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5,
+0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1, 0xa6bc5767, 0x3fb506dd, 0x48b2364b,
+0xd80d2bda, 0xaf0a1b4c, 0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef, 0x4669be79,
+0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236, 0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f,
+0xc5ba3bbe, 0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31, 0x2cd99e8b, 0x5bdeae1d,
+0x9b64c2b0, 0xec63f226, 0x756aa39c, 0x26d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x5005713,
+0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0xcb61b38, 0x92d28e9b, 0xe5d5be0d, 0x7cdcefb7, 0xbdbdf21,
+0x86d3d2d4, 0xf1d4e242, 0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1, 0x18b74777,
+0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c, 0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45,
+0xa00ae278, 0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7, 0x4969474d, 0x3e6e77db,
+0xaed16a4a, 0xd9d65adc, 0x40df0b66, 0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9,
+0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605, 0xcdd70693, 0x54de5729, 0x23d967bf,
+0xb3667a2e, 0xc4614ab8, 0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b, 0x2d02ef8d,
+};
+#endif /* GENTABLE */
+
+U32
+getcrc(char *c, int len, U32 crcinit)
+{
+ register U32 crc;
+ char *e = c + len;
+
+ crc = crcinit^0xFFFFFFFF;
+ while (c < e) {
+ crc = ((crc >> 8) & 0x00FFFFFF) ^ crcTable[ (crc^ *c) & 0xFF ];
+ ++c;
+ }
+ return( crc^0xFFFFFFFF );
+}
+
+U32
+getcrc_fp( PerlIO *fp, U32 crcinit )
+{
+ register U32 crc;
+ int c;
+
+ crc = crcinit^0xFFFFFFFF;
+ while( (c=PerlIO_getc(fp)) != EOF ) {
+ crc = ((crc>>8) & 0x00FFFFFF) ^ crcTable[ (crc^c) & 0xFF ];
+ }
+ return( crc^0xFFFFFFFF );
+}
+
+svtype
+getsvtype(SV *sv)
+{
+ if (sv == NULL )
+ return SVt_NULL;
+ if (SvROK(sv))
+ return SvTYPE(SvRV(sv));
+ else
+ return SvTYPE(sv);
+}
+
+MODULE = String::CRC32 PACKAGE = String::CRC32
+
+VERSIONCHECK: DISABLE
+PROTOTYPES: DISABLE
+
+U32
+crc32(data, ...)
+ char *data = NO_INIT
+ PREINIT:
+ U32 crcinit = 0;
+ STRLEN data_len;
+ PPCODE:
+ int sv_type;
+ IO *io;
+ SV *sv;
+ U32 rv = 0;
+ {
+#ifdef GENTABLE
+ crcgen();
+#endif /* GENTABLE */
+ /* Horst Fickenscher <horst_fickenscher at sepp.de> mailed me that it
+ could be useful to supply an initial value other than 0, e.g.
+ to calculate checksums of big files without the need of keeping
+ them comletely in memory */
+ if ( items > 1 )
+ crcinit = (U32) SvNV(ST(items - 1));
+
+ sv_type = getsvtype(ST(0));
+
+ if (sv_type == SVt_PVGV)
+ {
+ io = sv_2io(ST(0));
+ rv = getcrc_fp(IoIFP(io), crcinit);
+ }
+ else
+ {
+ data = (char *)SvPV(ST(0),data_len);
+ rv = getcrc(data, data_len, crcinit);
+ }
+ EXTEND(sp, 1);
+ sv = newSV(0);
+ sv_setuv(sv, (UV)rv);
+ PUSHs(sv_2mortal(sv));
+ }
\ No newline at end of file
Added: packages/libstring-crc32-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libstring-crc32-perl/branches/upstream/current/MANIFEST 2006-04-07 18:03:25 UTC (rev 2514)
+++ packages/libstring-crc32-perl/branches/upstream/current/MANIFEST 2006-04-08 13:17:33 UTC (rev 2515)
@@ -0,0 +1,10 @@
+README
+Makefile.PL
+t/crc.t # some tests
+t/testfile # a file to check during tests
+CRC32.xs # the heart of the module
+CRC32.pm
+CRC32.pod # documentation
+MANIFEST
+crcgen.c # use this to rebuild your crc table
+typemap # my typemap for a correct mapping from C types to perl
Added: packages/libstring-crc32-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libstring-crc32-perl/branches/upstream/current/Makefile.PL 2006-04-07 18:03:25 UTC (rev 2514)
+++ packages/libstring-crc32-perl/branches/upstream/current/Makefile.PL 2006-04-08 13:17:33 UTC (rev 2515)
@@ -0,0 +1,12 @@
+#! /usr/local/bin/perl
+
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile being created.
+WriteMakefile(
+ 'NAME' => 'String::CRC32',
+ 'DISTNAME' => 'String-CRC32',
+ 'VERSION' => '1.3',
+ 'OBJECT' => 'CRC32.o',
+ 'dist' => {COMPRESS=>'gzip', SUFFIX=>'gz'}
+);
Added: packages/libstring-crc32-perl/branches/upstream/current/README
===================================================================
--- packages/libstring-crc32-perl/branches/upstream/current/README 2006-04-07 18:03:25 UTC (rev 2514)
+++ packages/libstring-crc32-perl/branches/upstream/current/README 2006-04-08 13:17:33 UTC (rev 2515)
@@ -0,0 +1,27 @@
+
+Perl Module String::CRC32
+
+This packages provides a perl module to generate checksums from strings
+and from files.
+
+Written 19990310 by Soenke J. Peters <peters__perl at opcenter.de>.
+
+The checksums are the same as those calculated by ZMODEM, PKZIP,
+PICCHECK and many others.
+There's another perl module called String::CRC which allows to calculate
+not only 32 bit CRC numbers, but the generated sums differ from those of
+the programs mentioned above.
+
+Installation:
+ "perl Makefile.PL"
+ "make"
+ "make test"
+ "make install"
+
+If you find any bugs, please send me a good description (or a patch ;-) ).
+
+Have fun,
+ Soenke J. Peters
+ Rostock, Germany
+
+
Added: packages/libstring-crc32-perl/branches/upstream/current/crcgen.c
===================================================================
--- packages/libstring-crc32-perl/branches/upstream/current/crcgen.c 2006-04-07 18:03:25 UTC (rev 2514)
+++ packages/libstring-crc32-perl/branches/upstream/current/crcgen.c 2006-04-08 13:17:33 UTC (rev 2515)
@@ -0,0 +1,36 @@
+/*
+ Generation of CRC lookup table
+ as used in Perl module "String::CRC32"
+
+ 1999 by Soenke J. Peters <peters__perl at opcenter.de>
+*/
+
+#include <stdio.h>
+
+int
+main ( void )
+{
+ unsigned long crc, poly;
+ int i, j;
+
+ poly = 0xEDB88320L;
+
+ printf("unigned long\ncrcTable[256] = {\n");
+ for (i=0; i<256; i++) {
+ crc = i;
+ for (j=8; j>0; j--) {
+ if (crc&1) {
+ crc = (crc >> 1) ^ poly;
+ } else {
+ crc >>= 1;
+ }
+ }
+ printf( "0x%lx,", crc);
+ if( (i&7) == 7 )
+ printf("\n" );
+ else
+ printf(" ");
+ }
+ printf("};\n");
+ return 0;
+}
Added: packages/libstring-crc32-perl/branches/upstream/current/t/crc.t
===================================================================
--- packages/libstring-crc32-perl/branches/upstream/current/t/crc.t 2006-04-07 18:03:25 UTC (rev 2514)
+++ packages/libstring-crc32-perl/branches/upstream/current/t/crc.t 2006-04-08 13:17:33 UTC (rev 2515)
@@ -0,0 +1,38 @@
+#!/usr/local/bin/perl -I./blib/arch -I./blib/lib
+
+require String::CRC32;
+
+$string1 = "This is the test string";
+
+$l1 = length($string1);
+
+print "1..", $l1+4, "\n";
+
+print "\n1) Test the CRC of a string variable\n";
+$v1 = String::CRC32::crc32($string1);
+print ($v1 == 1835534707 ? "ok 1\n" : "not ok 1\n");
+
+print "\n2) Test the CRC of a string\n";
+$v1 = String::CRC32::crc32("This is another test string");
+print ($v1 == 2154698217 ? "ok 2\n" : "not ok 2\n");
+
+$i = 2;
+
+$l=$l1+3;
+print "\n3..$l) Test the CRC of various substrings (using crcinit)\n";
+for ($j = 0; $j <= $l1; $j++) {
+ $v1 = String::CRC32::crc32(substr($string1, 0, $j));
+ $v1 = String::CRC32::crc32(substr($string1, $j), $v1);
+ $i++;
+ print ($v1 == 1835534707 ? "ok $i\n" : "not ok $i\n");
+}
+
+$l=$l1+4;
+print "\n$l) Test the CRC of a file\n";
+$i++;
+open(TESTFILE,"testfile") ||
+ open(TESTFILE,"t/testfile") ||
+ open(TESTFILE," ../testfile") || die "No such file!\n";
+$v1 = String::CRC32::crc32(*TESTFILE);
+close TESTFILE;
+print ($v1 == 1925609391 ? "ok $i\n" : "not ok $i\n");
Added: packages/libstring-crc32-perl/branches/upstream/current/t/testfile
===================================================================
--- packages/libstring-crc32-perl/branches/upstream/current/t/testfile 2006-04-07 18:03:25 UTC (rev 2514)
+++ packages/libstring-crc32-perl/branches/upstream/current/t/testfile 2006-04-08 13:17:33 UTC (rev 2515)
@@ -0,0 +1,2 @@
+Do not alter this file!
+Changing this file will result in a failing test!
\ No newline at end of file
Added: packages/libstring-crc32-perl/branches/upstream/current/typemap
===================================================================
--- packages/libstring-crc32-perl/branches/upstream/current/typemap 2006-04-07 18:03:25 UTC (rev 2514)
+++ packages/libstring-crc32-perl/branches/upstream/current/typemap 2006-04-08 13:17:33 UTC (rev 2515)
@@ -0,0 +1,312 @@
+# $Header$
+# basic C types
+int T_IV
+unsigned T_UV
+unsigned int T_UV
+long T_IV
+unsigned long T_UV
+short T_IV
+unsigned short T_UV
+char T_CHAR
+unsigned char T_U_CHAR
+char * T_PV
+unsigned char * T_PV
+caddr_t T_PV
+wchar_t * T_PV
+wchar_t T_IV
+bool_t T_IV
+size_t T_IV
+ssize_t T_IV
+time_t T_NV
+unsigned long * T_OPAQUEPTR
+char ** T_PACKED
+void * T_PTR
+Time_t * T_PV
+SV * T_SV
+SVREF T_SVREF
+AV * T_AVREF
+HV * T_HVREF
+CV * T_CVREF
+
+IV T_IV
+I32 T_IV
+I16 T_IV
+I8 T_IV
+U32 T_U_LONG
+U16 T_U_SHORT
+U8 T_UV
+Result T_U_CHAR
+Boolean T_IV
+double T_DOUBLE
+SysRet T_SYSRET
+SysRetLong T_SYSRET
+FILE * T_IN
+FileHandle T_PTROBJ
+InputStream T_IN
+InOutStream T_INOUT
+OutputStream T_OUT
+bool T_BOOL
+
+#############################################################################
+INPUT
+T_SV
+ $var = $arg
+T_SVREF
+ if (sv_isa($arg, \"${ntype}\"))
+ $var = (SV*)SvRV($arg);
+ else
+ croak(\"$var is not of type ${ntype}\")
+T_AVREF
+ if (sv_isa($arg, \"${ntype}\"))
+ $var = (AV*)SvRV($arg);
+ else
+ croak(\"$var is not of type ${ntype}\")
+T_HVREF
+ if (sv_isa($arg, \"${ntype}\"))
+ $var = (HV*)SvRV($arg);
+ else
+ croak(\"$var is not of type ${ntype}\")
+T_CVREF
+ if (sv_isa($arg, \"${ntype}\"))
+ $var = (CV*)SvRV($arg);
+ else
+ croak(\"$var is not of type ${ntype}\")
+T_SYSRET
+ $var NOT IMPLEMENTED
+T_UV
+ $var = ($type)SvUV($arg)
+T_IV
+ $var = ($type)SvIV($arg)
+T_INT
+ $var = (int)SvIV($arg)
+T_ENUM
+ $var = ($type)SvIV($arg)
+T_BOOL
+ $var = (int)SvIV($arg)
+T_U_INT
+ $var = (unsigned int)SvUV($arg)
+T_SHORT
+ $var = (short)SvIV($arg)
+T_U_SHORT
+ $var = (unsigned short)SvUV($arg)
+T_LONG
+ $var = (long)SvIV($arg)
+T_U_LONG
+ $var = (unsigned long)SvUV($arg)
+T_CHAR
+ $var = (char)*SvPV($arg,PL_na)
+T_U_CHAR
+ $var = (unsigned char)SvUV($arg)
+T_FLOAT
+ $var = (float)SvNV($arg)
+T_NV
+ $var = ($type)SvNV($arg)
+T_DOUBLE
+ $var = (double)SvNV($arg)
+T_PV
+ $var = ($type)SvPV($arg,PL_na)
+T_PTR
+ $var = ($type)SvIV($arg)
+T_PTRREF
+ if (SvROK($arg)) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = ($type) tmp;
+ }
+ else
+ croak(\"$var is not a reference\")
+T_REF_IV_REF
+ if (sv_isa($arg, \"${type}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = *($type *) tmp;
+ }
+ else
+ croak(\"$var is not of type ${ntype}\")
+T_REF_IV_PTR
+ if (sv_isa($arg, \"${type}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = ($type) tmp;
+ }
+ else
+ croak(\"$var is not of type ${ntype}\")
+T_PTROBJ
+ if (sv_derived_from($arg, \"${ntype}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = ($type) tmp;
+ }
+ else
+ croak(\"$var is not of type ${ntype}\")
+T_PTRDESC
+ if (sv_isa($arg, \"${ntype}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ ${type}_desc = (\U${type}_DESC\E*) tmp;
+ $var = ${type}_desc->ptr;
+ }
+ else
+ croak(\"$var is not of type ${ntype}\")
+T_REFREF
+ if (SvROK($arg)) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = *($type) tmp;
+ }
+ else
+ croak(\"$var is not a reference\")
+T_REFOBJ
+ if (sv_isa($arg, \"${ntype}\")) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = *($type) tmp;
+ }
+ else
+ croak(\"$var is not of type ${ntype}\")
+T_OPAQUE
+ $var NOT IMPLEMENTED
+T_OPAQUEPTR
+ $var = ($type)SvPV($arg,PL_na)
+T_PACKED
+ $var = XS_unpack_$ntype($arg)
+T_PACKEDARRAY
+ $var = XS_unpack_$ntype($arg)
+T_CALLBACK
+ $var = make_perl_cb_$type($arg)
+T_ARRAY
+ $var = $ntype(items -= $argoff);
+ U32 ix_$var = $argoff;
+ while (items--) {
+ DO_ARRAY_ELEM;
+ }
+T_IN
+ $var = IoIFP(sv_2io($arg))
+T_INOUT
+ $var = IoIFP(sv_2io($arg))
+T_OUT
+ $var = IoOFP(sv_2io($arg))
+#############################################################################
+OUTPUT
+T_SV
+ $arg = $var;
+T_SVREF
+ $arg = newRV((SV*)$var);
+T_AVREF
+ $arg = newRV((SV*)$var);
+T_HVREF
+ $arg = newRV((SV*)$var);
+T_CVREF
+ $arg = newRV((SV*)$var);
+T_IV
+ sv_setiv($arg, (IV)$var);
+T_UV
+ sv_setuv($arg, (UV)$var);
+T_INT
+ sv_setiv($arg, (IV)$var);
+T_SYSRET
+ if ($var != -1) {
+ if ($var == 0)
+ sv_setpvn($arg, "0 but true", 10);
+ else
+ sv_setiv($arg, (IV)$var);
+ }
+T_ENUM
+ sv_setiv($arg, (IV)$var);
+T_BOOL
+ $arg = boolSV($var);
+T_U_INT
+ sv_setuv($arg, (UV)$var);
+T_SHORT
+ sv_setiv($arg, (IV)$var);
+T_U_SHORT
+ sv_setuv($arg, (UV)$var);
+T_LONG
+ sv_setiv($arg, (IV)$var);
+T_U_LONG
+ sv_setuv($arg, (UV)$var);
+T_CHAR
+ sv_setpvn($arg, (char *)&$var, 1);
+T_U_CHAR
+ sv_setuv($arg, (UV)$var);
+T_FLOAT
+ sv_setnv($arg, (double)$var);
+T_NV
+ sv_setnv($arg, (double)$var);
+T_DOUBLE
+ sv_setnv($arg, (double)$var);
+T_PV
+ sv_setpv((SV*)$arg, $var);
+T_PTR
+ sv_setiv($arg, (IV)$var);
+T_PTRREF
+ sv_setref_pv($arg, Nullch, (void*)$var);
+T_REF_IV_REF
+ sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
+T_REF_IV_PTR
+ sv_setref_pv($arg, \"${ntype}\", (void*)$var);
+T_PTROBJ
+ sv_setref_pv($arg, \"${ntype}\", (void*)$var);
+T_PTRDESC
+ sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
+T_REFREF
+ sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
+ ($var ? (void*)new $ntype($var) : 0));
+T_REFOBJ
+ NOT IMPLEMENTED
+T_OPAQUE
+ sv_setpvn($arg, (char *)&$var, sizeof($var));
+T_OPAQUEPTR
+ sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
+T_PACKED
+ XS_pack_$ntype($arg, $var);
+T_PACKEDARRAY
+ XS_pack_$ntype($arg, $var, count_$ntype);
+T_DATAUNIT
+ sv_setpvn($arg, $var.chp(), $var.size());
+T_CALLBACK
+ sv_setpvn($arg, $var.context.value().chp(),
+ $var.context.value().size());
+T_ARRAY
+ ST_EXTEND($var.size);
+ for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
+ ST(ix_$var) = sv_newmortal();
+ DO_ARRAY_ELEM
+ }
+ SP += $var.size - 1;
+T_IN
+ {
+ GV *gv = newGVgen("$Package");
+ if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
+ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+ else
+ $arg = &PL_sv_undef;
+ }
+T_INOUT
+ {
+ GV *gv = newGVgen("$Package");
+ if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
+ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+ else
+ $arg = &PL_sv_undef;
+ }
+T_OUT
+ {
+ GV *gv = newGVgen("$Package");
+ if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
+ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+ else
+ $arg = &PL_sv_undef;
+ }
+
+# SJP
+
+TYPEMAP
+pdl* T_PDL
+pdl * T_PDL
+Logical T_IV
+float T_NV
+
+INPUT
+
+T_PDL
+ $var = PDL->SvPDLV($arg)
+
+
+OUTPUT
+
+T_PDL
+ PDL->SetSV_PDL($arg,$var);
More information about the Pkg-perl-cvs-commits
mailing list