This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade Win32API::File from version 0.1202 to 0.1203
authorSteve Hay <steve.m.hay@googlemail.com>
Sat, 19 Mar 2016 01:28:40 +0000 (01:28 +0000)
committerSteve Hay <steve.m.hay@googlemail.com>
Sat, 19 Mar 2016 01:28:40 +0000 (01:28 +0000)
Fixes perl #125303.

(Includes a regen for the moved Myconst2perl.pm.)

18 files changed:
MANIFEST
Makefile.SH
Porting/Maintainers.pl
cpan/Win32API-File/File.pm
cpan/Win32API-File/Makefile.PL
cpan/Win32API-File/buffers.h
cpan/Win32API-File/cFile.h
cpan/Win32API-File/cFile.pc
cpan/Win32API-File/const2perl.h
cpan/Win32API-File/inc/ExtUtils/Myconst2perl.pm [moved from cpan/Win32API-File/ExtUtils/Myconst2perl.pm with 96% similarity]
cpan/Win32API-File/t/file.t
cpan/Win32API-File/t/tie.t
cpan/Win32API-File/typemap
lib/.gitignore
t/porting/customized.dat
win32/GNUmakefile
win32/Makefile
win32/makefile.mk

index 5a96d16..734dc40 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2927,9 +2927,9 @@ cpan/Win32API-File/buffers.h      Win32API::File extension
 cpan/Win32API-File/cFile.h     Win32API::File extension
 cpan/Win32API-File/cFile.pc    Win32API::File extension
 cpan/Win32API-File/const2perl.h        Win32API::File extension
-cpan/Win32API-File/ExtUtils/Myconst2perl.pm    Win32API::File extension
 cpan/Win32API-File/File.pm     Win32API::File extension
 cpan/Win32API-File/File.xs     Win32API::File extension
+cpan/Win32API-File/inc/ExtUtils/Myconst2perl.pm        Win32API::File extension
 cpan/Win32API-File/Makefile.PL Win32API::File extension makefile write
 cpan/Win32API-File/t/file.t    See if Win32API::File extension works
 cpan/Win32API-File/t/tie.t     See if Win32API::File extension works
index 8282452..442dac1 100755 (executable)
@@ -1371,26 +1371,26 @@ _cleaner2:
        rm -rf pod/perlfunc pod/perlipc
        -rmdir ext/B/lib
        rm -f so_locations $(LIBPERL_NONSHR) $(MINIPERL_NONSHR)
-       -rmdir lib/version lib/threads lib/encoding lib/autodie/exception
-       -rmdir lib/autodie/Scope lib/autodie lib/XS lib/Win32API lib/VMS
-       -rmdir lib/Unicode/Collate/Locale lib/Unicode/Collate/CJK
-       -rmdir lib/Unicode/Collate lib/Tie/Hash lib/Thread lib/Text
-       -rmdir lib/Test/use lib/Test/Tester lib/Test/Builder/Tester
-       -rmdir lib/Test/Builder/IO lib/Test/Builder lib/Test lib/Term
-       -rmdir lib/TAP/Parser/YAMLish lib/TAP/Parser/SourceHandler
-       -rmdir lib/TAP/Parser/Scheduler lib/TAP/Parser/Result
-       -rmdir lib/TAP/Parser/Iterator lib/TAP/Parser lib/TAP/Harness
-       -rmdir lib/TAP/Formatter/File lib/TAP/Formatter/Console
-       -rmdir lib/TAP/Formatter lib/TAP lib/Sys/Syslog lib/Sys lib/Sub
-       -rmdir lib/Search lib/Scalar lib/Pod/Text lib/Pod/Simple
-       -rmdir lib/Pod/Perldoc lib/PerlIO/via lib/PerlIO lib/Perl
-       -rmdir lib/Parse/CPAN lib/Parse lib/Params lib/Net/FTP lib/Module/Load
-       -rmdir lib/Module/CoreList lib/Module lib/Memoize lib/Math/BigInt
-       -rmdir lib/Math/BigFloat lib/Math lib/MIME lib/Locale/Maketext
-       -rmdir lib/Locale/Codes lib/Locale lib/List/Util lib/List lib/JSON/PP
-       -rmdir lib/JSON lib/IPC lib/IO/Uncompress/Adapter lib/IO/Uncompress
-       -rmdir lib/IO/Socket lib/IO/Compress/Zlib lib/IO/Compress/Zip
-       -rmdir lib/IO/Compress/Gzip lib/IO/Compress/Base
+       -rmdir lib/version lib/threads lib/inc/ExtUtils lib/inc lib/encoding
+       -rmdir lib/autodie/exception lib/autodie/Scope lib/autodie lib/XS
+       -rmdir lib/Win32API lib/VMS lib/Unicode/Collate/Locale
+       -rmdir lib/Unicode/Collate/CJK lib/Unicode/Collate lib/Tie/Hash
+       -rmdir lib/Thread lib/Text lib/Test/use lib/Test/Tester
+       -rmdir lib/Test/Builder/Tester lib/Test/Builder/IO lib/Test/Builder
+       -rmdir lib/Test lib/Term lib/TAP/Parser/YAMLish
+       -rmdir lib/TAP/Parser/SourceHandler lib/TAP/Parser/Scheduler
+       -rmdir lib/TAP/Parser/Result lib/TAP/Parser/Iterator lib/TAP/Parser
+       -rmdir lib/TAP/Harness lib/TAP/Formatter/File
+       -rmdir lib/TAP/Formatter/Console lib/TAP/Formatter lib/TAP
+       -rmdir lib/Sys/Syslog lib/Sys lib/Sub lib/Search lib/Scalar
+       -rmdir lib/Pod/Text lib/Pod/Simple lib/Pod/Perldoc lib/PerlIO/via
+       -rmdir lib/PerlIO lib/Perl lib/Parse/CPAN lib/Parse lib/Params
+       -rmdir lib/Net/FTP lib/Module/Load lib/Module/CoreList lib/Module
+       -rmdir lib/Memoize lib/Math/BigInt lib/Math/BigFloat lib/Math lib/MIME
+       -rmdir lib/Locale/Maketext lib/Locale/Codes lib/Locale lib/List/Util
+       -rmdir lib/List lib/JSON/PP lib/JSON lib/IPC lib/IO/Uncompress/Adapter
+       -rmdir lib/IO/Uncompress lib/IO/Socket lib/IO/Compress/Zlib
+       -rmdir lib/IO/Compress/Zip lib/IO/Compress/Gzip lib/IO/Compress/Base
        -rmdir lib/IO/Compress/Adapter lib/IO/Compress lib/IO
        -rmdir lib/I18N/LangTags lib/I18N lib/Hash/Util lib/Hash lib/HTTP
        -rmdir lib/Filter/Util lib/Filter lib/File/Spec lib/ExtUtils/Typemaps
index b31d095..102e301 100755 (executable)
@@ -1309,26 +1309,11 @@ use File::Glob qw(:case);
     },
 
     'Win32API::File' => {
-        'DISTRIBUTION' => 'CHORNY/Win32API-File-0.1202.tar.gz',
+        'DISTRIBUTION' => 'CHORNY/Win32API-File-0.1203.tar.gz',
         'FILES'        => q[cpan/Win32API-File],
         'EXCLUDED'     => [
             qr{^ex/},
         ],
-
-        # Currently all EOL differences. Waiting for a new upstream release:
-        # All the files in the GitHub repo have UNIX EOLs already.
-        'CUSTOMIZED'   => [
-            qw( ExtUtils/Myconst2perl.pm
-                Makefile.PL
-                buffers.h
-                cFile.h
-                cFile.pc
-                const2perl.h
-                t/file.t
-                t/tie.t
-                typemap
-                ),
-        ],
     },
 
     'XSLoader' => {
index ca7cf3c..10c5d2f 100644 (file)
@@ -10,7 +10,7 @@ use Fcntl qw( O_RDONLY O_RDWR O_WRONLY O_APPEND O_BINARY O_TEXT );
 use vars qw( $VERSION @ISA );
 use vars qw( @EXPORT @EXPORT_OK @EXPORT_FAIL %EXPORT_TAGS );
 
-$VERSION= '0.1202';
+$VERSION= '0.1203';
 
 use base qw( Exporter DynaLoader Tie::Handle IO::File );
 
@@ -317,8 +317,8 @@ sub OsFHandleOpen {
     if ($@) {
        return tie *{$fh}, __PACKAGE__, $osfh;
     }
-    return  undef if  $fd < 0;
-    return  open( $fh, $pref."&=".$fd );
+    return  undef unless  $fd;
+    return  open( $fh, $pref."&=".(0+$fd) );
 }
 
 sub GetOsFHandle {
index 4b5f959..b0a0dc0 100644 (file)
-#!/usr/bin/perl -w
-use 5.001; #not tested
-use ExtUtils::MakeMaker;
-use Config;
-use strict;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-unless ($^O eq "MSWin32" || $^O eq "cygwin" || $^O eq "interix") { #not tested on Interix
-    die "OS unsupported\n";
-}
-
-WriteMakefile1(
-    'NAME'     => 'Win32API::File',
-    'VERSION_FROM' => 'File.pm', # finds $VERSION
-    (  $Config{archname} =~ /-object\b/i  ?  ( 'CAPI' => 'TRUE' )  :  ()  ),
-    'AUTHOR'           => 'Tye McQueen <tye@metronet.com>',
-    'ABSTRACT_FROM'    => 'File.pm',
-    'postamble' => { IMPORT_LIST => [qw(/._/ !/[a-z]/ :MEDIA_TYPE)],
-                    IFDEF => "!/[a-z\\d]/",
-                    CPLUSPLUS => 1,
-                    WRITE_PERL => 1,
-                    #PERL_FILE_LIST => ['File.pm'], #added by Chorny
-                    #C_FILE_LIST => ['File.xs'], #added by Chorny
-                    # Comment out next line to rebuild constants defs:
-                    NO_REBUILD => 1,
-                  },
-    (  ! $Config{libperl}  ?  ()  :  ( LIBPERL_A => $Config{libperl} )  ),
-    'INSTALLDIRS' => (($] >= 5.008009 and $] < 5.012) ? 'perl' : 'site'),
-    'LICENSE'  => 'perl',
-    'MIN_PERL_VERSION' => 5.001,
-    'PREREQ_PM'        => {
-        'Math::BigInt' => 0,
-        'Win32' => 0,
-        'Carp' => 0,
-        'IO::File' => 0,
-    },
-    TEST_REQUIRES => {
-        'File::Spec' => 0,
-        'Test::More' => 0,
-    },
-
-    META_MERGE => {
-        resources => {
-            repository => 'http://github.com/chorny/Win32API-File',
-        },
-    },
-    $^O =~/win/i ? (
-        dist => {
-            TAR      => 'ptar',
-            TARFLAGS => '-c -C -f',
-        },
-    ) : (),
-);
-
-# Replacement for MakeMaker's "const2perl section" for versions
-# of MakeMaker prior to the addition of this functionality:
-sub MY::postamble
-{
-    my( $self, %attribs )= @_;
-
-    # Don't do anything if MakeMaker has const2perl
-    # that already took care of all of this:
-    return   unless  %attribs;
-
-    # Don't require these here if we just C<return> above:
-    eval "use ExtUtils::Myconst2perl qw(ParseAttribs); 1"   or  die "$@";
-    eval "use ExtUtils::MakeMaker qw(neatvalue); 1"   or  die "$@";
-
-    # If only one module, can skip one level of indirection:
-    my $hvAttr= \%attribs;
-    if(  $attribs{IMPORT_LIST}  ) {
-       $hvAttr= { $self->{NAME} => \%attribs };
-    }
-
-    my( $module, @m, $_final, @clean, @realclean );
-    foreach $module (  keys %$hvAttr  ) {
-       my( $outfile, @perlfiles, @cfiles, $bin, $obj, $final, $noreb );
-
-       # Translate user-friendly options into coder-friendly specifics:
-       ParseAttribs( $module, $hvAttr->{$module}, { OUTFILE => \$outfile,
-         C_FILE_LIST => \@perlfiles, PERL_FILE_LIST => \@cfiles,
-         OBJECT => \$obj, BINARY => \$bin, FINAL_PERL => \$final,
-         NO_REBUILD => \$noreb } );
-       die "IFDEF option in Makefile.PL must be string, not code ref.\n"
-         if  ref $hvAttr->{$module}->{IFDEF};
-       die qq{IFDEF option in Makefile.PL must not contain quotes (").\n}
-         if  ref $hvAttr->{$module}->{IFDEF};
-
-       # How to create F<$outfile> via ExtUtils::Myconst2perl::Myconst2perl:
-       push @m, "
-$outfile:      @perlfiles  @cfiles  Makefile" . '
-       $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Myconst2perl \\
-         -e "my %attribs;" \\
-         ';
-       $m[-1] =~ s/^/##/gm   if  $noreb;
-       my( $key, $value );
-       while(  ( $key, $value )= each %{$hvAttr->{$module}}  ) {
-           push @m, '-e "$$attribs{' . $key . '}= ' # try {{ }} for dmake
-             . neatvalue($value) . qq[;" \\\n\t  ];
-           $m[-1] =~ s/^/##/gm   if  $noreb;
-       }
-       push @m, '-e "Myconst2perl(' . neatvalue($module) . ",%attribs)\"\n";
-
-       # If requested extra work to generate Perl instead of XS code:
-       if(  $bin  ) {
-           my @path= split /::/, $module;
-           my $_final= $final;
-           $_final =~ s/\W/_/g;
-
-           # How to compile F<$outfile> and then run it to produce F<$final>:
-           push @m, "
-$bin:  $outfile" . '
-       $(CC) $(INC) $(CCFLAGS) $(OPTIMIZE) $(PERLTYPE) $(LARGE) \\
-         $(SPLIT) $(DEFINE_VERSION) $(XS_DEFINE_VERSION) -I$(PERL_INC) \\
-         $(DEFINE)' . $outfile . " "
-         .  $self->catfile(qw[ $(PERL_INC) $(LIBPERL_A) ]) . " -o $bin
-
-$final: $bin
-       " .  $self->catfile(".",$bin) . " >$final\n";
-           $m[-1] =~ s/^/##/gm   if  $noreb;
-
-           # Make sure the rarely-used $(INST_ARCHLIB) directory exists:
-           push @m, $self->dir_target('$(INST_ARCHLIB)');
-
-           ##warn qq{$path[-1].pm should C<require "},
-           ##  join("/",@path,$final), qq{">.\n};
-           # Install F<$final> whenever regular pm_to_blib target is built:
-           push @m, "
-pm_to_blib: ${_final}_to_blib
-
-${_final}_to_blib: $final
-       " . '@$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \\
-       "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \\
-        -e "pm_to_blib({ ',neatvalue($final),',',
-       neatvalue($self->catfile('$(INST_ARCHLIB)',@path,$final)), ' },',
-       neatvalue($self->catfile(qw[$(INST_LIB) auto])), ')"
-       @$(TOUCH) ', $_final, "_to_blib
-
-realclean ::
-       $self->{RM_RF} ", $self->catfile('$(INST_ARCHLIB)', $path[0]), "\n";
-
-           push( @clean, $outfile, $bin, $obj, $_final . "_to_blib" );
-           push( @realclean, $final )   unless  $noreb;
-       } else {
-
-           ##my $name= ( split /::/, $module )[-1];
-           ##warn qq{$name.xs should C<#include "$final"> },
-           ##  qq{in the C<BOOT:> section\n};
-           push( @realclean, $outfile )   unless  $noreb;
-       }
-    }
-
-    push @m, "
-clean ::
-       $self->{RM_F} @clean\n"   if  @clean;
-    push @m, "
-realclean ::
-       $self->{RM_F} @realclean\n"   if  @realclean;
-    return join('',@m);
-}
-
-
-sub WriteMakefile1 {  #Compatibility code for old versions of EU::MM. Written by Alexandr Ciornii, version 0.23. Added by eumm-upgrade.
-       my %params=@_;
-       my $eumm_version=$ExtUtils::MakeMaker::VERSION;
-       $eumm_version=eval $eumm_version;
-       die "EXTRA_META is deprecated" if exists $params{EXTRA_META};
-       die "License not specified" if not exists $params{LICENSE};
-       if ($params{AUTHOR} and ref($params{AUTHOR}) eq 'ARRAY' and $eumm_version < 6.5705) {
-               $params{META_ADD}->{author}=$params{AUTHOR};
-               $params{AUTHOR}=join(', ',@{$params{AUTHOR}});
-       }
-       if ($params{TEST_REQUIRES} and $eumm_version < 6.64) {
-               $params{BUILD_REQUIRES}={ %{$params{BUILD_REQUIRES} || {}} , %{$params{TEST_REQUIRES}} };
-               delete $params{TEST_REQUIRES};
-       }
-       if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) {
-               #EUMM 6.5502 has problems with BUILD_REQUIRES
-               $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} };
-               delete $params{BUILD_REQUIRES};
-       }
-       delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52;
-       delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48;
-       delete $params{META_MERGE} if $eumm_version < 6.46;
-       delete $params{META_ADD} if $eumm_version < 6.46;
-       delete $params{LICENSE} if $eumm_version < 6.31;
-       delete $params{AUTHOR} if $] < 5.005;
-       delete $params{ABSTRACT_FROM} if $] < 5.005;
-       delete $params{BINARY_LOCATION} if $] < 5.005;
-
-       WriteMakefile(%params);
-}
-
+#!/usr/bin/perl -w\r
+use 5.001; #not tested\r
+use ExtUtils::MakeMaker;\r
+use Config;\r
+use strict;\r
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence\r
+# the contents of the Makefile that is written.\r
+unless ($^O eq "MSWin32" || $^O eq "cygwin" || $^O eq "interix") { #not tested on Interix\r
+    die "OS unsupported\n";\r
+}\r
+\r
+WriteMakefile1(\r
+    'NAME'     => 'Win32API::File',\r
+    'VERSION_FROM' => 'File.pm', # finds $VERSION\r
+    (  $Config{archname} =~ /-object\b/i  ?  ( 'CAPI' => 'TRUE' )  :  ()  ),\r
+    'AUTHOR'           => 'Tye McQueen <tye@metronet.com>',\r
+    'ABSTRACT_FROM'    => 'File.pm',\r
+    'postamble' => { IMPORT_LIST => [qw(/._/ !/[a-z]/ :MEDIA_TYPE)],\r
+                    IFDEF => "!/[a-z\\d]/",\r
+                    CPLUSPLUS => 1,\r
+                    WRITE_PERL => 1,\r
+                    #PERL_FILE_LIST => ['File.pm'], #added by Chorny\r
+                    #C_FILE_LIST => ['File.xs'], #added by Chorny\r
+                    # Comment out next line to rebuild constants defs:\r
+                    NO_REBUILD => 1,\r
+                  },\r
+    (  ! $Config{libperl}  ?  ()  :  ( LIBPERL_A => $Config{libperl} )  ),\r
+    'INSTALLDIRS' => (($] >= 5.008009 and $] < 5.012) ? 'perl' : 'site'),\r
+    'LICENSE'  => 'perl',\r
+    'MIN_PERL_VERSION' => 5.001,\r
+    'PREREQ_PM'        => {\r
+        'Math::BigInt' => 0,\r
+        'Win32' => 0,\r
+        'Carp' => 0,\r
+        'IO::File' => 0,\r
+    },\r
+    TEST_REQUIRES => {\r
+        'File::Spec' => 0,\r
+        'Test::More' => 0,\r
+    },\r
+\r
+    META_MERGE => {\r
+        resources => {\r
+            repository => 'http://github.com/chorny/Win32API-File',\r
+        },\r
+    },\r
+    $^O =~/win/i ? (\r
+        dist => {\r
+            TAR      => 'ptar',\r
+            TARFLAGS => '-c -C -f',\r
+        },\r
+    ) : (),\r
+);\r
+\r
+# Replacement for MakeMaker's "const2perl section" for versions\r
+# of MakeMaker prior to the addition of this functionality:\r
+sub MY::postamble\r
+{\r
+    my( $self, %attribs )= @_;\r
+\r
+    # Don't do anything if MakeMaker has const2perl\r
+    # that already took care of all of this:\r
+    return   unless  %attribs;\r
+\r
+    # Don't require these here if we just C<return> above:\r
+    eval "use lib 'inc'; use ExtUtils::Myconst2perl qw(ParseAttribs); 1"   or  die "$@";\r
+    eval "use ExtUtils::MakeMaker qw(neatvalue); 1"   or  die "$@";\r
+\r
+    # If only one module, can skip one level of indirection:\r
+    my $hvAttr= \%attribs;\r
+    if(  $attribs{IMPORT_LIST}  ) {\r
+       $hvAttr= { $self->{NAME} => \%attribs };\r
+    }\r
+\r
+    my( $module, @m, $_final, @clean, @realclean );\r
+    foreach $module (  keys %$hvAttr  ) {\r
+       my( $outfile, @perlfiles, @cfiles, $bin, $obj, $final, $noreb );\r
+\r
+       # Translate user-friendly options into coder-friendly specifics:\r
+       ParseAttribs( $module, $hvAttr->{$module}, { OUTFILE => \$outfile,\r
+         C_FILE_LIST => \@perlfiles, PERL_FILE_LIST => \@cfiles,\r
+         OBJECT => \$obj, BINARY => \$bin, FINAL_PERL => \$final,\r
+         NO_REBUILD => \$noreb } );\r
+       die "IFDEF option in Makefile.PL must be string, not code ref.\n"\r
+         if  ref $hvAttr->{$module}->{IFDEF};\r
+       die qq{IFDEF option in Makefile.PL must not contain quotes (").\n}\r
+         if  ref $hvAttr->{$module}->{IFDEF};\r
+\r
+       # How to create F<$outfile> via ExtUtils::Myconst2perl::Myconst2perl:\r
+       push @m, "\r
+$outfile:      @perlfiles  @cfiles  Makefile" . '\r
+       $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Myconst2perl \\\r
+         -e "my %attribs;" \\\r
+         ';\r
+       $m[-1] =~ s/^/##/gm   if  $noreb;\r
+       my( $key, $value );\r
+       while(  ( $key, $value )= each %{$hvAttr->{$module}}  ) {\r
+           push @m, '-e "$$attribs{' . $key . '}= ' # try {{ }} for dmake\r
+             . neatvalue($value) . qq[;" \\\n\t  ];\r
+           $m[-1] =~ s/^/##/gm   if  $noreb;\r
+       }\r
+       push @m, '-e "Myconst2perl(' . neatvalue($module) . ",%attribs)\"\n";\r
+\r
+       # If requested extra work to generate Perl instead of XS code:\r
+       if(  $bin  ) {\r
+           my @path= split /::/, $module;\r
+           my $_final= $final;\r
+           $_final =~ s/\W/_/g;\r
+\r
+           # How to compile F<$outfile> and then run it to produce F<$final>:\r
+           push @m, "\r
+$bin:  $outfile" . '\r
+       $(CC) $(INC) $(CCFLAGS) $(OPTIMIZE) $(PERLTYPE) $(LARGE) \\\r
+         $(SPLIT) $(DEFINE_VERSION) $(XS_DEFINE_VERSION) -I$(PERL_INC) \\\r
+         $(DEFINE)' . $outfile . " "\r
+         .  $self->catfile(qw[ $(PERL_INC) $(LIBPERL_A) ]) . " -o $bin\r
+\r
+$final: $bin\r
+       " .  $self->catfile(".",$bin) . " >$final\n";\r
+           $m[-1] =~ s/^/##/gm   if  $noreb;\r
+\r
+           # Make sure the rarely-used $(INST_ARCHLIB) directory exists:\r
+           push @m, $self->dir_target('$(INST_ARCHLIB)');\r
+\r
+           ##warn qq{$path[-1].pm should C<require "},\r
+           ##  join("/",@path,$final), qq{">.\n};\r
+           # Install F<$final> whenever regular pm_to_blib target is built:\r
+           push @m, "\r
+pm_to_blib: ${_final}_to_blib\r
+\r
+${_final}_to_blib: $final\r
+       " . '@$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \\\r
+       "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \\\r
+        -e "pm_to_blib({ ',neatvalue($final),',',\r
+       neatvalue($self->catfile('$(INST_ARCHLIB)',@path,$final)), ' },',\r
+       neatvalue($self->catfile(qw[$(INST_LIB) auto])), ')"\r
+       @$(TOUCH) ', $_final, "_to_blib\r
+\r
+realclean ::\r
+       $self->{RM_RF} ", $self->catfile('$(INST_ARCHLIB)', $path[0]), "\n";\r
+\r
+           push( @clean, $outfile, $bin, $obj, $_final . "_to_blib" );\r
+           push( @realclean, $final )   unless  $noreb;\r
+       } else {\r
+\r
+           ##my $name= ( split /::/, $module )[-1];\r
+           ##warn qq{$name.xs should C<#include "$final"> },\r
+           ##  qq{in the C<BOOT:> section\n};\r
+           push( @realclean, $outfile )   unless  $noreb;\r
+       }\r
+    }\r
+\r
+    push @m, "\r
+clean ::\r
+       $self->{RM_F} @clean\n"   if  @clean;\r
+    push @m, "\r
+realclean ::\r
+       $self->{RM_F} @realclean\n"   if  @realclean;\r
+    return join('',@m);\r
+}\r
+\r
+\r
+sub WriteMakefile1 {  #Compatibility code for old versions of EU::MM. Written by Alexandr Ciornii, version 0.23. Added by eumm-upgrade.\r
+       my %params=@_;\r
+       my $eumm_version=$ExtUtils::MakeMaker::VERSION;\r
+       $eumm_version=eval $eumm_version;\r
+       die "EXTRA_META is deprecated" if exists $params{EXTRA_META};\r
+       die "License not specified" if not exists $params{LICENSE};\r
+       if ($params{AUTHOR} and ref($params{AUTHOR}) eq 'ARRAY' and $eumm_version < 6.5705) {\r
+               $params{META_ADD}->{author}=$params{AUTHOR};\r
+               $params{AUTHOR}=join(', ',@{$params{AUTHOR}});\r
+       }\r
+       if ($params{TEST_REQUIRES} and $eumm_version < 6.64) {\r
+               $params{BUILD_REQUIRES}={ %{$params{BUILD_REQUIRES} || {}} , %{$params{TEST_REQUIRES}} };\r
+               delete $params{TEST_REQUIRES};\r
+       }\r
+       if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) {\r
+               #EUMM 6.5502 has problems with BUILD_REQUIRES\r
+               $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} };\r
+               delete $params{BUILD_REQUIRES};\r
+       }\r
+       delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52;\r
+       delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48;\r
+       delete $params{META_MERGE} if $eumm_version < 6.46;\r
+       delete $params{META_ADD} if $eumm_version < 6.46;\r
+       delete $params{LICENSE} if $eumm_version < 6.31;\r
+       delete $params{AUTHOR} if $] < 5.005;\r
+       delete $params{ABSTRACT_FROM} if $] < 5.005;\r
+       delete $params{BINARY_LOCATION} if $] < 5.005;\r
+\r
+       WriteMakefile(%params);\r
+}\r
+\r
index cc114e5..8877a16 100644 (file)
-/* buffers.h -- Version 1.11 */
-
-/* The following abbreviations are used at start of parameter names
- * to indicate the type of data:
- *     s       string (char * or WCHAR *) [PV]
- *     sw      wide string (WCHAR *) [PV]
- *     p       pointer (usually to some structure) [PV]
- *     a       array (packed array as in C) (usually of some structure) [PV]
- *                 called a "vector" or "vect" in some places.
- *     n       generic number [IV, UV, or NV]
- *     iv      signed integral value [IV]
- *     u       unsigned integral value [UV]
- *     d       floating-point number (double) [NV]
- *     b       boolean (bool) [IV]
- *     c       count of items [UV]
- *     l       length (in bytes) [UV]
- *     lw      length in WCHARs [UV]
- *     h       a handle [IV]
- *     r       record (structure) [PV]
- *     sv      Perl scalar (s, i, u, d, n, or rv) [SV]
- *     rv      Perl reference (usually to scalar) [RV]
- *     hv      reference to Perl hash [HV]
- *     av      reference to Perl array [AV]
- *     cv      Perl code reference [PVCV]
- *
- * Unusual combined types:
- *     pp      single pointer (to non-Perl data) packed into string [PV]
- *     pap     vector of pointers (to non-Perl data) packed into string [PV]
- *
- * Whether a parameter is for input data, output data, or both is usually
- * not reflected by the data type prefix.  In cases where this is not
- * obvious nor reflected in the variable name proper, you can use
- * the following in front of the data type prefix:
- *     i       an input parameter given to API (usually omitted)
- *     o       an Output parameter taken from API
- *     io      Input given to API then overwritten with Output taken from API
- */
-
-/* Buffer arguments are usually followed by an argument (or two) specifying
- * their size and/or returning the size of data written.  The size can be
- * measured in bytes ["lSize"] or in characters [for (char *) buffers such as
- * for *A() routines, these sizes are also called "lSize", but are called
- * "lwSize" for (WCHAR *) buffers, UNICODE strings, such as for *W() routines].
- *
- * Before calling the actual C function, you must make sure the Perl variable
- * actually has a big enough buffer allocated, and, if the user didn't want
- * to specify a buffer size, set the buffer size to be correct.  This is what
- * the grow_*() macros are for.  They also handle special meanings of the
- * buffer size argument [described below].
- *
- * Once the actual C function returns, you must set the Perl variable to know
- * the size of the written data.  This is what the trunc_*() macros are for.
- *
- * The size sometimes does and sometimes doesn't include the trailing '\0'
- * [or L'\0'], so we always add or subtract 1 in the appropriate places so
- * we don't care about this detail.
- *
- * A call may  1) request a pointer to the buffer size which means that
- * the buffer size will be overwritten with the size of the data written;
- * 2) have an extra argument which is a pointer to the place to write the
- * size of the written data;  3) provide the size of the written data in
- * the function's return value;  4) format the data so that the length
- * can be determined by examining the data [such as with '\0'-terminated
- * strings];  or  5) write fixed-length data [usually sizeof(STRUCT)].
- * This obviously determines what you should use in the trunc_*() macro
- # to specify the size of the output value.
- *
- * The user can pass in an empty list reference, C<[]>, to indicate C<NULL>
- * for the pointer to the buffer which means that they don't want that data.
- *
- * The user can pass in C<[]> or C<0> to indicate that they don't care about
- * the buffer size [we aren't programming in C here, after all] and just try
- * to get the data.  This will work if either the buffer already allocated for
- * the SV [scalar value] is large enough to hold the data or the API provides
- * an easy way to determine the required size [and the XS code uses it].
- *
- * If the user passes in a numeric value for a buffer size, then the XS
- * code makes sure that the buffer is at least large enough to hold a value
- * of that size and then passes in how large the buffer is.  So the buffer
- * size passed to the API call is the larger of the size requested by the
- * user and the size of the buffer aleady allocated to the SV.
- *
- * The user can also pass in a string consisting of a leading "=" followed
- * by digits for a buffer size.  This means just use the size specified after
- * the equals sign, even if the allocated buffer is larger.  The XS code will
- * still allocate a large enough buffer before the first call.
- *
- * If the function is nice enough to tell us that a buffer was too small
- * [usually via ERROR_MORE_DATA] _and_ how large the buffer needs to be,
- * then the XS code should enlarge the buffer(s) and repeat the call [once].
- * This resizing is _not_ done for buffers whose size was specified with a
- * leading "=".
- *
- * Only grow_buf() and perhaps trunc_buf() can be used in a typemap file.
- * The other macros would be used in the parameter declarations or INPUT:
- * section [grow_*()], the INIT: section [init_*()], or the OUTPUT: section
- * [trunc_*()].
- *
- * Buffer arguments should be initialised with C<= NO_INIT> [or C<= NULL;>].
- *
- * See also the F<typemap> file.  C<oDWORD>, for example, is for an output-
- * only parameter of type C<DWORD> and you should simply C<#define> it to be
- * C<DWORD>.  In F<typemap>, C<oDWORD> is treated differently than C<DWORD>
- * in two ways.
- *
- * First, if C<undef> is passed in, a C<DWORD> could generate a warning
- * when it gets converted to 0 while C<oDWORD> will never generate such a
- * warning for C<undef>.  This first difference doesn't apply if specific
- * initialization is specified for the variable, as in C<= init_buf_l($var);>.
- * In particular, the init_*() macros also convert C<undef> to 0 without
- * ever producing a warning.
- *
- * Second, passing in a read-only SV for a C<oDWORD> parameter will generate
- * a fatal error on output when we try to update the SV.  For C<DWORD>, we
- * won't update a read-only SV since passing in a literal constant for a
- * buffer size is a useful thing to do even though it prevents us from
- * returning the size of data written via that SV.  Since we should use a
- * trunc_*() macro to output the actual data, the user should be able to
- * determine the size of data written based on the size of the scalar we
- * output anyway.
- *
- * This second difference doesn't apply unless the parameter is listed in
- * the OUTPUT: section without specific output instructions.  We define
- * no macros for outputting buffer length parameters so be careful to use
- * C<oDWORD> [for example] for them if and only if they are output-only.
- *
- * Note that C<oDWORD> is the same as C<DWORD> in that, if a defined value
- * is passed in, it is used [and can generate a warning if the value is
- * "not numeric"].  So although C<oDWORD> is for output-only parameters,
- * we still initialize the C variable before calling the API.  This is good
- * in case the parameter isn't always strictly output-only due to upgrades,
- * bugs, etc.
- *
- * Here is a made-up example that shows several cases:
- *
- * # Actual GetDataW() returns length of data written to ioswName, not bool.
- * bool
- * GetDataW( ioswName, ilwName, oswText, iolwText, opJunk, opRec, ilRec, olRec )
- *     WCHAR * ioswName        = NO_INIT
- *     DWORD   ilwName         = NO_INIT
- *     WCHAR * oswText         = NO_INIT
- *     DWORD   &iolwText       = init_buf_l($arg);
- *     void *  opJunk          = NO_INIT
- *     BYTE *  opRec           = NO_INIT
- *     DWORD   ilRec           = init_buf_l($arg);
- *     oDWORD  &olRec
- * PREINIT:
- *     DWORD   olwName;
- * INIT:
- *     grow_buf_lw( ioswName,ST(0), ilwName,ST(1) );
- *     grow_buf_lw( oswText,ST(2), iolwText,ST(3) );
- *     grow_buf_typ( opJunk,ST(4),void *, LONG_STRUCT_TYPEDEF );
- *     grow_buf_l( opRec,ST(5),BYTE *, ilRec,ST(6) );
- * CODE:
- *     olwName= GetDataW( ioswName, ilwName, oswText, &iolwText,
- *                        (LONG_STRUCT_TYPEDEF *)opJunk, opRec, &iolRec );
- *     if(  0 == olwName  &&  ERROR_MORE_DATA == GetLastError()
- *      &&  ( autosize(ST(1)) || autosize(ST(3)) || autosize(ST(6)) )  ) {
- *         if(  autosize(ST(1))  )
- *             grow_buf_lw( ioswName,ST(0), ilwName,ST(1) );
- *         if(  autosize(ST(3))  )
- *             grow_buf_lw( oswText,ST(2), iolwText,ST(3) );
- *         if(  autosize(ST(6))  )
- *             grow_buf_l( opRec,ST(5),BYTE *, iolRec,ST(6) );
- *         olwName= GetDataW( ioswName, ilwName, oswText, &iolwText,
- *                            (LONG_STRUCT_TYPEDEF *)opJunk, opRec, &iolRec );
- *     }
- *     RETVAL=  0 != olwName;
- * OUTPUT:
- *     RETVAL
- *     ioswName        trunc_buf_lw( RETVAL, ioswName,ST(0), olwName );
- *     oswText         trunc_buf_lw( RETVAL, oswText,ST(2), iolwText );
- *     iolwText
- *     opJunk          trunc_buf_typ(RETVAL,opJunk,ST(4),LONG_STRUCT_TYPEDEF);
- *     opRec           trunc_buf_l( RETVAL, opRec,ST(5), olRec );
- *     olRec
- *
- * The above example would be more complex and less efficient if we used
- * C<DWORD * iolwText> in place of C<DWORD  &iolwText>.  The only possible
- * advantage would be that C<NULL> would be passed in for C<iolwText> if
- * _both_ C<$oswText> and C<$iolwText> were specified as C<[]>.  The *_pl*()
- * macros are defined [and C<DWORD *> specified in F<typemap>] so we can
- * handle those cases but it is usually better to use the *_l*() macros
- * instead by specifying C<&> instead of C<*>.  Using C<&> instead of C<*>
- * is usually better when dealing with scalars, even if they aren't buffer
- * sizes.  But you must use C<*> if it is important for that parameter to
- * be able to pass C<NULL> to the underlying API.
- *
- * In Win32API::, we try to use C<*> for buffer sizes of optional buffers
- * and C<&> for buffer sizes of required buffers.
- *
- * For parameters that are pointers to things other than buffers or buffer
- * sizes, we use C<*> for "important" parameters [so that using C<[]>
- * generates an error rather than fetching the value and just throwing it
- * away], and for optional parameters [in case specifying C<NULL> is or
- * becomes important].  Otherwise we use C<&> [for "unimportant" but
- * required parameters] so the user can specify C<[]> if they don't care
- * about it.  The output handle of an "open" routine is "important".
- */
-
-#ifndef Debug
-# define       Debug(list)     /*Nothing*/
-#endif
-
-/*#ifndef CAST
- *# ifdef __cplusplus
- *#  define   CAST(type,expr)  static_cast<type>(expr)
- *# else*/
-#  define   CAST(type,expr)    (type)(expr)
-/*# endif
- *#endif*/
-
-/* Is an argument C<[]>, meaning we should pass C<NULL>? */
-#define null_arg(sv)   (  SvROK(sv)  &&  SVt_PVAV == SvTYPE(SvRV(sv))  \
-                          &&  -1 == av_len((AV*)SvRV(sv))  )
-
-#define PV_or_null(sv) ( null_arg(sv) ? NULL : SvPV_nolen(sv) )
-
-/* Minimum buffer size to use when no buffer existed: */
-#define MIN_GROW_SIZE  128
-
-#ifdef Debug
-/* Used in Debug() messages to show which macro call is involved: */
-#define string(arg) #arg
-#endif
-
-/* Simplify using SvGROW() for byte-sized buffers: */
-#define lSvGROW(sv,n)  SvGROW( sv, 0==(n) ? MIN_GROW_SIZE : (n)+1 )
-
-/* Simplify using SvGROW() for WCHAR-sized buffers: */
-#define lwSvGROW(sv,n) CAST( WCHAR *,          \
-       SvGROW( sv, sizeof(WCHAR)*( 0==(n) ? MIN_GROW_SIZE : (n)+1 ) ) )
-
-/* Whether the buffer size we got lets us change what buffer size we use: */
-#define autosize(sv)   (!(  SvOK(sv)  &&  ! SvROK(sv)          \
-                        &&  SvPV_nolen(sv)  &&  '=' == *SvPV_nolen(sv)  ))
-
-/* Get the IV/UV for a parameter that might be C<[]> or C<undef>: */
-#define optIV(sv)      ( null_arg(sv) ? 0 : !SvOK(sv) ? 0 : SvIV(sv) )
-#define optUV(sv)      ( null_arg(sv) ? 0 : !SvOK(sv) ? 0 : SvUV(sv) )
-
-/* Allocate temporary storage that will automatically be freed later: */
-#ifndef TempAlloc      /* Can be C<#define>d to be C<_alloca>, for example */
-# define TempAlloc( size )     sv_grow( sv_newmortal(), size )
-#endif
-
-/* Initialize a buffer size argument of type (DWORD *): */
-#define init_buf_pl( plSize, svSize, tpSize )          STMT_START {    \
-       if(  null_arg(svSize)  )                                        \
-           plSize= NULL;                                               \
-       else {                                                          \
-           STRLEN n_a;                                                 \
-           *( plSize= CAST( tpSize, TempAlloc(sizeof(*plSize)) ) )=    \
-             autosize(svSize) ? optUV(svSize)                          \
-               : strtoul( 1+SvPV(svSize,n_a), NULL, 10 );              \
-       } } STMT_END
-/* In INPUT section put ": init_buf_pl($var,$arg,$type);" after var name. */
-
-/* Initialize a buffer size argument of type DWORD: */
-#define init_buf_l( svSize )                                           \
-       (  null_arg(svSize) ? 0 : autosize(svSize) ? optUV(svSize)      \
-          : strtoul( 1+SvPV_nolen(svSize), NULL, 10 )  )
-/* In INPUT section put "= init_buf_l($arg);" after variable name. */
-
-/* Lengths in WCHARs are initialized the same as lengths in bytes: */
-#define init_buf_plw   init_buf_pl
-#define init_buf_lw    init_buf_l
-
-/* grow_buf_pl() and grow_buf_plw() are included so you can define
- * parameters of type C<DWORD *>, for example.  In practice, it is
- * usually better to define such parameters as "DWORD &". */
-
-/* Grow a buffer where we have a pointer to its size in bytes: */
-#define        grow_buf_pl( sBuf,svBuf,tpBuf, plSize,svSize,tpSize ) STMT_START { \
-       Debug(("grow_buf_pl( %s==0x%lX,[%s:%ld/%ld, %s==0x%lX:%ld,[%s )\n",\
-         string(sBuf),sBuf,strchr(string(svBuf),'('),SvPOK(svBuf)?     \
-         SvCUR(svBuf):-1,SvPOK(svBuf)?SvLEN(svBuf):-1,string(plSize),  \
-         plSize,plSize?*plSize:-1,strchr(string(svSize),'(')));        \
-       if(  null_arg(svBuf)  ) {                                       \
-           sBuf= NULL;                                                 \
-       } else {                                                        \
-           STRLEN n_a;                                                 \
-           if(  NULL == plSize  )                                      \
-               *( plSize= CAST(tpSize,TempAlloc(sizeof(*plSize))) )= 0;\
-           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \
-           (void) SvPV_force( svBuf, n_a );                            \
-           sBuf= CAST( tpBuf, lSvGROW( svBuf, *plSize ) );             \
-           if(  autosize(svSize)  )   *plSize= SvLEN(svBuf) - 1;       \
-           Debug(("more buf_pl( %s==0x%lX,[%s:%ld/%ld, %s==0x%lX:%ld,[%s )\n",\
-             string(sBuf),sBuf,strchr(string(svBuf),'('),SvPOK(svBuf)? \
-             SvCUR(svBuf):-1,SvPOK(svBuf)?SvLEN(svBuf):-1,string(plSize),\
-             plSize,plSize?*plSize:-1,strchr(string(svSize),'(')));    \
-       } } STMT_END
-
-/* Grow a buffer where we have a pointer to its size in WCHARs: */
-#define        grow_buf_plw( sBuf,svBuf, plwSize,svSize,tpSize ) STMT_START {  \
-       if(  null_arg(svBuf)  ) {                                       \
-           sBuf= NULL;                                                 \
-       } else {                                                        \
-           STRLEN n_a;                                                 \
-           if(  NULL == plwSize  )                                     \
-               *( plwSize= CAST(tpSize,TempAlloc(sizeof(*plwSize))) )= 0;\
-           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \
-           (void) SvPV_force( svBuf, n_a );                            \
-           sBuf= lwSvGROW( svBuf, *plwSize );                          \
-           if(  autosize(svSize)  )                                    \
-               *plwSize= SvLEN(svBuf)/sizeof(WCHAR) - 1;               \
-       } } STMT_END
-
-/* Grow a buffer where we have its size in bytes: */
-#define        grow_buf_l( sBuf,svBuf,tpBuf, lSize,svSize )    STMT_START {    \
-       if(  null_arg(svBuf)  ) {                                       \
-           sBuf= NULL;                                                 \
-       } else {                                                        \
-           STRLEN n_a;                                                 \
-           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \
-           (void) SvPV_force( svBuf, n_a );                            \
-           sBuf= CAST( tpBuf, lSvGROW( svBuf, lSize ) );               \
-           if(  autosize(svSize)  )   lSize= SvLEN(svBuf) - 1;         \
-       } } STMT_END
-
-/* Grow a buffer where we have its size in WCHARs: */
-#define        grow_buf_lw( swBuf,svBuf, lwSize,svSize )       STMT_START {    \
-       if(  null_arg(svBuf)  ) {                                       \
-           swBuf= NULL;                                                \
-       } else {                                                        \
-           STRLEN n_a;                                                 \
-           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \
-           (void) SvPV_force( svBuf, n_a );                            \
-           swBuf= lwSvGROW( svBuf, lwSize );                           \
-           if(  autosize(svSize)  )                                    \
-               lwSize= SvLEN(svBuf)/sizeof(WCHAR) - 1;                 \
-       } } STMT_END
-
-/* Grow a buffer that contains the declared fixed data type: */
-#define        grow_buf( pBuf,svBuf, tpBuf )                   STMT_START {    \
-       if(  null_arg(svBuf)  ) {                                       \
-           pBuf= NULL;                                                 \
-       } else {                                                        \
-           STRLEN n_a;                                                 \
-           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \
-           (void) SvPV_force( svBuf, n_a );                            \
-           pBuf= CAST( tpBuf, SvGROW( svBuf, sizeof(*pBuf) ) );        \
-       } } STMT_END
-
-/* Grow a buffer that contains a fixed data type other than that declared: */
-#define        grow_buf_typ( pBuf,svBuf,tpBuf, Type )          STMT_START {    \
-       if(  null_arg(svBuf)  ) {                                       \
-           pBuf= NULL;                                                 \
-       } else {                                                        \
-           STRLEN n_a;                                                 \
-           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \
-           (void) SvPV_force( svBuf, n_a );                            \
-           pBuf= CAST( tpBuf, SvGROW( svBuf, sizeof(Type) ) ); \
-       } } STMT_END
-
-/* Grow a buffer that contains a list of items of the declared data type: */
-#define        grow_vect( pBuf,svBuf,tpBuf, cItems )           STMT_START {    \
-       if(  null_arg(svBuf)  ) {                                       \
-           pBuf= NULL;                                                 \
-       } else {                                                        \
-           STRLEN n_a;                                                 \
-           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \
-           (void) SvPV_force( svBuf, n_a );                            \
-           pBuf= CAST( tpBuf, SvGROW( svBuf, sizeof(*pBuf)*cItems ) ); \
-       } } STMT_END
-
-/* If call succeeded, set data length to returned length (in bytes): */
-#define        trunc_buf_l( bOkay, sBuf,svBuf, lSize )         STMT_START {    \
-       if(  bOkay  &&  NULL != sBuf  ) {                               \
-           SvPOK_only( svBuf );                                        \
-           SvCUR_set( svBuf, lSize );                                  \
-       } } STMT_END
-
-/* Same as above except we have a pointer to the returned length: */
-#define        trunc_buf_pl( bOkay, sBuf,svBuf, plSize )                       \
-       trunc_buf_l( bOkay, sBuf,svBuf, *plSize )
-
-/* If call succeeded, set data length to returned length (in WCHARs): */
-#define        trunc_buf_lw( bOkay, sBuf,svBuf, lwSize )       STMT_START {    \
-       if(  bOkay  &&  NULL != sBuf  ) {                               \
-           SvPOK_only( svBuf );                                        \
-           SvCUR_set( svBuf, (lwSize)*sizeof(WCHAR) );                 \
-       } } STMT_END
-
-/* Same as above except we have a pointer to the returned length: */
-#define        trunc_buf_plw( bOkay, swBuf,svBuf, plwSize )                    \
-       trunc_buf_lw( bOkay, swBuf,svBuf, *plwSize )
-
-/* Set data length for a buffer that contains the declared fixed data type: */
-#define        trunc_buf( bOkay, pBuf,svBuf )                  STMT_START {    \
-       if(  bOkay  &&  NULL != pBuf  ) {                               \
-           SvPOK_only( svBuf );                                        \
-           SvCUR_set( svBuf, sizeof(*pBuf) );                          \
-       } } STMT_END
-
-/* Set data length for a buffer that contains some other fixed data type: */
-#define        trunc_buf_typ( bOkay, pBuf,svBuf, Type )        STMT_START {    \
-       if(  bOkay  &&  NULL != pBuf  ) {                               \
-           SvPOK_only( svBuf );                                        \
-           SvCUR_set( svBuf, sizeof(Type) );                           \
-       } } STMT_END
-
-/* Set length for buffer that contains list of items of the declared type: */
-#define        trunc_vect( bOkay, pBuf,svBuf, cItems )         STMT_START {    \
-       if(  bOkay  &&  NULL != pBuf  ) {                               \
-           SvPOK_only( svBuf );                                        \
-           SvCUR_set( svBuf, sizeof(*pBuf)*cItems );                   \
-       } } STMT_END
-
-/* Set data length for a buffer where a '\0'-terminate string was stored: */
-#define        trunc_buf_z( bOkay, sBuf,svBuf )                STMT_START {    \
-       if(  bOkay  &&  NULL != sBuf  ) {                               \
-           SvPOK_only( svBuf );                                        \
-           SvCUR_set( svBuf, strlen(sBuf) );                           \
-       } } STMT_END
-
-/* Set data length for a buffer where a L'\0'-terminate string was stored: */
-#define        trunc_buf_zw( bOkay, sBuf,svBuf )               STMT_START {    \
-       if(  bOkay  &&  NULL != sBuf  ) {                               \
-           SvPOK_only( svBuf );                                        \
-           SvCUR_set( svBuf, wcslen(sBuf)*sizeof(WCHAR) );             \
-       } } STMT_END
+/* buffers.h -- Version 1.11 */\r
+\r
+/* The following abbreviations are used at start of parameter names\r
+ * to indicate the type of data:\r
+ *     s       string (char * or WCHAR *) [PV]\r
+ *     sw      wide string (WCHAR *) [PV]\r
+ *     p       pointer (usually to some structure) [PV]\r
+ *     a       array (packed array as in C) (usually of some structure) [PV]\r
+ *                 called a "vector" or "vect" in some places.\r
+ *     n       generic number [IV, UV, or NV]\r
+ *     iv      signed integral value [IV]\r
+ *     u       unsigned integral value [UV]\r
+ *     d       floating-point number (double) [NV]\r
+ *     b       boolean (bool) [IV]\r
+ *     c       count of items [UV]\r
+ *     l       length (in bytes) [UV]\r
+ *     lw      length in WCHARs [UV]\r
+ *     h       a handle [IV]\r
+ *     r       record (structure) [PV]\r
+ *     sv      Perl scalar (s, i, u, d, n, or rv) [SV]\r
+ *     rv      Perl reference (usually to scalar) [RV]\r
+ *     hv      reference to Perl hash [HV]\r
+ *     av      reference to Perl array [AV]\r
+ *     cv      Perl code reference [PVCV]\r
+ *\r
+ * Unusual combined types:\r
+ *     pp      single pointer (to non-Perl data) packed into string [PV]\r
+ *     pap     vector of pointers (to non-Perl data) packed into string [PV]\r
+ *\r
+ * Whether a parameter is for input data, output data, or both is usually\r
+ * not reflected by the data type prefix.  In cases where this is not\r
+ * obvious nor reflected in the variable name proper, you can use\r
+ * the following in front of the data type prefix:\r
+ *     i       an input parameter given to API (usually omitted)\r
+ *     o       an Output parameter taken from API\r
+ *     io      Input given to API then overwritten with Output taken from API\r
+ */\r
+\r
+/* Buffer arguments are usually followed by an argument (or two) specifying\r
+ * their size and/or returning the size of data written.  The size can be\r
+ * measured in bytes ["lSize"] or in characters [for (char *) buffers such as\r
+ * for *A() routines, these sizes are also called "lSize", but are called\r
+ * "lwSize" for (WCHAR *) buffers, UNICODE strings, such as for *W() routines].\r
+ *\r
+ * Before calling the actual C function, you must make sure the Perl variable\r
+ * actually has a big enough buffer allocated, and, if the user didn't want\r
+ * to specify a buffer size, set the buffer size to be correct.  This is what\r
+ * the grow_*() macros are for.  They also handle special meanings of the\r
+ * buffer size argument [described below].\r
+ *\r
+ * Once the actual C function returns, you must set the Perl variable to know\r
+ * the size of the written data.  This is what the trunc_*() macros are for.\r
+ *\r
+ * The size sometimes does and sometimes doesn't include the trailing '\0'\r
+ * [or L'\0'], so we always add or subtract 1 in the appropriate places so\r
+ * we don't care about this detail.\r
+ *\r
+ * A call may  1) request a pointer to the buffer size which means that\r
+ * the buffer size will be overwritten with the size of the data written;\r
+ * 2) have an extra argument which is a pointer to the place to write the\r
+ * size of the written data;  3) provide the size of the written data in\r
+ * the function's return value;  4) format the data so that the length\r
+ * can be determined by examining the data [such as with '\0'-terminated\r
+ * strings];  or  5) write fixed-length data [usually sizeof(STRUCT)].\r
+ * This obviously determines what you should use in the trunc_*() macro\r
+ # to specify the size of the output value.\r
+ *\r
+ * The user can pass in an empty list reference, C<[]>, to indicate C<NULL>\r
+ * for the pointer to the buffer which means that they don't want that data.\r
+ *\r
+ * The user can pass in C<[]> or C<0> to indicate that they don't care about\r
+ * the buffer size [we aren't programming in C here, after all] and just try\r
+ * to get the data.  This will work if either the buffer already allocated for\r
+ * the SV [scalar value] is large enough to hold the data or the API provides\r
+ * an easy way to determine the required size [and the XS code uses it].\r
+ *\r
+ * If the user passes in a numeric value for a buffer size, then the XS\r
+ * code makes sure that the buffer is at least large enough to hold a value\r
+ * of that size and then passes in how large the buffer is.  So the buffer\r
+ * size passed to the API call is the larger of the size requested by the\r
+ * user and the size of the buffer already allocated to the SV.\r
+ *\r
+ * The user can also pass in a string consisting of a leading "=" followed\r
+ * by digits for a buffer size.  This means just use the size specified after\r
+ * the equals sign, even if the allocated buffer is larger.  The XS code will\r
+ * still allocate a large enough buffer before the first call.\r
+ *\r
+ * If the function is nice enough to tell us that a buffer was too small\r
+ * [usually via ERROR_MORE_DATA] _and_ how large the buffer needs to be,\r
+ * then the XS code should enlarge the buffer(s) and repeat the call [once].\r
+ * This resizing is _not_ done for buffers whose size was specified with a\r
+ * leading "=".\r
+ *\r
+ * Only grow_buf() and perhaps trunc_buf() can be used in a typemap file.\r
+ * The other macros would be used in the parameter declarations or INPUT:\r
+ * section [grow_*()], the INIT: section [init_*()], or the OUTPUT: section\r
+ * [trunc_*()].\r
+ *\r
+ * Buffer arguments should be initialised with C<= NO_INIT> [or C<= NULL;>].\r
+ *\r
+ * See also the F<typemap> file.  C<oDWORD>, for example, is for an output-\r
+ * only parameter of type C<DWORD> and you should simply C<#define> it to be\r
+ * C<DWORD>.  In F<typemap>, C<oDWORD> is treated differently than C<DWORD>\r
+ * in two ways.\r
+ *\r
+ * First, if C<undef> is passed in, a C<DWORD> could generate a warning\r
+ * when it gets converted to 0 while C<oDWORD> will never generate such a\r
+ * warning for C<undef>.  This first difference doesn't apply if specific\r
+ * initialization is specified for the variable, as in C<= init_buf_l($var);>.\r
+ * In particular, the init_*() macros also convert C<undef> to 0 without\r
+ * ever producing a warning.\r
+ *\r
+ * Second, passing in a read-only SV for a C<oDWORD> parameter will generate\r
+ * a fatal error on output when we try to update the SV.  For C<DWORD>, we\r
+ * won't update a read-only SV since passing in a literal constant for a\r
+ * buffer size is a useful thing to do even though it prevents us from\r
+ * returning the size of data written via that SV.  Since we should use a\r
+ * trunc_*() macro to output the actual data, the user should be able to\r
+ * determine the size of data written based on the size of the scalar we\r
+ * output anyway.\r
+ *\r
+ * This second difference doesn't apply unless the parameter is listed in\r
+ * the OUTPUT: section without specific output instructions.  We define\r
+ * no macros for outputting buffer length parameters so be careful to use\r
+ * C<oDWORD> [for example] for them if and only if they are output-only.\r
+ *\r
+ * Note that C<oDWORD> is the same as C<DWORD> in that, if a defined value\r
+ * is passed in, it is used [and can generate a warning if the value is\r
+ * "not numeric"].  So although C<oDWORD> is for output-only parameters,\r
+ * we still initialize the C variable before calling the API.  This is good\r
+ * in case the parameter isn't always strictly output-only due to upgrades,\r
+ * bugs, etc.\r
+ *\r
+ * Here is a made-up example that shows several cases:\r
+ *\r
+ * # Actual GetDataW() returns length of data written to ioswName, not bool.\r
+ * bool\r
+ * GetDataW( ioswName, ilwName, oswText, iolwText, opJunk, opRec, ilRec, olRec )\r
+ *     WCHAR * ioswName        = NO_INIT\r
+ *     DWORD   ilwName         = NO_INIT\r
+ *     WCHAR * oswText         = NO_INIT\r
+ *     DWORD   &iolwText       = init_buf_l($arg);\r
+ *     void *  opJunk          = NO_INIT\r
+ *     BYTE *  opRec           = NO_INIT\r
+ *     DWORD   ilRec           = init_buf_l($arg);\r
+ *     oDWORD  &olRec\r
+ * PREINIT:\r
+ *     DWORD   olwName;\r
+ * INIT:\r
+ *     grow_buf_lw( ioswName,ST(0), ilwName,ST(1) );\r
+ *     grow_buf_lw( oswText,ST(2), iolwText,ST(3) );\r
+ *     grow_buf_typ( opJunk,ST(4),void *, LONG_STRUCT_TYPEDEF );\r
+ *     grow_buf_l( opRec,ST(5),BYTE *, ilRec,ST(6) );\r
+ * CODE:\r
+ *     olwName= GetDataW( ioswName, ilwName, oswText, &iolwText,\r
+ *                        (LONG_STRUCT_TYPEDEF *)opJunk, opRec, &iolRec );\r
+ *     if(  0 == olwName  &&  ERROR_MORE_DATA == GetLastError()\r
+ *      &&  ( autosize(ST(1)) || autosize(ST(3)) || autosize(ST(6)) )  ) {\r
+ *         if(  autosize(ST(1))  )\r
+ *             grow_buf_lw( ioswName,ST(0), ilwName,ST(1) );\r
+ *         if(  autosize(ST(3))  )\r
+ *             grow_buf_lw( oswText,ST(2), iolwText,ST(3) );\r
+ *         if(  autosize(ST(6))  )\r
+ *             grow_buf_l( opRec,ST(5),BYTE *, iolRec,ST(6) );\r
+ *         olwName= GetDataW( ioswName, ilwName, oswText, &iolwText,\r
+ *                            (LONG_STRUCT_TYPEDEF *)opJunk, opRec, &iolRec );\r
+ *     }\r
+ *     RETVAL=  0 != olwName;\r
+ * OUTPUT:\r
+ *     RETVAL\r
+ *     ioswName        trunc_buf_lw( RETVAL, ioswName,ST(0), olwName );\r
+ *     oswText         trunc_buf_lw( RETVAL, oswText,ST(2), iolwText );\r
+ *     iolwText\r
+ *     opJunk          trunc_buf_typ(RETVAL,opJunk,ST(4),LONG_STRUCT_TYPEDEF);\r
+ *     opRec           trunc_buf_l( RETVAL, opRec,ST(5), olRec );\r
+ *     olRec\r
+ *\r
+ * The above example would be more complex and less efficient if we used\r
+ * C<DWORD * iolwText> in place of C<DWORD  &iolwText>.  The only possible\r
+ * advantage would be that C<NULL> would be passed in for C<iolwText> if\r
+ * _both_ C<$oswText> and C<$iolwText> were specified as C<[]>.  The *_pl*()\r
+ * macros are defined [and C<DWORD *> specified in F<typemap>] so we can\r
+ * handle those cases but it is usually better to use the *_l*() macros\r
+ * instead by specifying C<&> instead of C<*>.  Using C<&> instead of C<*>\r
+ * is usually better when dealing with scalars, even if they aren't buffer\r
+ * sizes.  But you must use C<*> if it is important for that parameter to\r
+ * be able to pass C<NULL> to the underlying API.\r
+ *\r
+ * In Win32API::, we try to use C<*> for buffer sizes of optional buffers\r
+ * and C<&> for buffer sizes of required buffers.\r
+ *\r
+ * For parameters that are pointers to things other than buffers or buffer\r
+ * sizes, we use C<*> for "important" parameters [so that using C<[]>\r
+ * generates an error rather than fetching the value and just throwing it\r
+ * away], and for optional parameters [in case specifying C<NULL> is or\r
+ * becomes important].  Otherwise we use C<&> [for "unimportant" but\r
+ * required parameters] so the user can specify C<[]> if they don't care\r
+ * about it.  The output handle of an "open" routine is "important".\r
+ */\r
+\r
+#ifndef Debug\r
+# define       Debug(list)     /*Nothing*/\r
+#endif\r
+\r
+/*#ifndef CAST\r
+ *# ifdef __cplusplus\r
+ *#  define   CAST(type,expr)  static_cast<type>(expr)\r
+ *# else*/\r
+#  define   CAST(type,expr)    (type)(expr)\r
+/*# endif\r
+ *#endif*/\r
+\r
+/* Is an argument C<[]>, meaning we should pass C<NULL>? */\r
+#define null_arg(sv)   (  SvROK(sv)  &&  SVt_PVAV == SvTYPE(SvRV(sv))  \\r
+                          &&  -1 == av_len((AV*)SvRV(sv))  )\r
+\r
+#define PV_or_null(sv) ( null_arg(sv) ? NULL : SvPV_nolen(sv) )\r
+\r
+/* Minimum buffer size to use when no buffer existed: */\r
+#define MIN_GROW_SIZE  128\r
+\r
+#ifdef Debug\r
+/* Used in Debug() messages to show which macro call is involved: */\r
+#define string(arg) #arg\r
+#endif\r
+\r
+/* Simplify using SvGROW() for byte-sized buffers: */\r
+#define lSvGROW(sv,n)  SvGROW( sv, 0==(n) ? MIN_GROW_SIZE : (n)+1 )\r
+\r
+/* Simplify using SvGROW() for WCHAR-sized buffers: */\r
+#define lwSvGROW(sv,n) CAST( WCHAR *,          \\r
+       SvGROW( sv, sizeof(WCHAR)*( 0==(n) ? MIN_GROW_SIZE : (n)+1 ) ) )\r
+\r
+/* Whether the buffer size we got lets us change what buffer size we use: */\r
+#define autosize(sv)   (!(  SvOK(sv)  &&  ! SvROK(sv)          \\r
+                        &&  SvPV_nolen(sv)  &&  '=' == *SvPV_nolen(sv)  ))\r
+\r
+/* Get the IV/UV for a parameter that might be C<[]> or C<undef>: */\r
+#define optIV(sv)      ( null_arg(sv) ? 0 : !SvOK(sv) ? 0 : SvIV(sv) )\r
+#define optUV(sv)      ( null_arg(sv) ? 0 : !SvOK(sv) ? 0 : SvUV(sv) )\r
+\r
+/* Allocate temporary storage that will automatically be freed later: */\r
+#ifndef TempAlloc      /* Can be C<#define>d to be C<_alloca>, for example */\r
+# define TempAlloc( size )     sv_grow( sv_newmortal(), size )\r
+#endif\r
+\r
+/* Initialize a buffer size argument of type (DWORD *): */\r
+#define init_buf_pl( plSize, svSize, tpSize )          STMT_START {    \\r
+       if(  null_arg(svSize)  )                                        \\r
+           plSize= NULL;                                               \\r
+       else {                                                          \\r
+           STRLEN n_a;                                                 \\r
+           *( plSize= CAST( tpSize, TempAlloc(sizeof(*plSize)) ) )=    \\r
+             autosize(svSize) ? optUV(svSize)                          \\r
+               : strtoul( 1+SvPV(svSize,n_a), NULL, 10 );              \\r
+       } } STMT_END\r
+/* In INPUT section put ": init_buf_pl($var,$arg,$type);" after var name. */\r
+\r
+/* Initialize a buffer size argument of type DWORD: */\r
+#define init_buf_l( svSize )                                           \\r
+       (  null_arg(svSize) ? 0 : autosize(svSize) ? optUV(svSize)      \\r
+          : strtoul( 1+SvPV_nolen(svSize), NULL, 10 )  )\r
+/* In INPUT section put "= init_buf_l($arg);" after variable name. */\r
+\r
+/* Lengths in WCHARs are initialized the same as lengths in bytes: */\r
+#define init_buf_plw   init_buf_pl\r
+#define init_buf_lw    init_buf_l\r
+\r
+/* grow_buf_pl() and grow_buf_plw() are included so you can define\r
+ * parameters of type C<DWORD *>, for example.  In practice, it is\r
+ * usually better to define such parameters as "DWORD &". */\r
+\r
+/* Grow a buffer where we have a pointer to its size in bytes: */\r
+#define        grow_buf_pl( sBuf,svBuf,tpBuf, plSize,svSize,tpSize ) STMT_START { \\r
+       Debug(("grow_buf_pl( %s==0x%lX,[%s:%ld/%ld, %s==0x%lX:%ld,[%s )\n",\\r
+         string(sBuf),sBuf,strchr(string(svBuf),'('),SvPOK(svBuf)?     \\r
+         SvCUR(svBuf):-1,SvPOK(svBuf)?SvLEN(svBuf):-1,string(plSize),  \\r
+         plSize,plSize?*plSize:-1,strchr(string(svSize),'(')));        \\r
+       if(  null_arg(svBuf)  ) {                                       \\r
+           sBuf= NULL;                                                 \\r
+       } else {                                                        \\r
+           STRLEN n_a;                                                 \\r
+           if(  NULL == plSize  )                                      \\r
+               *( plSize= CAST(tpSize,TempAlloc(sizeof(*plSize))) )= 0;\\r
+           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \\r
+           (void) SvPV_force( svBuf, n_a );                            \\r
+           sBuf= CAST( tpBuf, lSvGROW( svBuf, *plSize ) );             \\r
+           if(  autosize(svSize)  )   *plSize= SvLEN(svBuf) - 1;       \\r
+           Debug(("more buf_pl( %s==0x%lX,[%s:%ld/%ld, %s==0x%lX:%ld,[%s )\n",\\r
+             string(sBuf),sBuf,strchr(string(svBuf),'('),SvPOK(svBuf)? \\r
+             SvCUR(svBuf):-1,SvPOK(svBuf)?SvLEN(svBuf):-1,string(plSize),\\r
+             plSize,plSize?*plSize:-1,strchr(string(svSize),'(')));    \\r
+       } } STMT_END\r
+\r
+/* Grow a buffer where we have a pointer to its size in WCHARs: */\r
+#define        grow_buf_plw( sBuf,svBuf, plwSize,svSize,tpSize ) STMT_START {  \\r
+       if(  null_arg(svBuf)  ) {                                       \\r
+           sBuf= NULL;                                                 \\r
+       } else {                                                        \\r
+           STRLEN n_a;                                                 \\r
+           if(  NULL == plwSize  )                                     \\r
+               *( plwSize= CAST(tpSize,TempAlloc(sizeof(*plwSize))) )= 0;\\r
+           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \\r
+           (void) SvPV_force( svBuf, n_a );                            \\r
+           sBuf= lwSvGROW( svBuf, *plwSize );                          \\r
+           if(  autosize(svSize)  )                                    \\r
+               *plwSize= SvLEN(svBuf)/sizeof(WCHAR) - 1;               \\r
+       } } STMT_END\r
+\r
+/* Grow a buffer where we have its size in bytes: */\r
+#define        grow_buf_l( sBuf,svBuf,tpBuf, lSize,svSize )    STMT_START {    \\r
+       if(  null_arg(svBuf)  ) {                                       \\r
+           sBuf= NULL;                                                 \\r
+       } else {                                                        \\r
+           STRLEN n_a;                                                 \\r
+           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \\r
+           (void) SvPV_force( svBuf, n_a );                            \\r
+           sBuf= CAST( tpBuf, lSvGROW( svBuf, lSize ) );               \\r
+           if(  autosize(svSize)  )   lSize= SvLEN(svBuf) - 1;         \\r
+       } } STMT_END\r
+\r
+/* Grow a buffer where we have its size in WCHARs: */\r
+#define        grow_buf_lw( swBuf,svBuf, lwSize,svSize )       STMT_START {    \\r
+       if(  null_arg(svBuf)  ) {                                       \\r
+           swBuf= NULL;                                                \\r
+       } else {                                                        \\r
+           STRLEN n_a;                                                 \\r
+           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \\r
+           (void) SvPV_force( svBuf, n_a );                            \\r
+           swBuf= lwSvGROW( svBuf, lwSize );                           \\r
+           if(  autosize(svSize)  )                                    \\r
+               lwSize= SvLEN(svBuf)/sizeof(WCHAR) - 1;                 \\r
+       } } STMT_END\r
+\r
+/* Grow a buffer that contains the declared fixed data type: */\r
+#define        grow_buf( pBuf,svBuf, tpBuf )                   STMT_START {    \\r
+       if(  null_arg(svBuf)  ) {                                       \\r
+           pBuf= NULL;                                                 \\r
+       } else {                                                        \\r
+           STRLEN n_a;                                                 \\r
+           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \\r
+           (void) SvPV_force( svBuf, n_a );                            \\r
+           pBuf= CAST( tpBuf, SvGROW( svBuf, sizeof(*pBuf) ) );        \\r
+       } } STMT_END\r
+\r
+/* Grow a buffer that contains a fixed data type other than that declared: */\r
+#define        grow_buf_typ( pBuf,svBuf,tpBuf, Type )          STMT_START {    \\r
+       if(  null_arg(svBuf)  ) {                                       \\r
+           pBuf= NULL;                                                 \\r
+       } else {                                                        \\r
+           STRLEN n_a;                                                 \\r
+           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \\r
+           (void) SvPV_force( svBuf, n_a );                            \\r
+           pBuf= CAST( tpBuf, SvGROW( svBuf, sizeof(Type) ) ); \\r
+       } } STMT_END\r
+\r
+/* Grow a buffer that contains a list of items of the declared data type: */\r
+#define        grow_vect( pBuf,svBuf,tpBuf, cItems )           STMT_START {    \\r
+       if(  null_arg(svBuf)  ) {                                       \\r
+           pBuf= NULL;                                                 \\r
+       } else {                                                        \\r
+           STRLEN n_a;                                                 \\r
+           if(  ! SvOK(svBuf)  )    sv_setpvn(svBuf,"",0);             \\r
+           (void) SvPV_force( svBuf, n_a );                            \\r
+           pBuf= CAST( tpBuf, SvGROW( svBuf, sizeof(*pBuf)*cItems ) ); \\r
+       } } STMT_END\r
+\r
+/* If call succeeded, set data length to returned length (in bytes): */\r
+#define        trunc_buf_l( bOkay, sBuf,svBuf, lSize )         STMT_START {    \\r
+       if(  bOkay  &&  NULL != sBuf  ) {                               \\r
+           SvPOK_only( svBuf );                                        \\r
+           SvCUR_set( svBuf, lSize );                                  \\r
+       } } STMT_END\r
+\r
+/* Same as above except we have a pointer to the returned length: */\r
+#define        trunc_buf_pl( bOkay, sBuf,svBuf, plSize )                       \\r
+       trunc_buf_l( bOkay, sBuf,svBuf, *plSize )\r
+\r
+/* If call succeeded, set data length to returned length (in WCHARs): */\r
+#define        trunc_buf_lw( bOkay, sBuf,svBuf, lwSize )       STMT_START {    \\r
+       if(  bOkay  &&  NULL != sBuf  ) {                               \\r
+           SvPOK_only( svBuf );                                        \\r
+           SvCUR_set( svBuf, (lwSize)*sizeof(WCHAR) );                 \\r
+       } } STMT_END\r
+\r
+/* Same as above except we have a pointer to the returned length: */\r
+#define        trunc_buf_plw( bOkay, swBuf,svBuf, plwSize )                    \\r
+       trunc_buf_lw( bOkay, swBuf,svBuf, *plwSize )\r
+\r
+/* Set data length for a buffer that contains the declared fixed data type: */\r
+#define        trunc_buf( bOkay, pBuf,svBuf )                  STMT_START {    \\r
+       if(  bOkay  &&  NULL != pBuf  ) {                               \\r
+           SvPOK_only( svBuf );                                        \\r
+           SvCUR_set( svBuf, sizeof(*pBuf) );                          \\r
+       } } STMT_END\r
+\r
+/* Set data length for a buffer that contains some other fixed data type: */\r
+#define        trunc_buf_typ( bOkay, pBuf,svBuf, Type )        STMT_START {    \\r
+       if(  bOkay  &&  NULL != pBuf  ) {                               \\r
+           SvPOK_only( svBuf );                                        \\r
+           SvCUR_set( svBuf, sizeof(Type) );                           \\r
+       } } STMT_END\r
+\r
+/* Set length for buffer that contains list of items of the declared type: */\r
+#define        trunc_vect( bOkay, pBuf,svBuf, cItems )         STMT_START {    \\r
+       if(  bOkay  &&  NULL != pBuf  ) {                               \\r
+           SvPOK_only( svBuf );                                        \\r
+           SvCUR_set( svBuf, sizeof(*pBuf)*cItems );                   \\r
+       } } STMT_END\r
+\r
+/* Set data length for a buffer where a '\0'-terminate string was stored: */\r
+#define        trunc_buf_z( bOkay, sBuf,svBuf )                STMT_START {    \\r
+       if(  bOkay  &&  NULL != sBuf  ) {                               \\r
+           SvPOK_only( svBuf );                                        \\r
+           SvCUR_set( svBuf, strlen(sBuf) );                           \\r
+       } } STMT_END\r
+\r
+/* Set data length for a buffer where a L'\0'-terminate string was stored: */\r
+#define        trunc_buf_zw( bOkay, sBuf,svBuf )               STMT_START {    \\r
+       if(  bOkay  &&  NULL != sBuf  ) {                               \\r
+           SvPOK_only( svBuf );                                        \\r
+           SvCUR_set( svBuf, wcslen(sBuf)*sizeof(WCHAR) );             \\r
+       } } STMT_END\r
index 23e7ed8..badb1b9 100644 (file)
@@ -1 +1 @@
-/* Would contain C code to generate Perl constants if not using cFile.pc */
+/* Would contain C code to generate Perl constants if not using cFile.pc */\r
index b44fbe8..cd4c552 100644 (file)
-# Generated by cFile_pc.cxx.
-# Package Win32API::File with options:
-#    CPLUSPLUS => q[1]
-#    IFDEF => q[!/[a-z\d]/]
-#    IMPORT_LIST => [q[/._/], q[!/[a-z]/], q[:MEDIA_TYPE]]
-#    WRITE_PERL => q[1]
-# Perl files eval'd:
-#    File.pm => last if /^\s*(bootstrap|XSLoader::load)\b/
-# C files included:
-#    File.xs => last if m#/[/*]\s*CONSTS_DEFINED\b|^\s*MODULE\b#
-sub CREATE_ALWAYS () { 2 }
-sub CREATE_NEW () { 1 }
-sub DDD_EXACT_MATCH_ON_REMOVE () { 4 }
-sub DDD_RAW_TARGET_PATH () { 1 }
-sub DDD_REMOVE_DEFINITION () { 2 }
-sub DRIVE_CDROM () { 5 }
-sub DRIVE_FIXED () { 3 }
-sub DRIVE_NO_ROOT_DIR () { 1 }
-sub DRIVE_RAMDISK () { 6 }
-sub DRIVE_REMOTE () { 4 }
-sub DRIVE_REMOVABLE () { 2 }
-sub DRIVE_UNKNOWN () { 0 }
-sub F3_120M_512 () { 13 }
-sub F3_1Pt44_512 () { 2 }
-sub F3_20Pt8_512 () { 4 }
-sub F3_2Pt88_512 () { 3 }
-sub F3_720_512 () { 5 }
-sub F5_160_512 () { 10 }
-sub F5_180_512 () { 9 }
-sub F5_1Pt2_512 () { 1 }
-sub F5_320_1024 () { 8 }
-sub F5_320_512 () { 7 }
-sub F5_360_512 () { 6 }
-sub FILE_ADD_FILE () { 2 }
-sub FILE_ADD_SUBDIRECTORY () { 4 }
-sub FILE_ALL_ACCESS () { 2032127 }
-sub FILE_APPEND_DATA () { 4 }
-sub FILE_ATTRIBUTE_ARCHIVE () { 32 }
-sub FILE_ATTRIBUTE_COMPRESSED () { 2048 }
-sub FILE_ATTRIBUTE_DEVICE () { 0x00000040 }
-sub FILE_ATTRIBUTE_DIRECTORY () { 0x00000010 }
-sub FILE_ATTRIBUTE_ENCRYPTED () { 0x00004000 }
-sub FILE_ATTRIBUTE_HIDDEN () { 2 }
-sub FILE_ATTRIBUTE_NORMAL () { 128 }
-sub FILE_ATTRIBUTE_NOT_CONTENT_INDEXED () { 0x00002000 }
-sub FILE_ATTRIBUTE_OFFLINE () { 4096 }
-sub FILE_ATTRIBUTE_READONLY () { 1 }
-sub FILE_ATTRIBUTE_REPARSE_POINT () { 0x00000400 }
-sub FILE_ATTRIBUTE_SPARSE_FILE () { 0x00000200 }
-sub FILE_ATTRIBUTE_SYSTEM () { 4 }
-sub FILE_ATTRIBUTE_TEMPORARY () { 256 }
-sub FILE_BEGIN () { 0 }
-sub FILE_CREATE_PIPE_INSTANCE () { 4 }
-sub FILE_CURRENT () { 1 }
-sub FILE_DELETE_CHILD () { 64 }
-sub FILE_END () { 2 }
-sub FILE_EXECUTE () { 32 }
-sub FILE_FLAG_BACKUP_SEMANTICS () { 33554432 }
-sub FILE_FLAG_DELETE_ON_CLOSE () { 67108864 }
-sub FILE_FLAG_NO_BUFFERING () { 536870912 }
-sub FILE_FLAG_OPEN_REPARSE_POINT () { 0x200000 }
-sub FILE_FLAG_OVERLAPPED () { 1073741824 }
-sub FILE_FLAG_POSIX_SEMANTICS () { 16777216 }
-sub FILE_FLAG_RANDOM_ACCESS () { 268435456 }
-sub FILE_FLAG_SEQUENTIAL_SCAN () { 134217728 }
-sub FILE_FLAG_WRITE_THROUGH () { 0x80000000 }
-sub FILE_GENERIC_EXECUTE () { 1179808 }
-sub FILE_GENERIC_READ () { 1179785 }
-sub FILE_GENERIC_WRITE () { 1179926 }
-sub FILE_LIST_DIRECTORY () { 1 }
-sub FILE_READ_ATTRIBUTES () { 128 }
-sub FILE_READ_DATA () { 1 }
-sub FILE_READ_EA () { 8 }
-sub FILE_SHARE_DELETE () { 4 }
-sub FILE_SHARE_READ () { 1 }
-sub FILE_SHARE_WRITE () { 2 }
-sub FILE_TRAVERSE () { 32 }
-sub FILE_TYPE_CHAR () { 2 }
-sub FILE_TYPE_DISK () { 1 }
-sub FILE_TYPE_PIPE () { 3 }
-sub FILE_TYPE_UNKNOWN () { 0 }
-sub FILE_WRITE_ATTRIBUTES () { 256 }
-sub FILE_WRITE_DATA () { 2 }
-sub FILE_WRITE_EA () { 16 }
-sub FS_CASE_IS_PRESERVED () { 2 }
-sub FS_CASE_SENSITIVE () { 1 }
-sub FS_FILE_COMPRESSION () { 16 }
-sub FS_PERSISTENT_ACLS () { 8 }
-sub FS_UNICODE_STORED_ON_DISK () { 4 }
-sub FS_VOL_IS_COMPRESSED () { 32768 }
-sub FSCTL_SET_REPARSE_POINT () { (9 << 16 | 0 << 14 | 41 << 2 | 0) }
-sub FSCTL_GET_REPARSE_POINT () { (9 << 16 | 0 << 14 | 42 << 2 | 0) }
-sub FSCTL_DELETE_REPARSE_POINT () { (9 << 16 | 0 << 14 | 43 << 2 | 0) }
-sub FixedMedia () { 12 }
-sub GENERIC_ALL () { 268435456 }
-sub GENERIC_EXECUTE () { 536870912 }
-sub GENERIC_READ () { 0x80000000 }
-sub GENERIC_WRITE () { 1073741824 }
-sub HANDLE_FLAG_INHERIT () { 1 }
-sub HANDLE_FLAG_PROTECT_FROM_CLOSE () { 2 }
-sub INVALID_FILE_ATTRIBUTES () { 0xFFFFFFFF }
-sub INVALID_HANDLE_VALUE () { 0xffffffff }
-sub IOCTL_DISK_FORMAT_TRACKS () { 507928 }
-sub IOCTL_DISK_FORMAT_TRACKS_EX () { 507948 }
-sub IOCTL_DISK_GET_DRIVE_GEOMETRY () { 458752 }
-sub IOCTL_DISK_GET_DRIVE_LAYOUT () { 475148 }
-sub IOCTL_DISK_GET_MEDIA_TYPES () { 461824 }
-sub IOCTL_DISK_GET_PARTITION_INFO () { 475140 }
-sub IOCTL_DISK_HISTOGRAM_DATA () { 458804 }
-sub IOCTL_DISK_HISTOGRAM_RESET () { 458808 }
-sub IOCTL_DISK_HISTOGRAM_STRUCTURE () { 458800 }
-sub IOCTL_DISK_IS_WRITABLE () { 458788 }
-sub IOCTL_DISK_LOGGING () { 458792 }
-sub IOCTL_DISK_PERFORMANCE () { 458784 }
-sub IOCTL_DISK_REASSIGN_BLOCKS () { 507932 }
-sub IOCTL_DISK_REQUEST_DATA () { 458816 }
-sub IOCTL_DISK_REQUEST_STRUCTURE () { 458812 }
-sub IOCTL_DISK_SET_DRIVE_LAYOUT () { 507920 }
-sub IOCTL_DISK_SET_PARTITION_INFO () { 507912 }
-sub IOCTL_DISK_VERIFY () { 458772 }
-sub IOCTL_STORAGE_CHECK_VERIFY () { 2967552 }
-sub IOCTL_STORAGE_EJECT_MEDIA () { 2967560 }
-sub IOCTL_STORAGE_FIND_NEW_DEVICES () { 2967576 }
-sub IOCTL_STORAGE_GET_MEDIA_TYPES () { 2952192 }
-sub IOCTL_STORAGE_LOAD_MEDIA () { 2967564 }
-sub IOCTL_STORAGE_MEDIA_REMOVAL () { 2967556 }
-sub IOCTL_STORAGE_RELEASE () { 2967572 }
-sub IOCTL_STORAGE_RESERVE () { 2967568 }
-sub MOVEFILE_COPY_ALLOWED () { 2 }
-sub MOVEFILE_DELAY_UNTIL_REBOOT () { 4 }
-sub MOVEFILE_REPLACE_EXISTING () { 1 }
-sub MOVEFILE_WRITE_THROUGH () { 8 }
-sub OPEN_ALWAYS () { 4 }
-sub OPEN_EXISTING () { 3 }
-sub PARTITION_ENTRY_UNUSED () { 0 }
-sub PARTITION_EXTENDED () { 5 }
-sub PARTITION_FAT32 () { 11 }
-sub PARTITION_FAT32_XINT13 () { 12 }
-sub PARTITION_FAT_12 () { 1 }
-sub PARTITION_FAT_16 () { 4 }
-sub PARTITION_HUGE () { 6 }
-sub PARTITION_IFS () { 7 }
-sub PARTITION_NTFT () { 128 }
-sub PARTITION_PREP () { 65 }
-sub PARTITION_UNIX () { 99 }
-sub PARTITION_XENIX_1 () { 2 }
-sub PARTITION_XENIX_2 () { 3 }
-sub PARTITION_XINT13 () { 14 }
-sub PARTITION_XINT13_EXTENDED () { 15 }
-sub RemovableMedia () { 11 }
-sub SECURITY_ANONYMOUS () { 0 }
-sub SECURITY_CONTEXT_TRACKING () { 262144 }
-sub SECURITY_DELEGATION () { 196608 }
-sub SECURITY_EFFECTIVE_ONLY () { 524288 }
-sub SECURITY_IDENTIFICATION () { 65536 }
-sub SECURITY_IMPERSONATION () { 131072 }
-sub SECURITY_SQOS_PRESENT () { 1048576 }
-sub SEM_FAILCRITICALERRORS () { 1 }
-sub SEM_NOALIGNMENTFAULTEXCEPT () { 4 }
-sub SEM_NOGPFAULTERRORBOX () { 2 }
-sub SEM_NOOPENFILEERRORBOX () { 32768 }
-sub TRUNCATE_EXISTING () { 5 }
-sub Unknown () { 0 }
-sub VALID_NTFT () { 192 }
-sub STD_ERROR_HANDLE () { 0xfffffff4 }
-sub STD_INPUT_HANDLE () { 0xfffffff6 }
-sub STD_OUTPUT_HANDLE () { 0xfffffff5 }
-1;
+# Generated by cFile_pc.cxx.\r
+# Package Win32API::File with options:\r
+#    CPLUSPLUS => q[1]\r
+#    IFDEF => q[!/[a-z\d]/]\r
+#    IMPORT_LIST => [q[/._/], q[!/[a-z]/], q[:MEDIA_TYPE]]\r
+#    WRITE_PERL => q[1]\r
+# Perl files eval'd:\r
+#    File.pm => last if /^\s*(bootstrap|XSLoader::load)\b/\r
+# C files included:\r
+#    File.xs => last if m#/[/*]\s*CONSTS_DEFINED\b|^\s*MODULE\b#\r
+sub CREATE_ALWAYS () { 2 }\r
+sub CREATE_NEW () { 1 }\r
+sub DDD_EXACT_MATCH_ON_REMOVE () { 4 }\r
+sub DDD_RAW_TARGET_PATH () { 1 }\r
+sub DDD_REMOVE_DEFINITION () { 2 }\r
+sub DRIVE_CDROM () { 5 }\r
+sub DRIVE_FIXED () { 3 }\r
+sub DRIVE_NO_ROOT_DIR () { 1 }\r
+sub DRIVE_RAMDISK () { 6 }\r
+sub DRIVE_REMOTE () { 4 }\r
+sub DRIVE_REMOVABLE () { 2 }\r
+sub DRIVE_UNKNOWN () { 0 }\r
+sub F3_120M_512 () { 13 }\r
+sub F3_1Pt44_512 () { 2 }\r
+sub F3_20Pt8_512 () { 4 }\r
+sub F3_2Pt88_512 () { 3 }\r
+sub F3_720_512 () { 5 }\r
+sub F5_160_512 () { 10 }\r
+sub F5_180_512 () { 9 }\r
+sub F5_1Pt2_512 () { 1 }\r
+sub F5_320_1024 () { 8 }\r
+sub F5_320_512 () { 7 }\r
+sub F5_360_512 () { 6 }\r
+sub FILE_ADD_FILE () { 2 }\r
+sub FILE_ADD_SUBDIRECTORY () { 4 }\r
+sub FILE_ALL_ACCESS () { 2032127 }\r
+sub FILE_APPEND_DATA () { 4 }\r
+sub FILE_ATTRIBUTE_ARCHIVE () { 32 }\r
+sub FILE_ATTRIBUTE_COMPRESSED () { 2048 }\r
+sub FILE_ATTRIBUTE_DEVICE () { 0x00000040 }\r
+sub FILE_ATTRIBUTE_DIRECTORY () { 0x00000010 }\r
+sub FILE_ATTRIBUTE_ENCRYPTED () { 0x00004000 }\r
+sub FILE_ATTRIBUTE_HIDDEN () { 2 }\r
+sub FILE_ATTRIBUTE_NORMAL () { 128 }\r
+sub FILE_ATTRIBUTE_NOT_CONTENT_INDEXED () { 0x00002000 }\r
+sub FILE_ATTRIBUTE_OFFLINE () { 4096 }\r
+sub FILE_ATTRIBUTE_READONLY () { 1 }\r
+sub FILE_ATTRIBUTE_REPARSE_POINT () { 0x00000400 }\r
+sub FILE_ATTRIBUTE_SPARSE_FILE () { 0x00000200 }\r
+sub FILE_ATTRIBUTE_SYSTEM () { 4 }\r
+sub FILE_ATTRIBUTE_TEMPORARY () { 256 }\r
+sub FILE_BEGIN () { 0 }\r
+sub FILE_CREATE_PIPE_INSTANCE () { 4 }\r
+sub FILE_CURRENT () { 1 }\r
+sub FILE_DELETE_CHILD () { 64 }\r
+sub FILE_END () { 2 }\r
+sub FILE_EXECUTE () { 32 }\r
+sub FILE_FLAG_BACKUP_SEMANTICS () { 33554432 }\r
+sub FILE_FLAG_DELETE_ON_CLOSE () { 67108864 }\r
+sub FILE_FLAG_NO_BUFFERING () { 536870912 }\r
+sub FILE_FLAG_OPEN_REPARSE_POINT () { 0x200000 }\r
+sub FILE_FLAG_OVERLAPPED () { 1073741824 }\r
+sub FILE_FLAG_POSIX_SEMANTICS () { 16777216 }\r
+sub FILE_FLAG_RANDOM_ACCESS () { 268435456 }\r
+sub FILE_FLAG_SEQUENTIAL_SCAN () { 134217728 }\r
+sub FILE_FLAG_WRITE_THROUGH () { 0x80000000 }\r
+sub FILE_GENERIC_EXECUTE () { 1179808 }\r
+sub FILE_GENERIC_READ () { 1179785 }\r
+sub FILE_GENERIC_WRITE () { 1179926 }\r
+sub FILE_LIST_DIRECTORY () { 1 }\r
+sub FILE_READ_ATTRIBUTES () { 128 }\r
+sub FILE_READ_DATA () { 1 }\r
+sub FILE_READ_EA () { 8 }\r
+sub FILE_SHARE_DELETE () { 4 }\r
+sub FILE_SHARE_READ () { 1 }\r
+sub FILE_SHARE_WRITE () { 2 }\r
+sub FILE_TRAVERSE () { 32 }\r
+sub FILE_TYPE_CHAR () { 2 }\r
+sub FILE_TYPE_DISK () { 1 }\r
+sub FILE_TYPE_PIPE () { 3 }\r
+sub FILE_TYPE_UNKNOWN () { 0 }\r
+sub FILE_WRITE_ATTRIBUTES () { 256 }\r
+sub FILE_WRITE_DATA () { 2 }\r
+sub FILE_WRITE_EA () { 16 }\r
+sub FS_CASE_IS_PRESERVED () { 2 }\r
+sub FS_CASE_SENSITIVE () { 1 }\r
+sub FS_FILE_COMPRESSION () { 16 }\r
+sub FS_PERSISTENT_ACLS () { 8 }\r
+sub FS_UNICODE_STORED_ON_DISK () { 4 }\r
+sub FS_VOL_IS_COMPRESSED () { 32768 }\r
+sub FSCTL_SET_REPARSE_POINT () { (9 << 16 | 0 << 14 | 41 << 2 | 0) }\r
+sub FSCTL_GET_REPARSE_POINT () { (9 << 16 | 0 << 14 | 42 << 2 | 0) }\r
+sub FSCTL_DELETE_REPARSE_POINT () { (9 << 16 | 0 << 14 | 43 << 2 | 0) }\r
+sub FixedMedia () { 12 }\r
+sub GENERIC_ALL () { 268435456 }\r
+sub GENERIC_EXECUTE () { 536870912 }\r
+sub GENERIC_READ () { 0x80000000 }\r
+sub GENERIC_WRITE () { 1073741824 }\r
+sub HANDLE_FLAG_INHERIT () { 1 }\r
+sub HANDLE_FLAG_PROTECT_FROM_CLOSE () { 2 }\r
+sub INVALID_FILE_ATTRIBUTES () { 0xFFFFFFFF }\r
+sub INVALID_HANDLE_VALUE () { 0xffffffff }\r
+sub IOCTL_DISK_FORMAT_TRACKS () { 507928 }\r
+sub IOCTL_DISK_FORMAT_TRACKS_EX () { 507948 }\r
+sub IOCTL_DISK_GET_DRIVE_GEOMETRY () { 458752 }\r
+sub IOCTL_DISK_GET_DRIVE_LAYOUT () { 475148 }\r
+sub IOCTL_DISK_GET_MEDIA_TYPES () { 461824 }\r
+sub IOCTL_DISK_GET_PARTITION_INFO () { 475140 }\r
+sub IOCTL_DISK_HISTOGRAM_DATA () { 458804 }\r
+sub IOCTL_DISK_HISTOGRAM_RESET () { 458808 }\r
+sub IOCTL_DISK_HISTOGRAM_STRUCTURE () { 458800 }\r
+sub IOCTL_DISK_IS_WRITABLE () { 458788 }\r
+sub IOCTL_DISK_LOGGING () { 458792 }\r
+sub IOCTL_DISK_PERFORMANCE () { 458784 }\r
+sub IOCTL_DISK_REASSIGN_BLOCKS () { 507932 }\r
+sub IOCTL_DISK_REQUEST_DATA () { 458816 }\r
+sub IOCTL_DISK_REQUEST_STRUCTURE () { 458812 }\r
+sub IOCTL_DISK_SET_DRIVE_LAYOUT () { 507920 }\r
+sub IOCTL_DISK_SET_PARTITION_INFO () { 507912 }\r
+sub IOCTL_DISK_VERIFY () { 458772 }\r
+sub IOCTL_STORAGE_CHECK_VERIFY () { 2967552 }\r
+sub IOCTL_STORAGE_EJECT_MEDIA () { 2967560 }\r
+sub IOCTL_STORAGE_FIND_NEW_DEVICES () { 2967576 }\r
+sub IOCTL_STORAGE_GET_MEDIA_TYPES () { 2952192 }\r
+sub IOCTL_STORAGE_LOAD_MEDIA () { 2967564 }\r
+sub IOCTL_STORAGE_MEDIA_REMOVAL () { 2967556 }\r
+sub IOCTL_STORAGE_RELEASE () { 2967572 }\r
+sub IOCTL_STORAGE_RESERVE () { 2967568 }\r
+sub MOVEFILE_COPY_ALLOWED () { 2 }\r
+sub MOVEFILE_DELAY_UNTIL_REBOOT () { 4 }\r
+sub MOVEFILE_REPLACE_EXISTING () { 1 }\r
+sub MOVEFILE_WRITE_THROUGH () { 8 }\r
+sub OPEN_ALWAYS () { 4 }\r
+sub OPEN_EXISTING () { 3 }\r
+sub PARTITION_ENTRY_UNUSED () { 0 }\r
+sub PARTITION_EXTENDED () { 5 }\r
+sub PARTITION_FAT32 () { 11 }\r
+sub PARTITION_FAT32_XINT13 () { 12 }\r
+sub PARTITION_FAT_12 () { 1 }\r
+sub PARTITION_FAT_16 () { 4 }\r
+sub PARTITION_HUGE () { 6 }\r
+sub PARTITION_IFS () { 7 }\r
+sub PARTITION_NTFT () { 128 }\r
+sub PARTITION_PREP () { 65 }\r
+sub PARTITION_UNIX () { 99 }\r
+sub PARTITION_XENIX_1 () { 2 }\r
+sub PARTITION_XENIX_2 () { 3 }\r
+sub PARTITION_XINT13 () { 14 }\r
+sub PARTITION_XINT13_EXTENDED () { 15 }\r
+sub RemovableMedia () { 11 }\r
+sub SECURITY_ANONYMOUS () { 0 }\r
+sub SECURITY_CONTEXT_TRACKING () { 262144 }\r
+sub SECURITY_DELEGATION () { 196608 }\r
+sub SECURITY_EFFECTIVE_ONLY () { 524288 }\r
+sub SECURITY_IDENTIFICATION () { 65536 }\r
+sub SECURITY_IMPERSONATION () { 131072 }\r
+sub SECURITY_SQOS_PRESENT () { 1048576 }\r
+sub SEM_FAILCRITICALERRORS () { 1 }\r
+sub SEM_NOALIGNMENTFAULTEXCEPT () { 4 }\r
+sub SEM_NOGPFAULTERRORBOX () { 2 }\r
+sub SEM_NOOPENFILEERRORBOX () { 32768 }\r
+sub TRUNCATE_EXISTING () { 5 }\r
+sub Unknown () { 0 }\r
+sub VALID_NTFT () { 192 }\r
+sub STD_ERROR_HANDLE () { 0xfffffff4 }\r
+sub STD_INPUT_HANDLE () { 0xfffffff6 }\r
+sub STD_OUTPUT_HANDLE () { 0xfffffff5 }\r
+1;\r
index dbd94c1..738e415 100644 (file)
-/* const2perl.h -- For converting C constants into Perl constant subs
- *     (usually via XS code but can just write Perl code to stdout). */
-
-
-/* #ifndef _INCLUDE_CONST2PERL_H
- * #define _INCLUDE_CONST2PERL_H 1 */
-
-#ifndef CONST2WRITE_PERL       /* Default is "const to .xs": */
-
-# define newconst( sName, sFmt, xValue, newSV )        \
-               newCONSTSUB( mHvStash, sName, newSV )
-
-# define noconst( const )      av_push( mAvExportFail, newSVpv(#const,0) )
-
-# define setuv(u)      do {                            \
-       mpSvNew= newSViv(0); sv_setuv(mpSvNew,u);       \
-    } while( 0 )
-
-#else
-
-/* #ifdef __cplusplus
- * # undef printf
- * # undef fprintf
- * # undef stderr
- * # define stderr (&_iob[2])
- * # undef iobuf
- * # undef malloc
- * #endif */
-
-# include <stdio.h>    /* Probably already included, but shouldn't hurt */
-# include <errno.h>    /* Possibly already included, but shouldn't hurt */
-
-# define newconst( sName, sFmt, xValue, newSV )        \
-               printf( "sub %s () { " sFmt " }\n", sName, xValue )
-
-# define noconst( const )      printf( "push @EXPORT_FAIL, '%s';\n", #const )
-
-# define setuv(u)      /* Nothing */
-
-# ifndef IVdf
-#  define IVdf "ld"
-# endif
-# ifndef UVuf
-#  define UVuf "lu"
-# endif
-# ifndef UVxf
-#  define UVxf "lX"
-# endif
-# ifndef NV_DIG
-#  define NV_DIG 15
-# endif
-
-static char *
-escquote( const char *sValue )
-{
-    Size_t lLen= 1+2*strlen(sValue);
-    char *sEscaped= (char *) malloc( lLen );
-    char *sNext= sEscaped;
-    if(  NULL == sEscaped  ) {
-       fprintf( stderr, "Can't allocate %"UVuf"-byte buffer (errno=%d)\n",
-         U_V(lLen), _errno );
-       exit( 1 );
-    }
-    while(  '\0' != *sValue  ) {
-       switch(  *sValue  ) {
-        case '\'':
-        case '\\':
-           *(sNext++)= '\\';
-       }
-       *(sNext++)= *(sValue++);
-    }
-    *sNext= *sValue;
-    return( sEscaped );
-}
-
-#endif
-
-
-#ifdef __cplusplus
-
-class _const2perl {
- public:
-    char msBuf[64];    /* Must fit sprintf of longest NV */
-#ifndef CONST2WRITE_PERL
-    HV *mHvStash;
-    AV *mAvExportFail;
-    SV *mpSvNew;
-    _const2perl::_const2perl( char *sModName ) {
-       mHvStash= gv_stashpv( sModName, TRUE );
-       SV **pSv= hv_fetch( mHvStash, "EXPORT_FAIL", 11, TRUE );
-       GV *gv;
-       char *sVarName= (char *) malloc( 15+strlen(sModName) );
-       strcpy( sVarName, sModName );
-       strcat( sVarName, "::EXPORT_FAIL" );
-       gv= gv_fetchpv( sVarName, 1, SVt_PVAV );
-       mAvExportFail= GvAVn( gv );
-    }
-#else
-    _const2perl::_const2perl( char *sModName ) {
-       ;       /* Nothing to do */
-    }
-#endif /* CONST2WRITE_PERL */
-    void mkconst( char *sName, unsigned long uValue ) {
-       setuv(uValue);
-       newconst( sName, "0x%"UVxf, uValue, mpSvNew );
-    }
-    void mkconst( char *sName, unsigned int uValue ) {
-       setuv(uValue);
-       newconst( sName, "0x%"UVxf, uValue, mpSvNew );
-    }
-    void mkconst( char *sName, unsigned short uValue ) {
-       setuv(uValue);
-       newconst( sName, "0x%"UVxf, uValue, mpSvNew );
-    }
-    void mkconst( char *sName, long iValue ) {
-       newconst( sName, "%"IVdf, iValue, newSViv(iValue) );
-    }
-    void mkconst( char *sName, int iValue ) {
-       newconst( sName, "%"IVdf, iValue, newSViv(iValue) );
-    }
-    void mkconst( char *sName, short iValue ) {
-       newconst( sName, "%"IVdf, iValue, newSViv(iValue) );
-    }
-    void mkconst( char *sName, double nValue ) {
-       newconst( sName, "%s",
-         Gconvert(nValue,NV_DIG,0,msBuf), newSVnv(nValue) );
-    }
-    void mkconst( char *sName, char *sValue ) {
-       newconst( sName, "'%s'", escquote(sValue), newSVpv(sValue,0) );
-    }
-    void mkconst( char *sName, const void *pValue ) {
-       setuv((UV)pValue);
-       newconst( sName, "0x%"UVxf, (UV)(pValue), mpSvNew );
-    }
-/*#ifdef HAS_QUAD
- * HAS_QUAD only means pack/unpack deal with them, not that SVs can.
- *    void mkconst( char *sName, Quad_t *qValue ) {
- *     newconst( sName, "0x%"QVxf, qValue, newSVqv(qValue) );
- *    }
- *#endif / * HAS_QUAD */
-};
-
-#define START_CONSTS( sModName )       _const2perl const2( sModName );
-#define const2perl( const )            const2.mkconst( #const, const )
-
-#else  /* __cplusplus */
-
-# ifndef CONST2WRITE_PERL
-#  define START_CONSTS( sModName )                                     \
-           HV *mHvStash= gv_stashpv( sModName, TRUE );                 \
-           AV *mAvExportFail;                                          \
-           SV *mpSvNew;                                                \
-           { char *sVarName= malloc( 15+strlen(sModName) );            \
-             GV *gv;                                                   \
-               strcpy( sVarName, sModName );                           \
-               strcat( sVarName, "::EXPORT_FAIL" );                    \
-               gv= gv_fetchpv( sVarName, 1, SVt_PVAV );                \
-               mAvExportFail= GvAVn( gv );                             \
-           }
-# else
-#  define START_CONSTS( sModName )     /* Nothing */
-# endif
-
-#define const2perl( const )    do {                                    \
-       if(  const < 0  ) {                                             \
-           newconst( #const, "%"IVdf, const, newSViv((IV)const) );     \
-       } else {                                                        \
-           setuv( (UV)const );                                         \
-           newconst( #const, "0x%"UVxf, const, mpSvNew );              \
-       }                                                               \
-    } while( 0 )
-
-#endif /* __cplusplus */
-
-
-//Example use:
-//#include <const2perl.h>
-//  {
-//    START_CONSTS( "Package::Name" )  /* No ";" */
-//#ifdef $const
-//    const2perl( $const );
-//#else
-//    noconst( $const );
-//#endif
-//  }
-// sub ? { my( $sConstName )= @_;
-//    return $sConstName;      # "#ifdef $sConstName"
-//    return FALSE;            # Same as above
-//    return "HAS_QUAD";       # "#ifdef HAS_QUAD"
-//    return "#if 5.04 <= VERSION";
-//    return "#if 0";
-//    return 1;                # No #ifdef
-/* #endif / * _INCLUDE_CONST2PERL_H */
+/* const2perl.h -- For converting C constants into Perl constant subs\r
+ *     (usually via XS code but can just write Perl code to stdout). */\r
+\r
+\r
+/* #ifndef _INCLUDE_CONST2PERL_H\r
+ * #define _INCLUDE_CONST2PERL_H 1 */\r
+\r
+#ifndef CONST2WRITE_PERL       /* Default is "const to .xs": */\r
+\r
+# define newconst( sName, sFmt, xValue, newSV )        \\r
+               newCONSTSUB( mHvStash, sName, newSV )\r
+\r
+# define noconst( const )      av_push( mAvExportFail, newSVpv(#const,0) )\r
+\r
+# define setuv(u)      do {                            \\r
+       mpSvNew= newSViv(0); sv_setuv(mpSvNew,u);       \\r
+    } while( 0 )\r
+\r
+#else\r
+\r
+/* #ifdef __cplusplus\r
+ * # undef printf\r
+ * # undef fprintf\r
+ * # undef stderr\r
+ * # define stderr (&_iob[2])\r
+ * # undef iobuf\r
+ * # undef malloc\r
+ * #endif */\r
+\r
+# include <stdio.h>    /* Probably already included, but shouldn't hurt */\r
+# include <errno.h>    /* Possibly already included, but shouldn't hurt */\r
+\r
+# define newconst( sName, sFmt, xValue, newSV )        \\r
+               printf( "sub %s () { " sFmt " }\n", sName, xValue )\r
+\r
+# define noconst( const )      printf( "push @EXPORT_FAIL, '%s';\n", #const )\r
+\r
+# define setuv(u)      /* Nothing */\r
+\r
+# ifndef IVdf\r
+#  define IVdf "ld"\r
+# endif\r
+# ifndef UVuf\r
+#  define UVuf "lu"\r
+# endif\r
+# ifndef UVxf\r
+#  define UVxf "lX"\r
+# endif\r
+# ifndef NV_DIG\r
+#  define NV_DIG 15\r
+# endif\r
+\r
+static char *\r
+escquote( const char *sValue )\r
+{\r
+    Size_t lLen= 1+2*strlen(sValue);\r
+    char *sEscaped= (char *) malloc( lLen );\r
+    char *sNext= sEscaped;\r
+    if(  NULL == sEscaped  ) {\r
+       fprintf( stderr, "Can't allocate %"UVuf"-byte buffer (errno=%d)\n",\r
+         U_V(lLen), _errno );\r
+       exit( 1 );\r
+    }\r
+    while(  '\0' != *sValue  ) {\r
+       switch(  *sValue  ) {\r
+        case '\'':\r
+        case '\\':\r
+           *(sNext++)= '\\';\r
+       }\r
+       *(sNext++)= *(sValue++);\r
+    }\r
+    *sNext= *sValue;\r
+    return( sEscaped );\r
+}\r
+\r
+#endif\r
+\r
+\r
+#ifdef __cplusplus\r
+\r
+class _const2perl {\r
+ public:\r
+    char msBuf[64];    /* Must fit sprintf of longest NV */\r
+#ifndef CONST2WRITE_PERL\r
+    HV *mHvStash;\r
+    AV *mAvExportFail;\r
+    SV *mpSvNew;\r
+    _const2perl::_const2perl( char *sModName ) {\r
+       mHvStash= gv_stashpv( sModName, TRUE );\r
+       SV **pSv= hv_fetch( mHvStash, "EXPORT_FAIL", 11, TRUE );\r
+       GV *gv;\r
+       char *sVarName= (char *) malloc( 15+strlen(sModName) );\r
+       strcpy( sVarName, sModName );\r
+       strcat( sVarName, "::EXPORT_FAIL" );\r
+       gv= gv_fetchpv( sVarName, 1, SVt_PVAV );\r
+       mAvExportFail= GvAVn( gv );\r
+    }\r
+#else\r
+    _const2perl::_const2perl( char *sModName ) {\r
+       ;       /* Nothing to do */\r
+    }\r
+#endif /* CONST2WRITE_PERL */\r
+    void mkconst( char *sName, unsigned long uValue ) {\r
+       setuv(uValue);\r
+       newconst( sName, "0x%"UVxf, uValue, mpSvNew );\r
+    }\r
+    void mkconst( char *sName, unsigned int uValue ) {\r
+       setuv(uValue);\r
+       newconst( sName, "0x%"UVxf, uValue, mpSvNew );\r
+    }\r
+    void mkconst( char *sName, unsigned short uValue ) {\r
+       setuv(uValue);\r
+       newconst( sName, "0x%"UVxf, uValue, mpSvNew );\r
+    }\r
+    void mkconst( char *sName, long iValue ) {\r
+       newconst( sName, "%"IVdf, iValue, newSViv(iValue) );\r
+    }\r
+    void mkconst( char *sName, int iValue ) {\r
+       newconst( sName, "%"IVdf, iValue, newSViv(iValue) );\r
+    }\r
+    void mkconst( char *sName, short iValue ) {\r
+       newconst( sName, "%"IVdf, iValue, newSViv(iValue) );\r
+    }\r
+    void mkconst( char *sName, double nValue ) {\r
+       newconst( sName, "%s",\r
+         Gconvert(nValue,NV_DIG,0,msBuf), newSVnv(nValue) );\r
+    }\r
+    void mkconst( char *sName, char *sValue ) {\r
+       newconst( sName, "'%s'", escquote(sValue), newSVpv(sValue,0) );\r
+    }\r
+    void mkconst( char *sName, const void *pValue ) {\r
+       setuv((UV)pValue);\r
+       newconst( sName, "0x%"UVxf, (UV)(pValue), mpSvNew );\r
+    }\r
+/*#ifdef HAS_QUAD\r
+ * HAS_QUAD only means pack/unpack deal with them, not that SVs can.\r
+ *    void mkconst( char *sName, Quad_t *qValue ) {\r
+ *     newconst( sName, "0x%"QVxf, qValue, newSVqv(qValue) );\r
+ *    }\r
+ *#endif / * HAS_QUAD */\r
+};\r
+\r
+#define START_CONSTS( sModName )       _const2perl const2( sModName );\r
+#define const2perl( const )            const2.mkconst( #const, const )\r
+\r
+#else  /* __cplusplus */\r
+\r
+# ifndef CONST2WRITE_PERL\r
+#  define START_CONSTS( sModName )                                     \\r
+           HV *mHvStash= gv_stashpv( sModName, TRUE );                 \\r
+           AV *mAvExportFail;                                          \\r
+           SV *mpSvNew;                                                \\r
+           { char *sVarName= malloc( 15+strlen(sModName) );            \\r
+             GV *gv;                                                   \\r
+               strcpy( sVarName, sModName );                           \\r
+               strcat( sVarName, "::EXPORT_FAIL" );                    \\r
+               gv= gv_fetchpv( sVarName, 1, SVt_PVAV );                \\r
+               mAvExportFail= GvAVn( gv );                             \\r
+           }\r
+# else\r
+#  define START_CONSTS( sModName )     /* Nothing */\r
+# endif\r
+\r
+#define const2perl( const )    do {                                    \\r
+       if(  const < 0  ) {                                             \\r
+           newconst( #const, "%"IVdf, const, newSViv((IV)const) );     \\r
+       } else {                                                        \\r
+           setuv( (UV)const );                                         \\r
+           newconst( #const, "0x%"UVxf, const, mpSvNew );              \\r
+       }                                                               \\r
+    } while( 0 )\r
+\r
+#endif /* __cplusplus */\r
+\r
+\r
+//Example use:\r
+//#include <const2perl.h>\r
+//  {\r
+//    START_CONSTS( "Package::Name" )  /* No ";" */\r
+//#ifdef $const\r
+//    const2perl( $const );\r
+//#else\r
+//    noconst( $const );\r
+//#endif\r
+//  }\r
+// sub ? { my( $sConstName )= @_;\r
+//    return $sConstName;      # "#ifdef $sConstName"\r
+//    return FALSE;            # Same as above\r
+//    return "HAS_QUAD";       # "#ifdef HAS_QUAD"\r
+//    return "#if 5.04 <= VERSION";\r
+//    return "#if 0";\r
+//    return 1;                # No #ifdef\r
+/* #endif / * _INCLUDE_CONST2PERL_H */\r
-# This should eventually become part of MakeMaker as ExtUtils::Mkconst2perl.
-# Documentation for this is very skimpy at this point.  Full documentation
-# will be added to ExtUtils::Mkconst2perl when it is created.
-package # Hide from PAUSE
-         ExtUtils::Myconst2perl;
-
-use strict;
-use Config;
-
-use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION );
-BEGIN {
-    require Exporter;
-    push @ISA, 'Exporter';
-    @EXPORT= qw( &Myconst2perl );
-    @EXPORT_OK= qw( &ParseAttribs );
-    $VERSION= 1.00;
-}
-
-use Carp;
-use File::Basename;
-use ExtUtils::MakeMaker qw( neatvalue );
-
-# Return the extension to use for a file of C++ source code:
-sub _cc
-{
-    # Some day, $Config{_cc} might be defined for us:
-    return $Config{_cc}   if  $Config{_cc};
-    return ".cxx";     # Seems to be the most widely accepted extension.
-}
-
-=item ParseAttribs
-
-Parses user-firendly options into coder-firendly specifics.
-
-=cut
-
-sub ParseAttribs
-{
-    # Usage:  ParseAttribs( "Package::Name", \%opts, {opt=>\$var} );
-    my( $pkg, $hvAttr, $hvRequests )= @_;
-    my( $outfile, @perlfiles, %perlfilecodes, @cfiles, %cfilecodes );
-    my @importlist= @{$hvAttr->{IMPORT_LIST}};
-    my $perlcode= $hvAttr->{PERL_PE_CODE} ||
-       'last if /^\s*(bootstrap|XSLoader::load)\b/';
-    my $ccode= $hvAttr->{C_PE_CODE} ||
-       'last if m#/[/*]\s*CONSTS_DEFINED\b|^\s*MODULE\b#';
-    my $ifdef= $hvAttr->{IFDEF} || 0;
-    my $writeperl= !! $hvAttr->{WRITE_PERL};
-    my $export= !! $hvAttr->{DO_EXPORT};
-    my $importto= $hvAttr->{IMPORT_TO} || "_constants";
-    my $cplusplus= $hvAttr->{CPLUSPLUS};
-    $cplusplus= ""   if  ! defined $cplusplus;
-    my $object= "";
-    my $binary= "";
-    my $final= "";
-    my $norebuild= "";
-    my $subroutine= "";
-    my $base;
-    my %params= (
-       PERL_PE_CODE => \$perlcode,
-       PERL_FILE_LIST => \@perlfiles,
-       PERL_FILE_CODES => \%perlfilecodes,
-       PERL_FILES => sub { map {($_,$perlfilecodes{$_})} @perlfiles },
-       C_PE_CODE => \$ccode,
-       C_FILE_LIST => \@cfiles,
-       C_FILE_CODES => \%cfilecodes,
-       C_FILES => sub { map {($_,$cfilecodes{$_})} @cfiles },
-       DO_EXPORT => \$export,
-       IMPORT_TO => \$importto,
-       IMPORT_LIST => \@importlist,
-       SUBROUTINE => \$subroutine,
-       IFDEF => \$ifdef,
-       WRITE_PERL => \$writeperl,
-       CPLUSPLUS => \$cplusplus,
-       BASEFILENAME => \$base,
-       OUTFILE => \$outfile,
-       OBJECT => \$object,
-       BINARY => \$binary,
-       FINAL_PERL => \$final,
-       NO_REBUILD => \$norebuild,
-    );
-    {   my @err= grep {! defined $params{$_}} keys %$hvAttr;
-       carp "ExtUtils::Myconst2perl::ParseAttribs:  ",
-         "Unsupported option(s) (@err).\n"
-         if  @err;
-    }
-    $norebuild= $hvAttr->{NO_REBUILD}   if  exists $hvAttr->{NO_REBUILD};
-    my $module= ( split /::/, $pkg )[-1];
-    $base= "c".$module;
-    $base= $hvAttr->{BASEFILENAME}   if  exists $hvAttr->{BASEFILENAME};
-    my $ext=  ! $cplusplus  ?  ($Config{_c}||".c")
-      :  $cplusplus =~ /^[.]/  ?  $cplusplus  :  _cc();
-    if(  $writeperl  ) {
-       $outfile= $base . "_pc" . $ext;
-       $object= $base . "_pc" . ($Config{_o}||$Config{obj_ext});
-       $object= $hvAttr->{OBJECT}   if  $hvAttr->{OBJECT};
-       $binary= $base . "_pc" . ($Config{_exe}||$Config{exe_ext});
-       $binary= $hvAttr->{BINARY}   if  $hvAttr->{BINARY};
-       $final= $base . ".pc";
-       $final= $hvAttr->{FINAL_PERL}   if  $hvAttr->{FINAL_PERL};
-       $subroutine= "main";
-    } elsif(  $cplusplus  ) {
-       $outfile= $base . $ext;
-       $object= $base . ($Config{_o}||$Config{obj_ext});
-       $object= $hvAttr->{OBJECT}   if  $hvAttr->{OBJECT};
-       $subroutine= "const2perl_" . $pkg;
-       $subroutine =~ s/\W/_/g;
-    } else {
-       $outfile= $base . ".h";
-    }
-    $outfile= $hvAttr->{OUTFILE}   if  $hvAttr->{OUTFILE};
-    if(  $hvAttr->{PERL_FILES}  ) {
-       carp "ExtUtils::Myconst2perl:  PERL_FILES option not allowed ",
-         "with PERL_FILE_LIST nor PERL_FILE_CODES.\n"
-         if  $hvAttr->{PERL_FILE_LIST}  ||  $hvAttr->{PERL_FILE_CODES};
-       %perlfilecodes= @{$hvAttr->{PERL_FILES}};
-       my $odd= 0;
-       @perlfiles= grep {$odd= !$odd} @{$hvAttr->{PERL_FILES}};
-    } else {
-       if(  $hvAttr->{PERL_FILE_LIST}  ) {
-           @perlfiles= @{$hvAttr->{PERL_FILE_LIST}};
-       } elsif(  $hvAttr->{PERL_FILE_CODES}  ) {
-           @perlfiles= keys %{$hvAttr->{PERL_FILE_CODES}};
-       } else {
-           @perlfiles= ( "$module.pm" );
-       }
-       %perlfilecodes= %{$hvAttr->{PERL_FILE_CODES}}
-         if  $hvAttr->{PERL_FILE_CODES};
-    }
-    for my $file (  @perlfiles  ) {
-       $perlfilecodes{$file}= $perlcode  if  ! $perlfilecodes{$file};
-    }
-    if(  ! $subroutine  ) {
-       ; # Don't process any C source code files.
-    } elsif(  $hvAttr->{C_FILES}  ) {
-       carp "ExtUtils::Myconst2perl:  C_FILES option not allowed ",
-         "with C_FILE_LIST nor C_FILE_CODES.\n"
-         if  $hvAttr->{C_FILE_LIST}  ||  $hvAttr->{C_FILE_CODES};
-       %cfilecodes= @{$hvAttr->{C_FILES}};
-       my $odd= 0;
-       @cfiles= grep {$odd= !$odd} @{$hvAttr->{C_FILES}};
-    } else {
-       if(  $hvAttr->{C_FILE_LIST}  ) {
-           @cfiles= @{$hvAttr->{C_FILE_LIST}};
-       } elsif(  $hvAttr->{C_FILE_CODES}  ) {
-           @cfiles= keys %{$hvAttr->{C_FILE_CODES}};
-       } elsif(  $writeperl  ||  $cplusplus  ) {
-           @cfiles= ( "$module.xs" );
-       }
-       %cfilecodes= %{$hvAttr->{C_FILE_CODES}}   if  $hvAttr->{C_FILE_CODES};
-    }
-    for my $file (  @cfiles  ) {
-       $cfilecodes{$file}= $ccode  if  ! $cfilecodes{$file};
-    }
-    for my $key (  keys %$hvRequests  ) {
-       if(  ! $params{$key}  ) {
-           carp "ExtUtils::Myconst2perl::ParseAttribs:  ",
-             "Unsupported output ($key).\n";
-       } elsif(  "SCALAR" eq ref( $params{$key} )  ) {
-           ${$hvRequests->{$key}}= ${$params{$key}};
-       } elsif(  "ARRAY" eq ref( $params{$key} )  ) {
-           @{$hvRequests->{$key}}= @{$params{$key}};
-       } elsif(  "HASH" eq ref( $params{$key} )  ) {
-           %{$hvRequests->{$key}}= %{$params{$key}};
-       } elsif(  "CODE" eq ref( $params{$key} )  ) {
-           @{$hvRequests->{$key}}=  &{$params{$key}};
-       } else {
-           die "Impossible value in \$params{$key}";
-       }
-    }
-}
-
-=item Myconst2perl
-
-Generates a file used to implement C constants as "constant subroutines" in
-a Perl module.
-
-Extracts a list of constants from a module's export list by C<eval>ing the
-first part of the Module's F<*.pm> file and then requesting some groups of
-symbols be exported/imported into a dummy package.  Then writes C or C++
-code that can convert each C constant into a Perl "constant subroutine"
-whose name is the constant's name and whose value is the constant's value.
-
-=cut
-
-sub Myconst2perl
-{
-    my( $pkg, %spec )= @_;
-    my( $outfile, $writeperl, $ifdef, $export, $importto, @importlist,
-        @perlfile, %perlcode, @cfile, %ccode, $routine );
-    ParseAttribs( $pkg, \%spec, {
-       DO_EXPORT => \$export,
-       IMPORT_TO => \$importto,
-       IMPORT_LIST => \@importlist,
-       IFDEF => \$ifdef,
-       WRITE_PERL => \$writeperl,
-       OUTFILE => \$outfile,
-       PERL_FILE_LIST => \@perlfile,
-       PERL_FILE_CODES => \%perlcode,
-       C_FILE_LIST => \@cfile,
-       C_FILE_CODES => \%ccode,
-       SUBROUTINE => \$routine,
-    } );
-    my $module= ( split /::/, $pkg )[-1];
-
-    warn "Writing $outfile...\n";
-    open( STDOUT, ">$outfile" )  or  die "Can't create $outfile: $!\n";
-
-    my $code= "";
-    my $file;
-    foreach $file (  @perlfile  ) {
-       warn "Reading Perl file, $file:  $perlcode{$file}\n";
-       open( MODULE, "<$file" )  or  die "Can't read Perl file, $file: $!\n";
-       eval qq[
-           while(  <MODULE>  ) {
-               $perlcode{$file};
-               \$code .= \$_;
-           }
-           1;
-       ]  or  die "$file eval: $@\n";
-       close( MODULE );
-    }
-
-    print
-      "/* $outfile - Generated by ExtUtils::Myconst2perl::Myconst2perl */\n";
-    if(  $routine  ) {
-       print "/* See start of $routine() for generation parameters used */\n";
-       #print "#define main _main_proto"
-       #  " /* Ignore Perl's main() prototype */\n\n";
-       if(  $writeperl  ) {
-           # Here are more reasons why the WRITE_PERL option is discouraged.
-           if(  $Config{useperlio}  ) {
-               print "#define PERLIO_IS_STDIO 1\n";
-           }
-           print "#define WIN32IO_IS_STDIO 1\n";       # May cause a warning
-           print "#define NO_XSLOCKS 1\n";     # What a hack!
-       }
-       foreach $file (  @cfile  ) {
-           warn "Reading C file, $file:  $ccode{$file}\n";
-           open( XS, "<$file" )  or  die "Can't read C file, $file: $!\n";
-           my $code= $ccode{$file};
-           $code =~ s#\\#\\\\#g;
-           $code =~ s#([^\s -~])#"\\x".sprintf "%02X",unpack "C",$1#ge;
-           $code =~ s#[*]/#*\\/#g;
-           print qq[\n/* Include $file:  $code */\n];
-           print qq[\n#line 1 "$file"\n];
-           eval qq[
-               while(  <XS>  ) {
-                   $ccode{$file};
-                   print;
-               }
-               1;
-           ]  or  die "$file eval: $@\n";
-           close( XS );
-       }
-       #print qq[\n#undef main\n];
-       print qq[\n#define CONST2WRITE_PERL\n];
-       print qq[\n#include "const2perl.h"\n\n];
-       if(  $writeperl  ) {
-           print "int\nmain( int argc, char *argv[], char *envp[] )\n";
-       } else {
-           print "void\n$routine( void )\n";
-       }
-    }
-    print "{\n";
-
-    {
-       @ExtUtils::Myconst2perl::importlist= @importlist;
-       my $var= '@ExtUtils::Myconst2perl::importlist';
-       my $port= $export ? "export" : "import";
-       my $arg2= $export ? "q[$importto]," : "";
-       local( $^W )= 0;
-       eval $code . "{\n"
-         . "    {    package $importto;\n"
-         . "        warn qq[\u${port}ing to $importto: $var\\n];\n"
-         . "        \$pkg->$port( $arg2 $var );\n"
-         . "    }\n"
-         . "    {   no strict 'refs';\n"
-         . "        $var=  sort keys %{'_constants::'};   }\n"
-         . "    warn 0 + $var, qq[ symbols ${port}ed.\\n];\n"
-         . "}\n1;\n"
-         or  die "eval: $@\n";
-    }
-    my @syms= @ExtUtils::Myconst2perl::importlist;
-
-    my $if;
-    my $const;
-    print qq[    START_CONSTS( "$pkg" )        /* No ";" */\n];
-    {
-       my( $head, $tail )= ( "/*", "\n" );
-       if(  $writeperl  ) {
-           $head= '    printf( "#';
-           $tail= '\\n" );' . "\n";
-           print $head, " Generated by $outfile.", $tail;
-       }
-       print $head, " Package $pkg with options:", $tail;
-       $head= " *"   if  ! $writeperl;
-       my $key;
-       foreach $key (  sort keys %spec  ) {
-           my $val= neatvalue($spec{$key});
-           $val =~ s/\\/\\\\/g   if  $writeperl;
-           print $head, "    $key => ", $val, $tail;
-       }
-       print $head, " Perl files eval'd:", $tail;
-       foreach $key (  @perlfile  ) {
-           my $code= $perlcode{$key};
-           $code =~ s#\\#\\\\#g;
-           $code =~ s#([^ -~])#"\\".sprintf "%03o",unpack "C",$1#ge;
-           $code =~ s#"#\\"#g   if  $writeperl;
-           print $head, "    $key => ", $code, $tail;
-       }
-       if(  $writeperl  ) {
-           print $head, " C files included:", $tail;
-           foreach $key (  @cfile  ) {
-               my $code= $ccode{$key};
-               $code =~ s#\\#\\\\#g;
-               $code =~ s#([^ -~])#"\\".sprintf "%03o",unpack "C",$1#ge;
-               $code =~ s#"#\\"#g;
-               print $head, "    $key => ", $code, $tail;
-           }
-       } else {
-           print " */\n";
-       }
-    }
-    if(  ! ref($ifdef)  &&  $ifdef =~ /[^\s\w]/  ) {
-       my $sub= $ifdef;
-       $sub= 'sub { local($_)= @_; ' . $sub . ' }'
-         unless  $sub =~ /^\s*sub\b/;
-       $ifdef= eval $sub;
-       die "$@:  $sub\n"   if  $@;
-       if(  "CODE" ne ref($ifdef)  ) {
-           die "IFDEF didn't create subroutine reference:  eval $sub\n";
-       }
-    }
-    foreach $const (  @syms  ) {
-       $if=  "CODE" eq ref($ifdef)  ?  $ifdef->($const)  :  $ifdef;
-       if(  ! $if  ) {
-           $if= "";
-       } elsif(  "1" eq $if  ) {
-           $if= "#ifdef $const\n";
-       } elsif(  $if !~ /^#/  ) {
-           $if= "#ifdef $if\n";
-       } else {
-           $if= "$if\n";
-       }
-       print $if
-         . qq[    const2perl( $const );\n];
-       if(  $if  ) {
-           print "#else\n"
-             . qq[    noconst( $const );\n]
-             . "#endif\n";
-       }
-    }
-    if(  $writeperl  ) {
-       print
-         qq[    printf( "1;\\n" );\n],
-         qq[    return( 0 );\n];
-    }
-    print "}\n";
-}
-
-1;
+# This should eventually become part of MakeMaker as ExtUtils::Mkconst2perl.\r
+# Documentation for this is very skimpy at this point.  Full documentation\r
+# will be added to ExtUtils::Mkconst2perl when it is created.\r
+package # Hide from PAUSE\r
+         ExtUtils::Myconst2perl;\r
+\r
+use strict;\r
+use Config;\r
+\r
+use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION );\r
+BEGIN {\r
+    require Exporter;\r
+    push @ISA, 'Exporter';\r
+    @EXPORT= qw( &Myconst2perl );\r
+    @EXPORT_OK= qw( &ParseAttribs );\r
+    $VERSION= 1.00;\r
+}\r
+\r
+use Carp;\r
+use File::Basename;\r
+use ExtUtils::MakeMaker qw( neatvalue );\r
+\r
+# Return the extension to use for a file of C++ source code:\r
+sub _cc\r
+{\r
+    # Some day, $Config{_cc} might be defined for us:\r
+    return $Config{_cc}   if  $Config{_cc};\r
+    return ".cxx";     # Seems to be the most widely accepted extension.\r
+}\r
+\r
+=item ParseAttribs\r
+\r
+Parses user-firendly options into coder-firendly specifics.\r
+\r
+=cut\r
+\r
+sub ParseAttribs\r
+{\r
+    # Usage:  ParseAttribs( "Package::Name", \%opts, {opt=>\$var} );\r
+    my( $pkg, $hvAttr, $hvRequests )= @_;\r
+    my( $outfile, @perlfiles, %perlfilecodes, @cfiles, %cfilecodes );\r
+    my @importlist= @{$hvAttr->{IMPORT_LIST}};\r
+    my $perlcode= $hvAttr->{PERL_PE_CODE} ||\r
+       'last if /^\s*(bootstrap|XSLoader::load)\b/';\r
+    my $ccode= $hvAttr->{C_PE_CODE} ||\r
+       'last if m#/[/*]\s*CONSTS_DEFINED\b|^\s*MODULE\b#';\r
+    my $ifdef= $hvAttr->{IFDEF} || 0;\r
+    my $writeperl= !! $hvAttr->{WRITE_PERL};\r
+    my $export= !! $hvAttr->{DO_EXPORT};\r
+    my $importto= $hvAttr->{IMPORT_TO} || "_constants";\r
+    my $cplusplus= $hvAttr->{CPLUSPLUS};\r
+    $cplusplus= ""   if  ! defined $cplusplus;\r
+    my $object= "";\r
+    my $binary= "";\r
+    my $final= "";\r
+    my $norebuild= "";\r
+    my $subroutine= "";\r
+    my $base;\r
+    my %params= (\r
+       PERL_PE_CODE => \$perlcode,\r
+       PERL_FILE_LIST => \@perlfiles,\r
+       PERL_FILE_CODES => \%perlfilecodes,\r
+       PERL_FILES => sub { map {($_,$perlfilecodes{$_})} @perlfiles },\r
+       C_PE_CODE => \$ccode,\r
+       C_FILE_LIST => \@cfiles,\r
+       C_FILE_CODES => \%cfilecodes,\r
+       C_FILES => sub { map {($_,$cfilecodes{$_})} @cfiles },\r
+       DO_EXPORT => \$export,\r
+       IMPORT_TO => \$importto,\r
+       IMPORT_LIST => \@importlist,\r
+       SUBROUTINE => \$subroutine,\r
+       IFDEF => \$ifdef,\r
+       WRITE_PERL => \$writeperl,\r
+       CPLUSPLUS => \$cplusplus,\r
+       BASEFILENAME => \$base,\r
+       OUTFILE => \$outfile,\r
+       OBJECT => \$object,\r
+       BINARY => \$binary,\r
+       FINAL_PERL => \$final,\r
+       NO_REBUILD => \$norebuild,\r
+    );\r
+    {   my @err= grep {! defined $params{$_}} keys %$hvAttr;\r
+       carp "ExtUtils::Myconst2perl::ParseAttribs:  ",\r
+         "Unsupported option(s) (@err).\n"\r
+         if  @err;\r
+    }\r
+    $norebuild= $hvAttr->{NO_REBUILD}   if  exists $hvAttr->{NO_REBUILD};\r
+    my $module= ( split /::/, $pkg )[-1];\r
+    $base= "c".$module;\r
+    $base= $hvAttr->{BASEFILENAME}   if  exists $hvAttr->{BASEFILENAME};\r
+    my $ext=  ! $cplusplus  ?  ($Config{_c}||".c")\r
+      :  $cplusplus =~ /^[.]/  ?  $cplusplus  :  _cc();\r
+    if(  $writeperl  ) {\r
+       $outfile= $base . "_pc" . $ext;\r
+       $object= $base . "_pc" . ($Config{_o}||$Config{obj_ext});\r
+       $object= $hvAttr->{OBJECT}   if  $hvAttr->{OBJECT};\r
+       $binary= $base . "_pc" . ($Config{_exe}||$Config{exe_ext});\r
+       $binary= $hvAttr->{BINARY}   if  $hvAttr->{BINARY};\r
+       $final= $base . ".pc";\r
+       $final= $hvAttr->{FINAL_PERL}   if  $hvAttr->{FINAL_PERL};\r
+       $subroutine= "main";\r
+    } elsif(  $cplusplus  ) {\r
+       $outfile= $base . $ext;\r
+       $object= $base . ($Config{_o}||$Config{obj_ext});\r
+       $object= $hvAttr->{OBJECT}   if  $hvAttr->{OBJECT};\r
+       $subroutine= "const2perl_" . $pkg;\r
+       $subroutine =~ s/\W/_/g;\r
+    } else {\r
+       $outfile= $base . ".h";\r
+    }\r
+    $outfile= $hvAttr->{OUTFILE}   if  $hvAttr->{OUTFILE};\r
+    if(  $hvAttr->{PERL_FILES}  ) {\r
+       carp "ExtUtils::Myconst2perl:  PERL_FILES option not allowed ",\r
+         "with PERL_FILE_LIST nor PERL_FILE_CODES.\n"\r
+         if  $hvAttr->{PERL_FILE_LIST}  ||  $hvAttr->{PERL_FILE_CODES};\r
+       %perlfilecodes= @{$hvAttr->{PERL_FILES}};\r
+       my $odd= 0;\r
+       @perlfiles= grep {$odd= !$odd} @{$hvAttr->{PERL_FILES}};\r
+    } else {\r
+       if(  $hvAttr->{PERL_FILE_LIST}  ) {\r
+           @perlfiles= @{$hvAttr->{PERL_FILE_LIST}};\r
+       } elsif(  $hvAttr->{PERL_FILE_CODES}  ) {\r
+           @perlfiles= keys %{$hvAttr->{PERL_FILE_CODES}};\r
+       } else {\r
+           @perlfiles= ( "$module.pm" );\r
+       }\r
+       %perlfilecodes= %{$hvAttr->{PERL_FILE_CODES}}\r
+         if  $hvAttr->{PERL_FILE_CODES};\r
+    }\r
+    for my $file (  @perlfiles  ) {\r
+       $perlfilecodes{$file}= $perlcode  if  ! $perlfilecodes{$file};\r
+    }\r
+    if(  ! $subroutine  ) {\r
+       ; # Don't process any C source code files.\r
+    } elsif(  $hvAttr->{C_FILES}  ) {\r
+       carp "ExtUtils::Myconst2perl:  C_FILES option not allowed ",\r
+         "with C_FILE_LIST nor C_FILE_CODES.\n"\r
+         if  $hvAttr->{C_FILE_LIST}  ||  $hvAttr->{C_FILE_CODES};\r
+       %cfilecodes= @{$hvAttr->{C_FILES}};\r
+       my $odd= 0;\r
+       @cfiles= grep {$odd= !$odd} @{$hvAttr->{C_FILES}};\r
+    } else {\r
+       if(  $hvAttr->{C_FILE_LIST}  ) {\r
+           @cfiles= @{$hvAttr->{C_FILE_LIST}};\r
+       } elsif(  $hvAttr->{C_FILE_CODES}  ) {\r
+           @cfiles= keys %{$hvAttr->{C_FILE_CODES}};\r
+       } elsif(  $writeperl  ||  $cplusplus  ) {\r
+           @cfiles= ( "$module.xs" );\r
+       }\r
+       %cfilecodes= %{$hvAttr->{C_FILE_CODES}}   if  $hvAttr->{C_FILE_CODES};\r
+    }\r
+    for my $file (  @cfiles  ) {\r
+       $cfilecodes{$file}= $ccode  if  ! $cfilecodes{$file};\r
+    }\r
+    for my $key (  keys %$hvRequests  ) {\r
+       if(  ! $params{$key}  ) {\r
+           carp "ExtUtils::Myconst2perl::ParseAttribs:  ",\r
+             "Unsupported output ($key).\n";\r
+       } elsif(  "SCALAR" eq ref( $params{$key} )  ) {\r
+           ${$hvRequests->{$key}}= ${$params{$key}};\r
+       } elsif(  "ARRAY" eq ref( $params{$key} )  ) {\r
+           @{$hvRequests->{$key}}= @{$params{$key}};\r
+       } elsif(  "HASH" eq ref( $params{$key} )  ) {\r
+           %{$hvRequests->{$key}}= %{$params{$key}};\r
+       } elsif(  "CODE" eq ref( $params{$key} )  ) {\r
+           @{$hvRequests->{$key}}=  &{$params{$key}};\r
+       } else {\r
+           die "Impossible value in \$params{$key}";\r
+       }\r
+    }\r
+}\r
+\r
+=item Myconst2perl\r
+\r
+Generates a file used to implement C constants as "constant subroutines" in\r
+a Perl module.\r
+\r
+Extracts a list of constants from a module's export list by C<eval>ing the\r
+first part of the Module's F<*.pm> file and then requesting some groups of\r
+symbols be exported/imported into a dummy package.  Then writes C or C++\r
+code that can convert each C constant into a Perl "constant subroutine"\r
+whose name is the constant's name and whose value is the constant's value.\r
+\r
+=cut\r
+\r
+sub Myconst2perl\r
+{\r
+    my( $pkg, %spec )= @_;\r
+    my( $outfile, $writeperl, $ifdef, $export, $importto, @importlist,\r
+        @perlfile, %perlcode, @cfile, %ccode, $routine );\r
+    ParseAttribs( $pkg, \%spec, {\r
+       DO_EXPORT => \$export,\r
+       IMPORT_TO => \$importto,\r
+       IMPORT_LIST => \@importlist,\r
+       IFDEF => \$ifdef,\r
+       WRITE_PERL => \$writeperl,\r
+       OUTFILE => \$outfile,\r
+       PERL_FILE_LIST => \@perlfile,\r
+       PERL_FILE_CODES => \%perlcode,\r
+       C_FILE_LIST => \@cfile,\r
+       C_FILE_CODES => \%ccode,\r
+       SUBROUTINE => \$routine,\r
+    } );\r
+    my $module= ( split /::/, $pkg )[-1];\r
+\r
+    warn "Writing $outfile...\n";\r
+    open( STDOUT, ">$outfile" )  or  die "Can't create $outfile: $!\n";\r
+\r
+    my $code= "";\r
+    my $file;\r
+    foreach $file (  @perlfile  ) {\r
+       warn "Reading Perl file, $file:  $perlcode{$file}\n";\r
+       open( MODULE, "<$file" )  or  die "Can't read Perl file, $file: $!\n";\r
+       eval qq[\r
+           while(  <MODULE>  ) {\r
+               $perlcode{$file};\r
+               \$code .= \$_;\r
+           }\r
+           1;\r
+       ]  or  die "$file eval: $@\n";\r
+       close( MODULE );\r
+    }\r
+\r
+    print\r
+      "/* $outfile - Generated by ExtUtils::Myconst2perl::Myconst2perl */\n";\r
+    if(  $routine  ) {\r
+       print "/* See start of $routine() for generation parameters used */\n";\r
+       #print "#define main _main_proto"\r
+       #  " /* Ignore Perl's main() prototype */\n\n";\r
+       if(  $writeperl  ) {\r
+           # Here are more reasons why the WRITE_PERL option is discouraged.\r
+           if(  $Config{useperlio}  ) {\r
+               print "#define PERLIO_IS_STDIO 1\n";\r
+           }\r
+           print "#define WIN32IO_IS_STDIO 1\n";       # May cause a warning\r
+           print "#define NO_XSLOCKS 1\n";     # What a hack!\r
+       }\r
+       foreach $file (  @cfile  ) {\r
+           warn "Reading C file, $file:  $ccode{$file}\n";\r
+           open( XS, "<$file" )  or  die "Can't read C file, $file: $!\n";\r
+           my $code= $ccode{$file};\r
+           $code =~ s#\\#\\\\#g;\r
+           $code =~ s#([^\s -~])#"\\x".sprintf "%02X",unpack "C",$1#ge;\r
+           $code =~ s#[*]/#*\\/#g;\r
+           print qq[\n/* Include $file:  $code */\n];\r
+           print qq[\n#line 1 "$file"\n];\r
+           eval qq[\r
+               while(  <XS>  ) {\r
+                   $ccode{$file};\r
+                   print;\r
+               }\r
+               1;\r
+           ]  or  die "$file eval: $@\n";\r
+           close( XS );\r
+       }\r
+       #print qq[\n#undef main\n];\r
+       print qq[\n#define CONST2WRITE_PERL\n];\r
+       print qq[\n#include "const2perl.h"\n\n];\r
+       if(  $writeperl  ) {\r
+           print "int\nmain( int argc, char *argv[], char *envp[] )\n";\r
+       } else {\r
+           print "void\n$routine( void )\n";\r
+       }\r
+    }\r
+    print "{\n";\r
+\r
+    {\r
+       @ExtUtils::Myconst2perl::importlist= @importlist;\r
+       my $var= '@ExtUtils::Myconst2perl::importlist';\r
+       my $port= $export ? "export" : "import";\r
+       my $arg2= $export ? "q[$importto]," : "";\r
+       local( $^W )= 0;\r
+       eval $code . "{\n"\r
+         . "    {    package $importto;\n"\r
+         . "        warn qq[\u${port}ing to $importto: $var\\n];\n"\r
+         . "        \$pkg->$port( $arg2 $var );\n"\r
+         . "    }\n"\r
+         . "    {   no strict 'refs';\n"\r
+         . "        $var=  sort keys %{'_constants::'};   }\n"\r
+         . "    warn 0 + $var, qq[ symbols ${port}ed.\\n];\n"\r
+         . "}\n1;\n"\r
+         or  die "eval: $@\n";\r
+    }\r
+    my @syms= @ExtUtils::Myconst2perl::importlist;\r
+\r
+    my $if;\r
+    my $const;\r
+    print qq[    START_CONSTS( "$pkg" )        /* No ";" */\n];\r
+    {\r
+       my( $head, $tail )= ( "/*", "\n" );\r
+       if(  $writeperl  ) {\r
+           $head= '    printf( "#';\r
+           $tail= '\\n" );' . "\n";\r
+           print $head, " Generated by $outfile.", $tail;\r
+       }\r
+       print $head, " Package $pkg with options:", $tail;\r
+       $head= " *"   if  ! $writeperl;\r
+       my $key;\r
+       foreach $key (  sort keys %spec  ) {\r
+           my $val= neatvalue($spec{$key});\r
+           $val =~ s/\\/\\\\/g   if  $writeperl;\r
+           print $head, "    $key => ", $val, $tail;\r
+       }\r
+       print $head, " Perl files eval'd:", $tail;\r
+       foreach $key (  @perlfile  ) {\r
+           my $code= $perlcode{$key};\r
+           $code =~ s#\\#\\\\#g;\r
+           $code =~ s#([^ -~])#"\\".sprintf "%03o",unpack "C",$1#ge;\r
+           $code =~ s#"#\\"#g   if  $writeperl;\r
+           print $head, "    $key => ", $code, $tail;\r
+       }\r
+       if(  $writeperl  ) {\r
+           print $head, " C files included:", $tail;\r
+           foreach $key (  @cfile  ) {\r
+               my $code= $ccode{$key};\r
+               $code =~ s#\\#\\\\#g;\r
+               $code =~ s#([^ -~])#"\\".sprintf "%03o",unpack "C",$1#ge;\r
+               $code =~ s#"#\\"#g;\r
+               print $head, "    $key => ", $code, $tail;\r
+           }\r
+       } else {\r
+           print " */\n";\r
+       }\r
+    }\r
+    if(  ! ref($ifdef)  &&  $ifdef =~ /[^\s\w]/  ) {\r
+       my $sub= $ifdef;\r
+       $sub= 'sub { local($_)= @_; ' . $sub . ' }'\r
+         unless  $sub =~ /^\s*sub\b/;\r
+       $ifdef= eval $sub;\r
+       die "$@:  $sub\n"   if  $@;\r
+       if(  "CODE" ne ref($ifdef)  ) {\r
+           die "IFDEF didn't create subroutine reference:  eval $sub\n";\r
+       }\r
+    }\r
+    foreach $const (  @syms  ) {\r
+       $if=  "CODE" eq ref($ifdef)  ?  $ifdef->($const)  :  $ifdef;\r
+       if(  ! $if  ) {\r
+           $if= "";\r
+       } elsif(  "1" eq $if  ) {\r
+           $if= "#ifdef $const\n";\r
+       } elsif(  $if !~ /^#/  ) {\r
+           $if= "#ifdef $if\n";\r
+       } else {\r
+           $if= "$if\n";\r
+       }\r
+       print $if\r
+         . qq[    const2perl( $const );\n];\r
+       if(  $if  ) {\r
+           print "#else\n"\r
+             . qq[    noconst( $const );\n]\r
+             . "#endif\n";\r
+       }\r
+    }\r
+    if(  $writeperl  ) {\r
+       print\r
+         qq[    printf( "1;\\n" );\n],\r
+         qq[    return( 0 );\n];\r
+    }\r
+    print "}\n";\r
+}\r
+\r
+1;\r
index cbc808c..25450a5 100644 (file)
-#!/usr/bin/perl -w
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-BEGIN {
-    $|= 1;
-
-    # when building perl, skip this test if Win32API::File isn't being built
-    if ( $ENV{PERL_CORE} ) {
-       require Config;
-       if ( $Config::Config{extensions} !~ m:(?<!\S)Win32API/File(?!\S): ) {
-           print "1..0 # Skip Win32API::File extension not built\n";
-           exit();
-       }
-    }
-
-    print "1..270\n";
-}
-END {print "not ok 1\n" unless $loaded;}
-
-# Win32API::File does an implicit "require Win32", but
-# the ../lib directory in @INC will no longer work once
-# we chdir() into the TEMP directory.
-
-use Win32;
-use File::Spec;
-use Carp;
-use Carp::Heavy;
-
-use Win32API::File qw(:ALL);
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-$test= 1;
-
-use strict qw(subs);
-
-$temp= File::Spec->tmpdir();
-$dir= "W32ApiF.tmp";
-
-$ENV{WINDIR} = $ENV{SYSTEMROOT} if not exists $ENV{WINDIR};
-
-chdir( $temp )
-  or  die "# Can't cd to temp directory, $temp: $!\n";
-$tempdir = File::Spec->catdir($temp,$dir);
-if(  -d $dir  ) {
-    print "# deleting ",File::Spec->catdir($temp,$dir,'*'),"\n" if glob "$dir/*";
-
-    for (glob "$dir/*") {
-       chmod 0777, $_;
-       unlink $_;
-    }
-    rmdir $dir or die "Could not rmdir $dir: $!";
-}
-mkdir( $dir, 0777 )
-  or  die "# Can't create temp dir, $tempdir: $!\n";
-print "# chdir $tempdir\n";
-chdir( $dir )
-  or  die "# Can't cd to my dir, $tempdir: $!\n";
-$h1= createFile( "ReadOnly.txt", "r", { Attributes=>"r" } );
-$ok=  ! $h1  &&  Win32API::File::_fileLastError() == 2; # could not find the file
-$ok or print "# ","".fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 2
-if(  ! $ok  ) {   CloseHandle($h1);   unlink("ReadOnly.txt");   }
-
-$ok= $h1= createFile( "ReadOnly.txt", "wcn", { Attributes=>"r" } );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 3
-
-$ok= WriteFile( $h1, "Original text\n", 0, [], [] );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 4
-
-$h2= createFile( "ReadOnly.txt", "rcn" );
-$ok= ! $h2  &&  Win32API::File::_fileLastError() == 80; # file exists
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 5
-if(  ! $ok  ) {   CloseHandle($h2);   }
-
-$h2= createFile( "ReadOnly.txt", "rwke" );
-$ok= ! $h2  &&  Win32API::File::_fileLastError() == 5; # access is denied
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 6
-if(  ! $ok  ) {   CloseHandle($h2);   }
-
-$ok= $h2= createFile( "ReadOnly.txt", "r" );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 7
-
-$ok= SetFilePointer( $h1, length("Original"), [], FILE_BEGIN );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 8
-
-$ok= WriteFile( $h1, "ly was other text\n", 0, $len, [] )
-  &&  $len == length("ly was other text\n");
-$ok or print "# <$len> should be <",
-  length("ly was other text\n"),">: ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 9
-
-$ok= ReadFile( $h2, $text, 80, $len, [] )
- &&  $len == length($text);
-$ok or print "# <$len> should be <",length($text),
-  ">: ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 10
-
-$ok= $text eq "Originally was other text\n";
-if( !$ok ) {
-    $text =~ s/\r/\\r/g;   $text =~ s/\n/\\n/g;
-    print "# <$text> should be <Originally was other text\\n>.\n";
-}
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 11
-
-$ok= CloseHandle($h2);
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 12
-
-$ok= ! ReadFile( $h2, $text, 80, $len, [] )
- &&  Win32API::File::_fileLastError() == 6; # handle is invalid
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 13
-
-CloseHandle($h1);
-
-$ok= $h1= createFile( "CanWrite.txt", "rw", FILE_SHARE_WRITE,
-             { Create=>CREATE_ALWAYS } );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 14
-
-$ok= WriteFile( $h1, "Just this and not this", 10, [], [] );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 15
-
-$ok= $h2= createFile( "CanWrite.txt", "wk", { Share=>"rw" } );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 16
-
-$ok= OsFHandleOpen( "APP", $h2, "wat" );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 17
-
-$ok=  $h2 == GetOsFHandle( "APP" );
-$ok or print "# $h2 != ",GetOsFHandle("APP"),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 18
-
-{   my $save= select(APP);   $|= 1;  select($save);   }
-$ok= print APP "is enough\n";
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 19
-
-SetFilePointer($h1, 0, [], FILE_BEGIN) if $^O eq 'cygwin';
-
-$ok= ReadFile( $h1, $text, 0, [], [] );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 20
-
-$ok=  $text eq "is enough\r\n";
-if( !$ok ) {
-    $text =~ s/\r/\\r/g;
-    $text =~ s/\n/\\n/g;
-    print "# <$text> should be <is enough\\r\\n>\n";
-}
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 21
-
-$skip = "";
-if ($^O eq 'cygwin') {
-    $ok = 1;
-    $skip = " # skip cygwin can delete open files";
-}
-else {
-    unlink("CanWrite.txt");
-    $ok = -e "CanWrite.txt" &&  $! =~ /permission denied/i;
-    $ok or print "# $!\n";
-}
-print $ok ? "" : "not ", "ok ", ++$test, "$skip\n"; # ok 22
-
-close(APP);            # Also does C<CloseHandle($h2)>
-## CloseHandle( $h2 );
-CloseHandle( $h1 );
-
-$ok= ! DeleteFile( "ReadOnly.txt" )
- &&  Win32API::File::_fileLastError() == 5; # access is denied
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 23
-
-$ok= ! CopyFile( "ReadOnly.txt", "CanWrite.txt", 1 )
- &&  Win32API::File::_fileLastError() == 80; # file exists
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 24
-
-$ok= ! CopyFile( "CanWrite.txt", "ReadOnly.txt", 0 )
- &&  Win32API::File::_fileLastError() == 5; # access is denied
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 25
-
-$ok= ! MoveFile( "NoSuchFile", "NoSuchDest" )
- &&  Win32API::File::_fileLastError() == 2; # not find the file
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 26
-
-$ok= ! MoveFileEx( "NoSuchFile", "NoSuchDest", 0 )
- &&  Win32API::File::_fileLastError() == 2; # not find the file
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 27
-
-$ok= ! MoveFile( "ReadOnly.txt", "CanWrite.txt" )
- &&  Win32API::File::_fileLastError() == 183; # file already exists
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 28
-
-$ok= ! MoveFileEx( "ReadOnly.txt", "CanWrite.txt", 0 )
- &&  Win32API::File::_fileLastError() == 183; # file already exists
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 29
-
-$ok= CopyFile( "ReadOnly.txt", "ReadOnly.cp", 1 )
- &&  CopyFile( "CanWrite.txt", "CanWrite.cp", 1 );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 30
-
-$ok= ! MoveFileEx( "CanWrite.txt", "ReadOnly.cp", MOVEFILE_REPLACE_EXISTING )
- &&  (Win32API::File::_fileLastError() == 5     # access is denied
- ||   Win32API::File::_fileLastError() == 183); # already exists
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 31
-
-$ok= MoveFileEx( "ReadOnly.cp", "CanWrite.cp", MOVEFILE_REPLACE_EXISTING );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 32
-
-$ok= MoveFile( "CanWrite.cp", "Moved.cp" );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 33
-
-$ok= ! unlink( "ReadOnly.cp" )
- &&  $! =~ /no such file/i
- &&  ! unlink( "CanWrite.cp" )
- &&  $! =~ /no such file/i;
-$ok or print "# $!\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 34
-
-$ok= ! DeleteFile( "Moved.cp" )
- &&  Win32API::File::_fileLastError() == 5; # access is denied
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 35
-
-if ($^O eq 'cygwin') {
-    chmod( 0200 | 07777 & (stat("Moved.cp"))[2], "Moved.cp" );
-}
-else {
-    system( "attrib -r Moved.cp" );
-}
-
-$ok= DeleteFile( "Moved.cp" );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 36
-
-$new= SEM_FAILCRITICALERRORS|SEM_NOOPENFILEERRORBOX;
-$old= SetErrorMode( $new );
-$renew= SetErrorMode( $old );
-$reold= SetErrorMode( $old );
-
-$ok= $old == $reold;
-$ok or print "# $old != $reold: ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 37
-
-$ok= ($renew&$new) == $new;
-$ok or print "# $new != $renew: ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 38
-
-$ok= @drives= getLogicalDrives();
-$ok && print "# @drives\n";
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 39
-
-$ok=  $drives[0] !~ /^[ab]/  ||  DRIVE_REMOVABLE == GetDriveType($drives[0]);
-$ok or print "# ",DRIVE_REMOVABLE," != ",GetDriveType($drives[0]),
-  ": ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 40
-
-$drive= substr( $ENV{WINDIR}, 0, 3 );
-
-$ok= 1 == grep /^\Q$drive\E/i, @drives;
-$ok or print "# No $drive found in list of drives.\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 41
-
-$ok= DRIVE_FIXED == GetDriveType( $drive );
-$ok or print
-  "# ",DRIVE_FIXED," != ",GetDriveType($drive),": ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 42
-
-$ok=  GetVolumeInformation( $drive, $vol, 64, $ser, $max, $flag, $fs, 16 );
-$ok or print "# ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 43
-$vol= $ser= $max= $flag= $fs= "";      # Prevent warnings.
-
-chop($drive);
-$ok= QueryDosDevice( $drive, $dev, 80 );
-$ok or print "# $drive: ",fileLastError(),"\n";
-if( $ok ) {
-    ( $text= $dev ) =~ s/\0/\\0/g;
-    print "# $drive => $text\n";
-}
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 44
-
-$bits= GetLogicalDrives();
-$let= 25;
-$bit= 1<<$let;
-while(  $bit & $bits  ) {
-    $let--;
-    $bit >>= 1;
-}
-$let= pack( "C", $let + unpack("C","A") ) . ":";
-print "# Querying undefined $let.\n";
-
-$ok= DefineDosDevice( 0, $let, $ENV{WINDIR} );
-$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 45
-
-$ok=  -s $let."/Win.ini"  ==  -s $ENV{WINDIR}."/Win.ini";
-$ok or print "# ", -s $let."/Win.ini", " vs. ",
-  -s $ENV{WINDIR}."/Win.ini", ": ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 46
-
-$ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE,
-                     $let, $ENV{WINDIR} );
-$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 47
-
-$ok= ! -f $let."/Win.ini"
-  &&  $! =~ /no such file/i;
-$ok or print "# $!\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 48
-
-$ok= DefineDosDevice( DDD_RAW_TARGET_PATH, $let, $dev );
-if( !$ok  ) {
-    ( $text= $dev ) =~ s/\0/\\0/g;
-    print "# $let,$text: ",fileLastError(),"\n";
-}
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 49
-
-my $path = $ENV{WINDIR};
-$ok= -f $let.substr($path,$^O eq 'cygwin'?2:3)."/win.ini";
-$ok or print "# ",$let.substr($path,3)."/win.ini ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 50
-
-$ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE
-                    |DDD_RAW_TARGET_PATH, $let, $dev );
-$ok or print "# $let,$dev: ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 51
-
-my $attrs = GetFileAttributes( $path );
-$ok= $attrs != INVALID_FILE_ATTRIBUTES;
-$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 52
-
-$ok= ($attrs & FILE_ATTRIBUTE_DIRECTORY);
-$ok or print "# $path not a directory, attrs=$attrs: ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 53
-
-$path .= "/win.ini";
-$attrs = GetFileAttributes( $path );
-$ok= $attrs != INVALID_FILE_ATTRIBUTES;
-$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 54
-
-$ok= !($attrs & FILE_ATTRIBUTE_DIRECTORY);
-$ok or print "# $path is a directory, attrs=$attrs: ",fileLastError(),"\n";
-print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 55
-
-#      DefineDosDevice
-#      GetFileType
-#      GetVolumeInformation
-#      QueryDosDevice
-#Add a drive letter that points to our temp directory
-#Add a drive letter that points to the drive our directory is in
-
-#winnt.t:
-# get first drive letters and use to test disk and storage IOCTLs
-# "//./PhysicalDrive0"
-#      DeviceIoControl
-
-my %consts;
-my @consts= @Win32API::File::EXPORT_OK;
-@consts{@consts}= @consts;
-
-my( @noargs, %noargs )= qw(
-  attrLetsToBits fileLastError getLogicalDrives GetLogicalDrives );
-@noargs{@noargs}= @noargs;
-
-foreach $func ( @{$Win32API::File::EXPORT_TAGS{Func}} ) {
-    delete $consts{$func};
-    if(  defined( $noargs{$func} )  ) {
-       $ok=  ! eval("$func(0,0)")  &&  $@ =~ /(::|\s)_?${func}A?[(:\s]/;
-    } else {
-       $ok=  ! eval("$func()")  &&  $@ =~ /(::|\s)_?${func}A?[(:\s]/;
-    }
-    $ok or print "# $func: $@\n";
-    print $ok ? "" : "not ", "ok ", ++$test, "\n";
-}
-
-foreach $func ( @{$Win32API::File::EXPORT_TAGS{FuncA}},
-                @{$Win32API::File::EXPORT_TAGS{FuncW}} ) {
-    $ok=  ! eval("$func()")  &&  $@ =~ /::_?${func}\(/;
-    delete $consts{$func};
-    $ok or print "# $func: $@\n";
-    print $ok ? "" : "not ", "ok ", ++$test, "\n";
-}
-
-foreach $const ( keys(%consts) ) {
-    $ok= eval("my \$x= $const(); 1");
-    $ok or print "# Constant $const: $@\n";
-    print $ok ? "" : "not ", "ok ", ++$test, "\n";
-}
-
-chdir( $temp );
-if (-e "$dir/ReadOnly.txt") {
-    chmod 0777, "$dir/ReadOnly.txt";
-    unlink "$dir/ReadOnly.txt";
-}
-unlink "$dir/CanWrite.txt" if -e "$dir/CanWrite.txt";
-rmdir $dir;
-
-__END__
+#!/usr/bin/perl -w\r
+# Before `make install' is performed this script should be runnable with\r
+# `make test'. After `make install' it should work as `perl test.pl'\r
+\r
+######################### We start with some black magic to print on failure.\r
+\r
+BEGIN {\r
+    $|= 1;\r
+\r
+    # when building perl, skip this test if Win32API::File isn't being built\r
+    if ( $ENV{PERL_CORE} ) {\r
+       require Config;\r
+       if ( $Config::Config{extensions} !~ m:(?<!\S)Win32API/File(?!\S): ) {\r
+           print "1..0 # Skip Win32API::File extension not built\n";\r
+           exit();\r
+       }\r
+    }\r
+\r
+    print "1..270\n";\r
+}\r
+END {print "not ok 1\n" unless $loaded;}\r
+\r
+# Win32API::File does an implicit "require Win32", but\r
+# the ../lib directory in @INC will no longer work once\r
+# we chdir() into the TEMP directory.\r
+\r
+use Win32;\r
+use File::Spec;\r
+use Carp;\r
+use Carp::Heavy;\r
+\r
+use Win32API::File qw(:ALL);\r
+$loaded = 1;\r
+print "ok 1\n";\r
+\r
+######################### End of black magic.\r
+\r
+$test= 1;\r
+\r
+use strict qw(subs);\r
+\r
+$temp= File::Spec->tmpdir();\r
+$dir= "W32ApiF.tmp";\r
+\r
+$ENV{WINDIR} = $ENV{SYSTEMROOT} if not exists $ENV{WINDIR};\r
+\r
+chdir( $temp )\r
+  or  die "# Can't cd to temp directory, $temp: $!\n";\r
+$tempdir = File::Spec->catdir($temp,$dir);\r
+if(  -d $dir  ) {\r
+    print "# deleting ",File::Spec->catdir($temp,$dir,'*'),"\n" if glob "$dir/*";\r
+\r
+    for (glob "$dir/*") {\r
+       chmod 0777, $_;\r
+       unlink $_;\r
+    }\r
+    rmdir $dir or die "Could not rmdir $dir: $!";\r
+}\r
+mkdir( $dir, 0777 )\r
+  or  die "# Can't create temp dir, $tempdir: $!\n";\r
+print "# chdir $tempdir\n";\r
+chdir( $dir )\r
+  or  die "# Can't cd to my dir, $tempdir: $!\n";\r
+$h1= createFile( "ReadOnly.txt", "r", { Attributes=>"r" } );\r
+$ok=  ! $h1  &&  Win32API::File::_fileLastError() == 2; # could not find the file\r
+$ok or print "# ","".fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 2\r
+if(  ! $ok  ) {   CloseHandle($h1);   unlink("ReadOnly.txt");   }\r
+\r
+$ok= $h1= createFile( "ReadOnly.txt", "wcn", { Attributes=>"r" } );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 3\r
+\r
+$ok= WriteFile( $h1, "Original text\n", 0, [], [] );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 4\r
+\r
+$h2= createFile( "ReadOnly.txt", "rcn" );\r
+$ok= ! $h2  &&  Win32API::File::_fileLastError() == 80; # file exists\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 5\r
+if(  ! $ok  ) {   CloseHandle($h2);   }\r
+\r
+$h2= createFile( "ReadOnly.txt", "rwke" );\r
+$ok= ! $h2  &&  Win32API::File::_fileLastError() == 5; # access is denied\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 6\r
+if(  ! $ok  ) {   CloseHandle($h2);   }\r
+\r
+$ok= $h2= createFile( "ReadOnly.txt", "r" );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 7\r
+\r
+$ok= SetFilePointer( $h1, length("Original"), [], FILE_BEGIN );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 8\r
+\r
+$ok= WriteFile( $h1, "ly was other text\n", 0, $len, [] )\r
+  &&  $len == length("ly was other text\n");\r
+$ok or print "# <$len> should be <",\r
+  length("ly was other text\n"),">: ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 9\r
+\r
+$ok= ReadFile( $h2, $text, 80, $len, [] )\r
+ &&  $len == length($text);\r
+$ok or print "# <$len> should be <",length($text),\r
+  ">: ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 10\r
+\r
+$ok= $text eq "Originally was other text\n";\r
+if( !$ok ) {\r
+    $text =~ s/\r/\\r/g;   $text =~ s/\n/\\n/g;\r
+    print "# <$text> should be <Originally was other text\\n>.\n";\r
+}\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 11\r
+\r
+$ok= CloseHandle($h2);\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 12\r
+\r
+$ok= ! ReadFile( $h2, $text, 80, $len, [] )\r
+ &&  Win32API::File::_fileLastError() == 6; # handle is invalid\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 13\r
+\r
+CloseHandle($h1);\r
+\r
+$ok= $h1= createFile( "CanWrite.txt", "rw", FILE_SHARE_WRITE,\r
+             { Create=>CREATE_ALWAYS } );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 14\r
+\r
+$ok= WriteFile( $h1, "Just this and not this", 10, [], [] );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 15\r
+\r
+$ok= $h2= createFile( "CanWrite.txt", "wk", { Share=>"rw" } );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 16\r
+\r
+$ok= OsFHandleOpen( "APP", $h2, "wat" );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 17\r
+\r
+$ok=  $h2 == GetOsFHandle( "APP" );\r
+$ok or print "# $h2 != ",GetOsFHandle("APP"),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 18\r
+\r
+{   my $save= select(APP);   $|= 1;  select($save);   }\r
+$ok= print APP "is enough\n";\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 19\r
+\r
+SetFilePointer($h1, 0, [], FILE_BEGIN) if $^O eq 'cygwin';\r
+\r
+$ok= ReadFile( $h1, $text, 0, [], [] );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 20\r
+\r
+$ok=  $text eq "is enough\r\n";\r
+if( !$ok ) {\r
+    $text =~ s/\r/\\r/g;\r
+    $text =~ s/\n/\\n/g;\r
+    print "# <$text> should be <is enough\\r\\n>\n";\r
+}\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 21\r
+\r
+$skip = "";\r
+if ($^O eq 'cygwin') {\r
+    $ok = 1;\r
+    $skip = " # skip cygwin can delete open files";\r
+}\r
+else {\r
+    unlink("CanWrite.txt");\r
+    $ok = -e "CanWrite.txt" &&  $! =~ /permission denied/i;\r
+    $ok or print "# $!\n";\r
+}\r
+print $ok ? "" : "not ", "ok ", ++$test, "$skip\n"; # ok 22\r
+\r
+close(APP);            # Also does C<CloseHandle($h2)>\r
+## CloseHandle( $h2 );\r
+CloseHandle( $h1 );\r
+\r
+$ok= ! DeleteFile( "ReadOnly.txt" )\r
+ &&  Win32API::File::_fileLastError() == 5; # access is denied\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 23\r
+\r
+$ok= ! CopyFile( "ReadOnly.txt", "CanWrite.txt", 1 )\r
+ &&  Win32API::File::_fileLastError() == 80; # file exists\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 24\r
+\r
+$ok= ! CopyFile( "CanWrite.txt", "ReadOnly.txt", 0 )\r
+ &&  Win32API::File::_fileLastError() == 5; # access is denied\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 25\r
+\r
+$ok= ! MoveFile( "NoSuchFile", "NoSuchDest" )\r
+ &&  Win32API::File::_fileLastError() == 2; # not find the file\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 26\r
+\r
+$ok= ! MoveFileEx( "NoSuchFile", "NoSuchDest", 0 )\r
+ &&  Win32API::File::_fileLastError() == 2; # not find the file\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 27\r
+\r
+$ok= ! MoveFile( "ReadOnly.txt", "CanWrite.txt" )\r
+ &&  Win32API::File::_fileLastError() == 183; # file already exists\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 28\r
+\r
+$ok= ! MoveFileEx( "ReadOnly.txt", "CanWrite.txt", 0 )\r
+ &&  Win32API::File::_fileLastError() == 183; # file already exists\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 29\r
+\r
+$ok= CopyFile( "ReadOnly.txt", "ReadOnly.cp", 1 )\r
+ &&  CopyFile( "CanWrite.txt", "CanWrite.cp", 1 );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 30\r
+\r
+$ok= ! MoveFileEx( "CanWrite.txt", "ReadOnly.cp", MOVEFILE_REPLACE_EXISTING )\r
+ &&  (Win32API::File::_fileLastError() == 5     # access is denied\r
+ ||   Win32API::File::_fileLastError() == 183); # already exists\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 31\r
+\r
+$ok= MoveFileEx( "ReadOnly.cp", "CanWrite.cp", MOVEFILE_REPLACE_EXISTING );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 32\r
+\r
+$ok= MoveFile( "CanWrite.cp", "Moved.cp" );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 33\r
+\r
+$ok= ! unlink( "ReadOnly.cp" )\r
+ &&  $! =~ /no such file/i\r
+ &&  ! unlink( "CanWrite.cp" )\r
+ &&  $! =~ /no such file/i;\r
+$ok or print "# $!\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 34\r
+\r
+$ok= ! DeleteFile( "Moved.cp" )\r
+ &&  Win32API::File::_fileLastError() == 5; # access is denied\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 35\r
+\r
+if ($^O eq 'cygwin') {\r
+    chmod( 0200 | 07777 & (stat("Moved.cp"))[2], "Moved.cp" );\r
+}\r
+else {\r
+    system( "attrib -r Moved.cp" );\r
+}\r
+\r
+$ok= DeleteFile( "Moved.cp" );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 36\r
+\r
+$new= SEM_FAILCRITICALERRORS|SEM_NOOPENFILEERRORBOX;\r
+$old= SetErrorMode( $new );\r
+$renew= SetErrorMode( $old );\r
+$reold= SetErrorMode( $old );\r
+\r
+$ok= $old == $reold;\r
+$ok or print "# $old != $reold: ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 37\r
+\r
+$ok= ($renew&$new) == $new;\r
+$ok or print "# $new != $renew: ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 38\r
+\r
+$ok= @drives= getLogicalDrives();\r
+$ok && print "# @drives\n";\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 39\r
+\r
+$ok=  $drives[0] !~ /^[ab]/  ||  DRIVE_REMOVABLE == GetDriveType($drives[0]);\r
+$ok or print "# ",DRIVE_REMOVABLE," != ",GetDriveType($drives[0]),\r
+  ": ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 40\r
+\r
+$drive= substr( $ENV{WINDIR}, 0, 3 );\r
+\r
+$ok= 1 == grep /^\Q$drive\E/i, @drives;\r
+$ok or print "# No $drive found in list of drives.\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 41\r
+\r
+$ok= DRIVE_FIXED == GetDriveType( $drive );\r
+$ok or print\r
+  "# ",DRIVE_FIXED," != ",GetDriveType($drive),": ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 42\r
+\r
+$ok=  GetVolumeInformation( $drive, $vol, 64, $ser, $max, $flag, $fs, 16 );\r
+$ok or print "# ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 43\r
+$vol= $ser= $max= $flag= $fs= "";      # Prevent warnings.\r
+\r
+chop($drive);\r
+$ok= QueryDosDevice( $drive, $dev, 80 );\r
+$ok or print "# $drive: ",fileLastError(),"\n";\r
+if( $ok ) {\r
+    ( $text= $dev ) =~ s/\0/\\0/g;\r
+    print "# $drive => $text\n";\r
+}\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 44\r
+\r
+$bits= GetLogicalDrives();\r
+$let= 25;\r
+$bit= 1<<$let;\r
+while(  $bit & $bits  ) {\r
+    $let--;\r
+    $bit >>= 1;\r
+}\r
+$let= pack( "C", $let + unpack("C","A") ) . ":";\r
+print "# Querying undefined $let.\n";\r
+\r
+$ok= DefineDosDevice( 0, $let, $ENV{WINDIR} );\r
+$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 45\r
+\r
+$ok=  -s $let."/Win.ini"  ==  -s $ENV{WINDIR}."/Win.ini";\r
+$ok or print "# ", -s $let."/Win.ini", " vs. ",\r
+  -s $ENV{WINDIR}."/Win.ini", ": ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 46\r
+\r
+$ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE,\r
+                     $let, $ENV{WINDIR} );\r
+$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 47\r
+\r
+$ok= ! -f $let."/Win.ini"\r
+  &&  $! =~ /no such file/i;\r
+$ok or print "# $!\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 48\r
+\r
+$ok= DefineDosDevice( DDD_RAW_TARGET_PATH, $let, $dev );\r
+if( !$ok  ) {\r
+    ( $text= $dev ) =~ s/\0/\\0/g;\r
+    print "# $let,$text: ",fileLastError(),"\n";\r
+}\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 49\r
+\r
+my $path = $ENV{WINDIR};\r
+$ok= -f $let.substr($path,$^O eq 'cygwin'?2:3)."/win.ini";\r
+$ok or print "# ",$let.substr($path,3)."/win.ini ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 50\r
+\r
+$ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE\r
+                    |DDD_RAW_TARGET_PATH, $let, $dev );\r
+$ok or print "# $let,$dev: ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 51\r
+\r
+my $attrs = GetFileAttributes( $path );\r
+$ok= $attrs != INVALID_FILE_ATTRIBUTES;\r
+$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 52\r
+\r
+$ok= ($attrs & FILE_ATTRIBUTE_DIRECTORY);\r
+$ok or print "# $path not a directory, attrs=$attrs: ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 53\r
+\r
+$path .= "/win.ini";\r
+$attrs = GetFileAttributes( $path );\r
+$ok= $attrs != INVALID_FILE_ATTRIBUTES;\r
+$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 54\r
+\r
+$ok= !($attrs & FILE_ATTRIBUTE_DIRECTORY);\r
+$ok or print "# $path is a directory, attrs=$attrs: ",fileLastError(),"\n";\r
+print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 55\r
+\r
+#      DefineDosDevice\r
+#      GetFileType\r
+#      GetVolumeInformation\r
+#      QueryDosDevice\r
+#Add a drive letter that points to our temp directory\r
+#Add a drive letter that points to the drive our directory is in\r
+\r
+#winnt.t:\r
+# get first drive letters and use to test disk and storage IOCTLs\r
+# "//./PhysicalDrive0"\r
+#      DeviceIoControl\r
+\r
+my %consts;\r
+my @consts= @Win32API::File::EXPORT_OK;\r
+@consts{@consts}= @consts;\r
+\r
+my( @noargs, %noargs )= qw(\r
+  attrLetsToBits fileLastError getLogicalDrives GetLogicalDrives );\r
+@noargs{@noargs}= @noargs;\r
+\r
+foreach $func ( @{$Win32API::File::EXPORT_TAGS{Func}} ) {\r
+    delete $consts{$func};\r
+    if(  defined( $noargs{$func} )  ) {\r
+       $ok=  ! eval("$func(0,0)")  &&  $@ =~ /(::|\s)_?${func}A?[(:\s]/;\r
+    } else {\r
+       $ok=  ! eval("$func()")  &&  $@ =~ /(::|\s)_?${func}A?[(:\s]/;\r
+    }\r
+    $ok or print "# $func: $@\n";\r
+    print $ok ? "" : "not ", "ok ", ++$test, "\n";\r
+}\r
+\r
+foreach $func ( @{$Win32API::File::EXPORT_TAGS{FuncA}},\r
+                @{$Win32API::File::EXPORT_TAGS{FuncW}} ) {\r
+    $ok=  ! eval("$func()")  &&  $@ =~ /::_?${func}\(/;\r
+    delete $consts{$func};\r
+    $ok or print "# $func: $@\n";\r
+    print $ok ? "" : "not ", "ok ", ++$test, "\n";\r
+}\r
+\r
+foreach $const ( keys(%consts) ) {\r
+    $ok= eval("my \$x= $const(); 1");\r
+    $ok or print "# Constant $const: $@\n";\r
+    print $ok ? "" : "not ", "ok ", ++$test, "\n";\r
+}\r
+\r
+chdir( $temp );\r
+if (-e "$dir/ReadOnly.txt") {\r
+    chmod 0777, "$dir/ReadOnly.txt";\r
+    unlink "$dir/ReadOnly.txt";\r
+}\r
+unlink "$dir/CanWrite.txt" if -e "$dir/CanWrite.txt";\r
+rmdir $dir;\r
+\r
+__END__\r
index 34b1cd7..262550d 100644 (file)
@@ -4,89 +4,70 @@
 BEGIN {
     $|= 1;
 
+    use Test::More;
+
     # when building perl, skip this test if Win32API::File isn't being built
     if ( $ENV{PERL_CORE} ) {
-       require Config;
-       if ( $Config::Config{extensions} !~ m:(?<!\S)Win32API/File(?!\S): ) {
-           print "1..0 # Skip Win32API::File extension not built\n";
-           exit();
-       }
+        require Config;
+        if ( $Config::Config{extensions} !~ m:(?<!\S)Win32API/File(?!\S): ) {
+            plan skip_all => 'Skip Win32API::File extension not built';
+            exit;
+        }
     }
 
-    print "1..10\n";
+    plan tests => 10;
 }
-END   { print "not ok 1\n" unless $main::loaded; }
 
 use strict;
 use warnings;
 use Win32API::File qw(:ALL);
 use IO::File;
 
-$main::loaded = 1;
-
-print "ok 1\n";
+my $filename = 'foo.txt';
+ok(! -e $filename || unlink($filename), "unlinked $filename (if it existed)");
 
-unlink "foo.txt";
-
-my $fh = Win32API::File->new("+> foo.txt")
-       or die fileLastError();
+my $fh = Win32API::File->new("+> $filename")
+    or die fileLastError();
 
 my $tell = tell $fh;
-print "# tell \$fh == '$tell'\n";
-print "not " unless
-       tell $fh == 0;
-print "ok 2\n";
+is(0+$tell, 0, "tell \$fh == '$tell'");
 
 my $text = "some text\n";
 
-print "not " unless
-       print $fh $text;
-print "ok 3\n";
+ok(print($fh $text), "printed 'some text\\n'");
 
 $tell = tell $fh;
-print "# after printing 'some text\\n', tell is: '$tell'\n";
-print "not " unless
-       $tell == length($text) + 1;
-print "ok 4\n";
+my $len = length($text) + 1; # + 1 for cr
+is($tell, $len, "after printing 'some text\\n', tell is: '$tell'");
 
-print "not " unless
-       seek($fh, 0, 0) == 0;
-print "ok 5\n";
+my $seek = seek($fh, 0, 0);
+is(0+$seek, 0, "seek is: '$seek'");
 
-print "not " unless
-       not eof $fh;
-print "ok 6\n";
+my $eof = eof $fh;
+ok(! $eof, 'not eof');
 
 my $readline = <$fh>;
 
 my $pretty_readline = $readline;
-$pretty_readline =~ s/\r/\\r/g;  $pretty_readline =~ s/\n/\\n/g;  
-print "# read line is '$pretty_readline'\n";
-
-print "not " unless
-       $readline eq "some text\r\n";
-print "ok 7\n";
+$pretty_readline =~ s/\r/\\r/g;  $pretty_readline =~ s/\n/\\n/g;
+is($pretty_readline, "some text\\r\\n", "read line is '$pretty_readline'");
 
-print "not " unless
-       eof $fh;
-print "ok 8\n";
+$eof = eof $fh;
+ok($eof, 'reached eof');
 
-print "not " unless
-       close $fh;
-print "ok 9\n";
+ok(close($fh), 'closed filehandle');
 
 # Test out binmode (should be only LF with print, no CR).
 
-$fh = Win32API::File->new("+> foo.txt")
-       or die fileLastError();
+$fh = Win32API::File->new("+> $filename")
+    or die fileLastError();
 binmode $fh;
 print $fh "hello there\n";
 seek $fh, 0, 0;
 
-print "not " unless
-       <$fh> eq "hello there\n";
-print "ok 10\n";
+$readline = <$fh>;
+is($readline, "hello there\n", "binmode worked (no CR)");
 
 close $fh;
 
-unlink "foo.txt";
+unlink $filename;
index 2134712..76c8196 100644 (file)
-BOOL                   T_BOOL
-LONG                   T_IV
-HKEY                   T_UV
-HANDLE                 T_UV
-DWORD                  T_UV
-oDWORD                 O_UV
-UINT                   T_UV
-REGSAM                 T_UV
-SECURITY_INFORMATION   T_UV
-char *                 T_BUF
-WCHAR *                        T_BUF
-BYTE *                 T_BUF
-void *                 T_BUF
-ValEntA *              T_BUF
-ValEntW *              T_BUF
-SECURITY_DESCRIPTOR *  T_BUF
-SECURITY_ATTRIBUTES *  T_BUF
-LPOVERLAPPED           T_BUF
-LONG *                 T_IVBUF
-DWORD *                        T_UVBUF
-LPDWORD                        T_UVBUF
-oDWORD *               O_UVBUF
-HKEY *                 T_UVBUFP
-oHKEY *                        O_UVBUFP
-FILETIME *             T_SBUF
-
-#############################################################################
-INPUT
-T_BOOL
-       $var= null_arg($arg)||!SvTRUE($arg) ? ($type)0 : looks_like_number($arg) ? ($type)SvIV($arg) : ($type)1
-T_BUF
-       if(  null_arg($arg)  )
-           $var= NULL;
-       else
-           $var= ($type) SvPV_nolen( $arg )
-T_SBUF
-       grow_buf( $var,$arg, $type )
-T_IV
-       $var= null_arg($arg) ? ($type)0 : INT2PTR($type,SvIV($arg))
-T_UV
-       $var= null_arg($arg) ? ($type)0 : INT2PTR($type,SvUV($arg))
-O_IV
-       $var= optIV($arg)
-O_UV
-       $var= optUV($arg)
-T_IVBUF
-       if(  null_arg($arg)  )
-           $var= NULL;
-       else
-           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= SvIV($arg)
-T_UVBUF
-       if(  null_arg($arg)  )
-           $var= NULL;
-       else
-           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= SvUV($arg)
-O_IVBUF
-       if(  null_arg($arg)  )
-           $var= NULL;
-       else
-           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )=
-             SvOK($arg) ? SvIV($arg) : 0;
-O_UVBUF
-       if(  null_arg($arg)  )
-           $var= NULL;
-       else
-           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )=
-             SvOK($arg) ? SvUV($arg) : 0;
-T_IVBUFP
-       if(  null_arg($arg)  )
-           $var= NULL;
-       else
-           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= (void *)SvIV($arg)
-T_UVBUFP
-       if(  null_arg($arg)  )
-           $var= NULL;
-       else
-           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= (void *)SvUV($arg)
-O_IVBUFP
-       if(  null_arg($arg)  )
-           $var= NULL;
-       else
-           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )=
-             SvOK($arg) ? (void *)SvIV($arg) : 0;
-O_UVBUFP
-       if(  null_arg($arg)  )
-           $var= NULL;
-       else
-           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )=
-             SvOK($arg) ? (void *)SvUV($arg) : 0;
-
-#############################################################################
-OUTPUT
-T_BOOL
-       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  ) {
-           if(  $var  ) {
-               sv_setiv( $arg, (IV)$var );
-           } else {
-               sv_setsv( $arg, &PL_sv_no );
-           }
-       }
-T_BUF
-       ;
-T_SBUF
-       trunc_buf( RETVAL, $var,$arg );
-T_IV
-       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  )
-           sv_setiv( $arg, PTR2IV($var) );
-T_UV
-       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  )
-           sv_setuv( $arg, PTR2UV($var) );
-O_IV
-       if(  ! null_arg($arg)  )
-           sv_setiv( $arg, PTR2IV($var) );
-O_UV
-       if(  ! null_arg($arg)  )
-           sv_setuv( $arg, PTR2UV($var) );
-T_IVBUF
-       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  )
-           sv_setiv( $arg, (IV)*($var) );
-T_UVBUF
-       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  )
-           sv_setuv( $arg, (UV)*($var) );
-O_IVBUF
-       if(  ! null_arg($arg)  )
-           sv_setiv( $arg, (IV)*($var) );
-O_UVBUF
-       if(  ! null_arg($arg)  )
-           sv_setuv( $arg, (UV)*($var) );
-T_IVBUFP
-       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  )
-           sv_setiv( $arg, (IV)*($var) );
-T_UVBUFP
-       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  )
-           sv_setuv( $arg, (UV)*($var) );
-O_IVBUFP
-       if(  ! null_arg($arg)  )
-           sv_setiv( $arg, (IV)*($var) );
-O_UVBUFP
-       if(  ! null_arg($arg)  )
-           sv_setuv( $arg, (UV)*($var) );
+BOOL                   T_BOOL\r
+LONG                   T_IV\r
+HKEY                   T_UV\r
+HANDLE                 T_UV\r
+DWORD                  T_UV\r
+oDWORD                 O_UV\r
+UINT                   T_UV\r
+REGSAM                 T_UV\r
+SECURITY_INFORMATION   T_UV\r
+char *                 T_BUF\r
+WCHAR *                        T_BUF\r
+BYTE *                 T_BUF\r
+void *                 T_BUF\r
+ValEntA *              T_BUF\r
+ValEntW *              T_BUF\r
+SECURITY_DESCRIPTOR *  T_BUF\r
+SECURITY_ATTRIBUTES *  T_BUF\r
+LPOVERLAPPED           T_BUF\r
+LONG *                 T_IVBUF\r
+DWORD *                        T_UVBUF\r
+LPDWORD                        T_UVBUF\r
+oDWORD *               O_UVBUF\r
+HKEY *                 T_UVBUFP\r
+oHKEY *                        O_UVBUFP\r
+FILETIME *             T_SBUF\r
+\r
+#############################################################################\r
+INPUT\r
+T_BOOL\r
+       $var= null_arg($arg)||!SvTRUE($arg) ? ($type)0 : looks_like_number($arg) ? ($type)SvIV($arg) : ($type)1\r
+T_BUF\r
+       if(  null_arg($arg)  )\r
+           $var= NULL;\r
+       else\r
+           $var= ($type) SvPV_nolen( $arg )\r
+T_SBUF\r
+       grow_buf( $var,$arg, $type )\r
+T_IV\r
+       $var= null_arg($arg) ? ($type)0 : INT2PTR($type,SvIV($arg))\r
+T_UV\r
+       $var= null_arg($arg) ? ($type)0 : INT2PTR($type,SvUV($arg))\r
+O_IV\r
+       $var= optIV($arg)\r
+O_UV\r
+       $var= optUV($arg)\r
+T_IVBUF\r
+       if(  null_arg($arg)  )\r
+           $var= NULL;\r
+       else\r
+           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= SvIV($arg)\r
+T_UVBUF\r
+       if(  null_arg($arg)  )\r
+           $var= NULL;\r
+       else\r
+           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= SvUV($arg)\r
+O_IVBUF\r
+       if(  null_arg($arg)  )\r
+           $var= NULL;\r
+       else\r
+           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )=\r
+             SvOK($arg) ? SvIV($arg) : 0;\r
+O_UVBUF\r
+       if(  null_arg($arg)  )\r
+           $var= NULL;\r
+       else\r
+           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )=\r
+             SvOK($arg) ? SvUV($arg) : 0;\r
+T_IVBUFP\r
+       if(  null_arg($arg)  )\r
+           $var= NULL;\r
+       else\r
+           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= (void *)SvIV($arg)\r
+T_UVBUFP\r
+       if(  null_arg($arg)  )\r
+           $var= NULL;\r
+       else\r
+           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )= (void *)SvUV($arg)\r
+O_IVBUFP\r
+       if(  null_arg($arg)  )\r
+           $var= NULL;\r
+       else\r
+           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )=\r
+             SvOK($arg) ? (void *)SvIV($arg) : 0;\r
+O_UVBUFP\r
+       if(  null_arg($arg)  )\r
+           $var= NULL;\r
+       else\r
+           *( $var= ($type) TempAlloc( sizeof(*($var)) ) )=\r
+             SvOK($arg) ? (void *)SvUV($arg) : 0;\r
+\r
+#############################################################################\r
+OUTPUT\r
+T_BOOL\r
+       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  ) {\r
+           if(  $var  ) {\r
+               sv_setiv( $arg, (IV)$var );\r
+           } else {\r
+               sv_setsv( $arg, &PL_sv_no );\r
+           }\r
+       }\r
+T_BUF\r
+       ;\r
+T_SBUF\r
+       trunc_buf( RETVAL, $var,$arg );\r
+T_IV\r
+       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  )\r
+           sv_setiv( $arg, PTR2IV($var) );\r
+T_UV\r
+       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  )\r
+           sv_setuv( $arg, PTR2UV($var) );\r
+O_IV\r
+       if(  ! null_arg($arg)  )\r
+           sv_setiv( $arg, PTR2IV($var) );\r
+O_UV\r
+       if(  ! null_arg($arg)  )\r
+           sv_setuv( $arg, PTR2UV($var) );\r
+T_IVBUF\r
+       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  )\r
+           sv_setiv( $arg, (IV)*($var) );\r
+T_UVBUF\r
+       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  )\r
+           sv_setuv( $arg, (UV)*($var) );\r
+O_IVBUF\r
+       if(  ! null_arg($arg)  )\r
+           sv_setiv( $arg, (IV)*($var) );\r
+O_UVBUF\r
+       if(  ! null_arg($arg)  )\r
+           sv_setuv( $arg, (UV)*($var) );\r
+T_IVBUFP\r
+       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  )\r
+           sv_setiv( $arg, (IV)*($var) );\r
+T_UVBUFP\r
+       if(  ! null_arg($arg)  &&  ! SvREADONLY($arg)  )\r
+           sv_setuv( $arg, (UV)*($var) );\r
+O_IVBUFP\r
+       if(  ! null_arg($arg)  )\r
+           sv_setiv( $arg, (IV)*($var) );\r
+O_UVBUFP\r
+       if(  ! null_arg($arg)  )\r
+           sv_setuv( $arg, (UV)*($var) );\r
index 0779609..cf45ebc 100644 (file)
@@ -74,7 +74,6 @@
 /ExtUtils/Miniperl.pm
 /ExtUtils/Mkbootstrap.pm
 /ExtUtils/Mksymlists.pm
-/ExtUtils/Myconst2perl.pm
 /ExtUtils/Packlist.pm
 /ExtUtils/ParseXS.pm
 /ExtUtils/ParseXS.pod
 /experimental.pm
 /fields.pm
 /if.pm
+/inc/
 /lib.pm
 /mro.pm
 /ok.pm
index 8410d0b..6c4f404 100644 (file)
@@ -51,15 +51,6 @@ Scalar-List-Utils cpan/Scalar-List-Utils/ListUtil.xs 6128584ecb0ae69bb21b16b22da
 Scalar-List-Utils cpan/Scalar-List-Utils/t/product.t 99bf424804f055b99ff2a18b7dcf25bb8b6d2463
 Socket cpan/Socket/Socket.pm 98e38176d745c38282907f391c077298f5a3d0ba
 Socket cpan/Socket/Socket.xs edd4fed212785f11c5c2095a75941dad27d586d9
-Win32API::File cpan/Win32API-File/buffers.h 02d230ac9ac7091365128161a0ed671898baefae
-Win32API::File cpan/Win32API-File/cFile.h fca7e383e76979c3ac3adf12d11d1bcd2618e489
-Win32API::File cpan/Win32API-File/cFile.pc 992421eea7782a5957b64f66764f6ffb5093bee4
-Win32API::File cpan/Win32API-File/const2perl.h 521a12d359f5efb68cf8abe1977689b640bc8b7d
-Win32API::File cpan/Win32API-File/ExtUtils/Myconst2perl.pm ce52544f49ac880e20b6171fe38f6560ed845e97
-Win32API::File cpan/Win32API-File/Makefile.PL 605d0aee31aebe84a99408f9ab5f644db57c61c6
-Win32API::File cpan/Win32API-File/t/file.t 124e64aa77e755235eb297644a87fac5388d3d78
-Win32API::File cpan/Win32API-File/t/tie.t 712ea7edd0cc805ce1c0b8172c01b03dd19b583d
-Win32API::File cpan/Win32API-File/typemap 24bff088babeadac0873e8df390d1666d9d9db4a
 autodie cpan/autodie/t/mkdir.t 9e70d2282a3cc7d76a78bf8144fccba20fb37dac
 version cpan/version/lib/version.pm c25428bcfe61db6ce0c264b3916d8ee7980c398c
 version vutil.c 8162dcb371f65863161f4e7f5513d2ebf4285f99
index 51f9584..9461bd8 100644 (file)
@@ -1604,6 +1604,7 @@ distclean: realclean
        -if exist $(LIBDIR)\Hash rmdir /s /q $(LIBDIR)\Hash
        -if exist $(LIBDIR)\HTTP rmdir /s /q $(LIBDIR)\HTTP
        -if exist $(LIBDIR)\I18N rmdir /s /q $(LIBDIR)\I18N
+       -if exist $(LIBDIR)\inc rmdir /s /q $(LIBDIR)\inc
        -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO
        -if exist $(LIBDIR)\IPC rmdir /s /q $(LIBDIR)\IPC
        -if exist $(LIBDIR)\JSON rmdir /s /q $(LIBDIR)\JSON
index 360c6ec..c73087a 100644 (file)
@@ -1277,6 +1277,7 @@ distclean: realclean
        -if exist $(LIBDIR)\Hash rmdir /s /q $(LIBDIR)\Hash
        -if exist $(LIBDIR)\HTTP rmdir /s /q $(LIBDIR)\HTTP
        -if exist $(LIBDIR)\I18N rmdir /s /q $(LIBDIR)\I18N
+       -if exist $(LIBDIR)\inc rmdir /s /q $(LIBDIR)\inc
        -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO
        -if exist $(LIBDIR)\IPC rmdir /s /q $(LIBDIR)\IPC
        -if exist $(LIBDIR)\JSON rmdir /s /q $(LIBDIR)\JSON
index 486e3f6..f74ad98 100644 (file)
@@ -1572,6 +1572,7 @@ distclean: realclean
        -if exist $(LIBDIR)\Hash rmdir /s /q $(LIBDIR)\Hash
        -if exist $(LIBDIR)\HTTP rmdir /s /q $(LIBDIR)\HTTP
        -if exist $(LIBDIR)\I18N rmdir /s /q $(LIBDIR)\I18N
+       -if exist $(LIBDIR)\inc rmdir /s /q $(LIBDIR)\inc
        -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO
        -if exist $(LIBDIR)\IPC rmdir /s /q $(LIBDIR)\IPC
        -if exist $(LIBDIR)\JSON rmdir /s /q $(LIBDIR)\JSON