From 78ff2d7be71ff9f6811d8b05bb66c4c4707951ba Mon Sep 17 00:00:00 2001 From: Yitzchak Scott-Thoennes Date: Mon, 19 Feb 2007 17:50:18 -0800 Subject: Re: Win32 modules & cygwin From: "Yitzchak Scott-Thoennes" Message-ID: <1254.67.42.109.122.1171965018.squirrel@67.42.109.122> Also includes integration & deletion of win32/ext/Win32API to ext/Win32API, and addition of copyright message and corrections to spacing/tabbing as suggested by Jan Dubois. p4raw-id: //depot/perl@30379 --- win32/FindExt.pm | 2 +- win32/Makefile | 12 +- win32/config_sh.PL | 2 +- win32/ext/Win32API/File/Changes | 103 - win32/ext/Win32API/File/ExtUtils/Myconst2perl.pm | 361 --- win32/ext/Win32API/File/File.pm | 3035 ---------------------- win32/ext/Win32API/File/File.xs | 647 ----- win32/ext/Win32API/File/Makefile.PL | 127 - win32/ext/Win32API/File/README | 133 - win32/ext/Win32API/File/buffers.h | 423 --- win32/ext/Win32API/File/cFile.h | 1 - win32/ext/Win32API/File/cFile.pc | 165 -- win32/ext/Win32API/File/const2perl.h | 193 -- win32/ext/Win32API/File/t/file.t | 408 --- win32/ext/Win32API/File/t/tie.t | 79 - win32/ext/Win32API/File/typemap | 140 - win32/makefile.mk | 12 +- win32/win32.c | 68 +- 18 files changed, 22 insertions(+), 5889 deletions(-) delete mode 100644 win32/ext/Win32API/File/Changes delete mode 100644 win32/ext/Win32API/File/ExtUtils/Myconst2perl.pm delete mode 100644 win32/ext/Win32API/File/File.pm delete mode 100644 win32/ext/Win32API/File/File.xs delete mode 100644 win32/ext/Win32API/File/Makefile.PL delete mode 100644 win32/ext/Win32API/File/README delete mode 100644 win32/ext/Win32API/File/buffers.h delete mode 100644 win32/ext/Win32API/File/cFile.h delete mode 100644 win32/ext/Win32API/File/cFile.pc delete mode 100644 win32/ext/Win32API/File/const2perl.h delete mode 100644 win32/ext/Win32API/File/t/file.t delete mode 100644 win32/ext/Win32API/File/t/tie.t delete mode 100644 win32/ext/Win32API/File/typemap (limited to 'win32') diff --git a/win32/FindExt.pm b/win32/FindExt.pm index eb0eb3b662..f0477b8846 100644 --- a/win32/FindExt.pm +++ b/win32/FindExt.pm @@ -82,7 +82,7 @@ sub find_ext closedir $dh; for my $xxx (@items) { if ($xxx ne "DynaLoader") { - if (-f "$xxx/$xxx.xs") { + if (-f "$xxx/$xxx.xs" || -f "$xxx/$xxx.c" ) { $ext{"$_[0]$xxx"} = $static{"$_[0]$xxx"} ? 'static' : 'dynamic'; } elsif (-f "$xxx/Makefile.PL") { $ext{"$_[0]$xxx"} = 'nonxs'; diff --git a/win32/Makefile b/win32/Makefile index 8299d1c9fa..71b99c3af8 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -771,7 +771,7 @@ SETARGV_OBJ = setargv$(o) # specify static extensions here #STATIC_EXT = Cwd Compress/Raw/Zlib -STATIC_EXT = +STATIC_EXT = Win32CORE DYNALOADER = $(EXTDIR)\DynaLoader\DynaLoader @@ -1005,26 +1005,26 @@ MakePPPort_clean: Extensions: buildext.pl $(PERLDEP) $(CONFIGPM) $(XCOPY) ..\*.h $(COREDIR)\*.* $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --dynamic - $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic + -if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic Extensions_reonly: buildext.pl $(PERLDEP) $(CONFIGPM) $(XCOPY) ..\*.h $(COREDIR)\*.* $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --dynamic +re - $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic +re + -if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic +re Extensions_static : buildext.pl $(PERLDEP) $(CONFIGPM) $(XCOPY) ..\*.h $(COREDIR)\*.* $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --static - $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --static + -if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --static $(MINIPERL) -I..\lib buildext.pl --list-static-libs > Extensions_static Extensions_clean: -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) clean - -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext clean + -if exist $(MINIPERL) if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext clean Extensions_realclean: -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) realclean - -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext realclean + -if exist $(MINIPERL) if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext realclean #------------------------------------------------------------------------------- diff --git a/win32/config_sh.PL b/win32/config_sh.PL index 884db4a537..98c01eb3c9 100644 --- a/win32/config_sh.PL +++ b/win32/config_sh.PL @@ -43,7 +43,7 @@ while (@{$optref} && $optref->[0] =~ /^([\w_]+)=(.*)$/) { } FindExt::scan_ext("../ext"); -FindExt::scan_ext("ext"); +FindExt::scan_ext("ext") if -d 'ext'; # also look in win32/ext/ if it exists FindExt::set_static_extensions(split ' ', $opt{'static_ext'}); my @dynamic_ext = grep(!/Thread/,FindExt::dynamic_ext()); diff --git a/win32/ext/Win32API/File/Changes b/win32/ext/Win32API/File/Changes deleted file mode 100644 index b63b2763da..0000000000 --- a/win32/ext/Win32API/File/Changes +++ /dev/null @@ -1,103 +0,0 @@ -Revision history for Perl extension Win32API::File. - -0.1001 2006-07-02 14:04 - - Minor doc tweak, release as standalone for sychronization with - with version in bleadperl (future 5.10) - -0.10 2005-09-09 - - Added GetFileAttributes() function and corresponding constants. - (Patches from Kenneth Olwing from 2004-11-12). - - cygwin patches from Rafael Kitover and Reini Urban. - This includes the addition of the GetFileSize(), getFileSize() - setFilePointer() and GetOverlappedResult() methods and the - experimental new object oriented interface. All file position - operations use either Math::BigInt objects or 8 byte integers - (cygwin) for file offsets. - -0.0901 2005-08-30 - - increased version number to show difference to standalone - CPAN release of Win32API-File-0.09.zip - -0.09 2005-02-18 - - Support 5.007+ - -0.09 [libwin32 version only] - - Add AUTHOR and ABSTRACT_FROM to Makefile.PL. - - Trivial speed improvements. - - Fixed F if Z: is a valid drive letter. - -0.08 2000-04-07 - - C now returns false for failure. - - New F supports C++ compilers. - - Read-only output-only parameters now generate an error. - - Added fileLastError() since C<$^E> is often quickly overwritten. - - Complete rewrite of how C constants are made available in Perl. - - Added fileConstant(), a nice way to look-up constants at run time. - - Added Get/SetHandleInformation and HANDLE_FLAG_* constants. - - Added IOCTL_DISK_GET_MEDIA_TYPES since *_STORAGE_* fails for floppy. - - Added several example scripts. - -0.07 1999-08-17 - - Added DeleteFile(). - - Removed prototypes from OsFHandleOpen() and GetOsFHandle() since - the C<*> doesn't prevent warnings about bareword file handles and - prevents the useful usage message if no arguments given. - - Fixed bug due to failed C<(/k/i,/t/i)> in list context returning - C<()> not C<(undef,undef)> in modern versions of Perl. - - Change order of C<#include>s so can build with Perl5.005 and later. - - Fixed C to ignore Perl bug where C<$^E> is truncated. - - Turned on C in C for certain versions of Perl. - - Updated C. - -0.06 1999-08-10 - - Switch to new buffers.h and "Hungarian" notation! - - Added full documentation! - - ReadFile() no longer tries to read more bytes than asked for - just because the scalar buffer can hold more bytes! - - createFile() does better DWIM for share mode. - - Return SV_NO rather than C<0> for Boolean false. - - For boolean args, non-empty strings are C<1>, don't convert to int. - - Added ":MEDIA_TYPE" export class. - - Added C and C to ":GENERIC_" exports. - - Added C and C! - - Added C and C! - - Support calling C without the useless integer argument. - - Auto-load/export constants with C<()> prototype so can be in-lined. - - Added C and C. - - Added C. - - Added ":FILE_" export class for specific types of access to files. - - Added C to ":SECURITY_" export class. - - Added ":PARTITION_" export class for partition types. - - Seriously bulked up the test suite. - -0.05 1998-08-21 - - "-w" no longer warns that a buffer size of "=99" "isn't numeric". - nor if pass undef var for buffer size or output-only parameter. - - Added SetErrorMode() and :SEM_. - - createFile() sharing now defaults to "rw" to match C RTL. - - createFile() was ignoring "r" and "w" in access masks. - -0.04 1998-08-13 - - Added GetLogicalDrives and GetLogicalDriveStrings. - - Added GetDriveType and GetVolumeInformation. - - Added DRIVE_* for GetDriveType(). - - Added FS_* for GetVolumeInformation(). - - Added createFile(), getLogicalDrives(), and attrLetsToBits() helpers. - - CreateFile() returns: INVALID_HANDLE_VALUE->false, 0->"0 but true". - - More standardized "Hungarian" notation and uses buffers.h. - - Large unsigned values no longer made negative. - -0.03 1998-04-25 - - Added DDD_* constants to File.pm and moved codes mistakenly - exported for :DDD_ to be exported for :Misc. - - Split large group of constants to increase efficiency. - - Minor cosmetic fixes. - -0.02 1998-03-03 - - Added DeviceIoControl(). - - Added some IOCTL_STORAGE_* and IOCTL_DISK_* constants - - Taught test.pl to verify all exported functions and constants. - -0.01 1997-12-08 - - original version; based on Win32API::Registry. - - release to partner diff --git a/win32/ext/Win32API/File/ExtUtils/Myconst2perl.pm b/win32/ext/Win32API/File/ExtUtils/Myconst2perl.pm deleted file mode 100644 index d4f936e107..0000000000 --- a/win32/ext/Win32API/File/ExtUtils/Myconst2perl.pm +++ /dev/null @@ -1,361 +0,0 @@ -# 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 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 Cing 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( ) { - $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( ) { - $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; diff --git a/win32/ext/Win32API/File/File.pm b/win32/ext/Win32API/File/File.pm deleted file mode 100644 index 74494fa7ec..0000000000 --- a/win32/ext/Win32API/File/File.pm +++ /dev/null @@ -1,3035 +0,0 @@ -# File.pm -- Low-level access to Win32 file/dir functions/constants. - -package Win32API::File; - -use strict; -use integer; -use Carp; -use Config qw( %Config ); -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.1001'; - -use base qw( Exporter DynaLoader Tie::Handle IO::File ); - -# Math::BigInt optimizations courtesy of Tels -BEGIN { - require Math::BigInt; - if (defined($Math::BigInt::VERSION) && $Math::BigInt::VERSION >= 1.60) { - Math::BigInt->import(lib => 'GMP'); - } -} - -my $_64BITINT = defined $Config{use64bitint} && - $Config{use64bitint} eq 'define'; - -my $THIRTY_TWO = $_64BITINT ? 32 : new Math::BigInt 32; - -my $FFFFFFFF = $_64BITINT ? 0xFFFFFFFF : new Math::BigInt 0xFFFFFFFF; - -@EXPORT= qw(); -%EXPORT_TAGS= ( - Func => [qw( attrLetsToBits createFile - fileConstant fileLastError getLogicalDrives - CloseHandle CopyFile CreateFile - DefineDosDevice DeleteFile DeviceIoControl - FdGetOsFHandle GetDriveType GetFileAttributes GetFileType - GetHandleInformation GetLogicalDrives GetLogicalDriveStrings - GetOsFHandle GetVolumeInformation IsRecognizedPartition - IsContainerPartition MoveFile MoveFileEx - OsFHandleOpen OsFHandleOpenFd QueryDosDevice - ReadFile SetErrorMode SetFilePointer - SetHandleInformation WriteFile GetFileSize - getFileSize setFilePointer GetOverlappedResult)], - FuncA => [qw( - CopyFileA CreateFileA DefineDosDeviceA - DeleteFileA GetDriveTypeA GetFileAttributesA GetLogicalDriveStringsA - GetVolumeInformationA MoveFileA MoveFileExA - QueryDosDeviceA )], - FuncW => [qw( - CopyFileW CreateFileW DefineDosDeviceW - DeleteFileW GetDriveTypeW GetFileAttributesW GetLogicalDriveStringsW - GetVolumeInformationW MoveFileW MoveFileExW - QueryDosDeviceW )], - Misc => [qw( - CREATE_ALWAYS CREATE_NEW FILE_BEGIN - FILE_CURRENT FILE_END INVALID_HANDLE_VALUE - OPEN_ALWAYS OPEN_EXISTING TRUNCATE_EXISTING )], - DDD_ => [qw( - DDD_EXACT_MATCH_ON_REMOVE DDD_RAW_TARGET_PATH - DDD_REMOVE_DEFINITION )], - DRIVE_ => [qw( - DRIVE_UNKNOWN DRIVE_NO_ROOT_DIR DRIVE_REMOVABLE - DRIVE_FIXED DRIVE_REMOTE DRIVE_CDROM - DRIVE_RAMDISK )], - FILE_ => [qw( - FILE_READ_DATA FILE_LIST_DIRECTORY - FILE_WRITE_DATA FILE_ADD_FILE - FILE_APPEND_DATA FILE_ADD_SUBDIRECTORY - FILE_CREATE_PIPE_INSTANCE FILE_READ_EA - FILE_WRITE_EA FILE_EXECUTE - FILE_TRAVERSE FILE_DELETE_CHILD - FILE_READ_ATTRIBUTES FILE_WRITE_ATTRIBUTES - FILE_ALL_ACCESS FILE_GENERIC_READ - FILE_GENERIC_WRITE FILE_GENERIC_EXECUTE )], - FILE_ATTRIBUTE_ => [qw( - INVALID_FILE_ATTRIBUTES - FILE_ATTRIBUTE_DEVICE FILE_ATTRIBUTE_DIRECTORY - FILE_ATTRIBUTE_ENCRYPTED FILE_ATTRIBUTE_NOT_CONTENT_INDEXED - FILE_ATTRIBUTE_REPARSE_POINT FILE_ATTRIBUTE_SPARSE_FILE - FILE_ATTRIBUTE_ARCHIVE FILE_ATTRIBUTE_COMPRESSED - FILE_ATTRIBUTE_HIDDEN FILE_ATTRIBUTE_NORMAL - FILE_ATTRIBUTE_OFFLINE FILE_ATTRIBUTE_READONLY - FILE_ATTRIBUTE_SYSTEM FILE_ATTRIBUTE_TEMPORARY )], - FILE_FLAG_ => [qw( - FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_DELETE_ON_CLOSE - FILE_FLAG_NO_BUFFERING FILE_FLAG_OVERLAPPED - FILE_FLAG_POSIX_SEMANTICS FILE_FLAG_RANDOM_ACCESS - FILE_FLAG_SEQUENTIAL_SCAN FILE_FLAG_WRITE_THROUGH - FILE_FLAG_OPEN_REPARSE_POINT )], - FILE_SHARE_ => [qw( - FILE_SHARE_DELETE FILE_SHARE_READ FILE_SHARE_WRITE )], - FILE_TYPE_ => [qw( - FILE_TYPE_CHAR FILE_TYPE_DISK FILE_TYPE_PIPE - FILE_TYPE_UNKNOWN )], - FS_ => [qw( - FS_CASE_IS_PRESERVED FS_CASE_SENSITIVE - FS_UNICODE_STORED_ON_DISK FS_PERSISTENT_ACLS - FS_FILE_COMPRESSION FS_VOL_IS_COMPRESSED )], - FSCTL_ => [qw( - FSCTL_SET_REPARSE_POINT FSCTL_GET_REPARSE_POINT - FSCTL_DELETE_REPARSE_POINT )], - HANDLE_FLAG_ => [qw( - HANDLE_FLAG_INHERIT HANDLE_FLAG_PROTECT_FROM_CLOSE )], - IOCTL_STORAGE_ => [qw( - IOCTL_STORAGE_CHECK_VERIFY IOCTL_STORAGE_MEDIA_REMOVAL - IOCTL_STORAGE_EJECT_MEDIA IOCTL_STORAGE_LOAD_MEDIA - IOCTL_STORAGE_RESERVE IOCTL_STORAGE_RELEASE - IOCTL_STORAGE_FIND_NEW_DEVICES IOCTL_STORAGE_GET_MEDIA_TYPES - )], - IOCTL_DISK_ => [qw( - IOCTL_DISK_FORMAT_TRACKS IOCTL_DISK_FORMAT_TRACKS_EX - IOCTL_DISK_GET_DRIVE_GEOMETRY IOCTL_DISK_GET_DRIVE_LAYOUT - IOCTL_DISK_GET_MEDIA_TYPES IOCTL_DISK_GET_PARTITION_INFO - IOCTL_DISK_HISTOGRAM_DATA IOCTL_DISK_HISTOGRAM_RESET - IOCTL_DISK_HISTOGRAM_STRUCTURE IOCTL_DISK_IS_WRITABLE - IOCTL_DISK_LOGGING IOCTL_DISK_PERFORMANCE - IOCTL_DISK_REASSIGN_BLOCKS IOCTL_DISK_REQUEST_DATA - IOCTL_DISK_REQUEST_STRUCTURE IOCTL_DISK_SET_DRIVE_LAYOUT - IOCTL_DISK_SET_PARTITION_INFO IOCTL_DISK_VERIFY )], - GENERIC_ => [qw( - GENERIC_ALL GENERIC_EXECUTE - GENERIC_READ GENERIC_WRITE )], - MEDIA_TYPE => [qw( - Unknown F5_1Pt2_512 F3_1Pt44_512 - F3_2Pt88_512 F3_20Pt8_512 F3_720_512 - F5_360_512 F5_320_512 F5_320_1024 - F5_180_512 F5_160_512 RemovableMedia - FixedMedia F3_120M_512 )], - MOVEFILE_ => [qw( - MOVEFILE_COPY_ALLOWED MOVEFILE_DELAY_UNTIL_REBOOT - MOVEFILE_REPLACE_EXISTING MOVEFILE_WRITE_THROUGH )], - SECURITY_ => [qw( - SECURITY_ANONYMOUS SECURITY_CONTEXT_TRACKING - SECURITY_DELEGATION SECURITY_EFFECTIVE_ONLY - SECURITY_IDENTIFICATION SECURITY_IMPERSONATION - SECURITY_SQOS_PRESENT )], - SEM_ => [qw( - SEM_FAILCRITICALERRORS SEM_NOGPFAULTERRORBOX - SEM_NOALIGNMENTFAULTEXCEPT SEM_NOOPENFILEERRORBOX )], - PARTITION_ => [qw( - PARTITION_ENTRY_UNUSED PARTITION_FAT_12 - PARTITION_XENIX_1 PARTITION_XENIX_2 - PARTITION_FAT_16 PARTITION_EXTENDED - PARTITION_HUGE PARTITION_IFS - PARTITION_FAT32 PARTITION_FAT32_XINT13 - PARTITION_XINT13 PARTITION_XINT13_EXTENDED - PARTITION_PREP PARTITION_UNIX - VALID_NTFT PARTITION_NTFT )], -); -@EXPORT_OK= (); -{ - my $key; - foreach $key ( keys(%EXPORT_TAGS) ) { - push( @EXPORT_OK, @{$EXPORT_TAGS{$key}} ); - #push( @EXPORT_FAIL, @{$EXPORT_TAGS{$key}} ) unless $key =~ /^Func/; - } -} -$EXPORT_TAGS{ALL}= \@EXPORT_OK; - -bootstrap Win32API::File $VERSION; - -# Preloaded methods go here. - -# To convert C constants to Perl code in cFile.pc -# [instead of C or C++ code in cFile.h]: -# * Modify F to add WriteMakeFile() => -# CONST2PERL/postamble => [[ "Win32API::File" => ]] WRITE_PERL => 1. -# * Either comment out C<#include "cFile.h"> from F -# or make F an empty file. -# * Make sure the following C block is not commented out. -# * "nmake clean", "perl Makefile.PL", "nmake" - -if( ! defined &GENERIC_READ ) { - require "Win32API/File/cFile.pc"; -} - -sub fileConstant -{ - my( $name )= @_; - if( 1 != @_ || ! $name || $name =~ /\W/ ) { - require Carp; - Carp::croak( 'Usage: ',__PACKAGE__,'::fileConstant("CONST_NAME")' ); - } - my $proto= prototype $name; - if( defined \&$name - && defined $proto - && "" eq $proto ) { - no strict 'refs'; - return &$name; - } - return undef; -} - -# We provide this for backwards compatibility: -sub constant -{ - my( $name )= @_; - my $value= fileConstant( $name ); - if( defined $value ) { - $!= 0; - return $value; - } - $!= 11; # EINVAL - return 0; -} - -# BEGIN { -# my $code= 'return _fileLastError(@_)'; -# local( $!, $^E )= ( 1, 1 ); -# if( $! ne $^E ) { -# $code= ' -# local( $^E )= _fileLastError(@_); -# my $ret= $^E; -# return $ret; -# '; -# } -# eval "sub fileLastError { $code }"; -# die "$@" if $@; -# } - -package Win32API::File::_error; - -use overload - '""' => sub { - require Win32 unless defined &Win32::FormatMessage; - $_ = Win32::FormatMessage(Win32API::File::_fileLastError()); - tr/\r\n//d; - return $_; - }, - '0+' => sub { Win32API::File::_fileLastError() }, - 'fallback' => 1; - -sub new { return bless {}, shift } -sub set { Win32API::File::_fileLastError($_[1]); return $_[0] } - -package Win32API::File; - -my $_error = new Win32API::File::_error; - -sub fileLastError { - croak 'Usage: ',__PACKAGE__,'::fileLastError( [$setWin32ErrCode] )' if @_ > 1; - $_error->set($_[0]) if defined $_[0]; - return $_error; -} - -# Since we ISA DynaLoader which ISA AutoLoader, we ISA AutoLoader so we -# need this next chunk to prevent Win32API::File->nonesuch() from -# looking for "nonesuch.al" and producing confusing error messages: -use vars qw($AUTOLOAD); -sub AUTOLOAD { - require Carp; - Carp::croak( - "Can't locate method $AUTOLOAD via package Win32API::File" ); -} - -# Replace "&rout;" with "goto &rout;" when that is supported on Win32. - -# Aliases for non-Unicode functions: -sub CopyFile { &CopyFileA; } -sub CreateFile { &CreateFileA; } -sub DefineDosDevice { &DefineDosDeviceA; } -sub DeleteFile { &DeleteFileA; } -sub GetDriveType { &GetDriveTypeA; } -sub GetFileAttributes { &GetFileAttributesA; } -sub GetLogicalDriveStrings { &GetLogicalDriveStringsA; } -sub GetVolumeInformation { &GetVolumeInformationA; } -sub MoveFile { &MoveFileA; } -sub MoveFileEx { &MoveFileExA; } -sub QueryDosDevice { &QueryDosDeviceA; } - -sub OsFHandleOpen { - if( 3 != @_ ) { - croak 'Win32API::File Usage: ', - 'OsFHandleOpen(FILE,$hNativeHandle,"rwatb")'; - } - my( $fh, $osfh, $access )= @_; - if( ! ref($fh) ) { - if( $fh !~ /('|::)/ ) { - $fh= caller() . "::" . $fh; - } - no strict "refs"; - $fh= \*{$fh}; - } - my( $mode, $pref ); - if( $access =~ /r/i ) { - if( $access =~ /w/i ) { - $mode= O_RDWR; - $pref= "+<"; - } else { - $mode= O_RDONLY; - $pref= "<"; - } - } else { - if( $access =~ /w/i ) { - $mode= O_WRONLY; - $pref= ">"; - } else { - # croak qq, - # qq; - $mode= O_RDONLY; - $pref= "<"; - } - } - $mode |= O_APPEND if $access =~ /a/i; - #$mode |= O_TEXT if $access =~ /t/i; - # Some versions of the Fcntl module are broken and won't autoload O_TEXT: - if( $access =~ /t/i ) { - my $o_text= eval "O_TEXT"; - $o_text= 0x4000 if $@; - $mode |= $o_text; - } - $mode |= O_BINARY if $access =~ /b/i; - my $fd = eval { OsFHandleOpenFd( $osfh, $mode ) }; - if ($@) { - return tie *{$fh}, __PACKAGE__, $osfh; - } - return undef if $fd < 0; - return open( $fh, $pref."&=".$fd ); -} - -sub GetOsFHandle { - if( 1 != @_ ) { - croak 'Win32API::File Usage: $OsFHandle= GetOsFHandle(FILE)'; - } - my( $file )= @_; - if( ! ref($file) ) { - if( $file !~ /('|::)/ ) { - $file= caller() . "::" . $file; - } - no strict "refs"; - # The eval "" is necessary in Perl 5.6, avoid it otherwise. - my $tied = !defined($^]) || $^] < 5.008 - ? eval "tied *{$file}" - : tied *{$file}; - - if (UNIVERSAL::isa($tied => __PACKAGE__)) { - return $tied->win32_handle; - } - - $file= *{$file}; - } - my( $fd )= fileno($file); - if( ! defined( $fd ) ) { - if( $file =~ /^\d+\Z/ ) { - $fd= $file; - } else { - return (); # $! should be set by fileno(). - } - } - my $h= FdGetOsFHandle( $fd ); - if( INVALID_HANDLE_VALUE() == $h ) { - $h= ""; - } elsif( "0" eq $h ) { - $h= "0 but true"; - } - return $h; -} - -sub getFileSize { - croak 'Win32API::File Usage: $size= getFileSize($hNativeHandle)' - if @_ != 1; - - my $handle = shift; - my $high_size = 0; - - my $low_size = GetFileSize($handle, $high_size); - - my $retval = $_64BITINT ? $high_size : new Math::BigInt $high_size; - - $retval <<= $THIRTY_TWO; - $retval += $low_size; - - return $retval; -} - -sub setFilePointer { - croak 'Win32API::File Usage: $pos= setFilePointer($hNativeHandle, $posl, $from_where)' - if @_ != 3; - - my ($handle, $pos, $from_where) = @_; - - my ($pos_low, $pos_high) = ($pos, 0); - - if ($_64BITINT) { - $pos_low = ($pos & $FFFFFFFF); - $pos_high = (($pos >> $THIRTY_TWO) & $FFFFFFFF); - } - elsif (UNIVERSAL::isa($pos => 'Math::BigInt')) { - $pos_low = ($pos & $FFFFFFFF)->numify(); - $pos_high = (($pos >> $THIRTY_TWO) & $FFFFFFFF)->numify(); - } - - my $retval = SetFilePointer($handle, $pos_low, $pos_high, $from_where); - - if (defined $pos_high && $pos_high != 0) { - $retval = new Math::BigInt $retval unless $_64BITINT; - $pos_high = new Math::BigInt $pos_high unless $_64BITINT; - - $retval += $pos_high << $THIRTY_TWO; - } - - return $retval; -} - -sub attrLetsToBits -{ - my( $lets )= @_; - my( %a )= ( - "a"=>FILE_ATTRIBUTE_ARCHIVE(), "c"=>FILE_ATTRIBUTE_COMPRESSED(), - "h"=>FILE_ATTRIBUTE_HIDDEN(), "o"=>FILE_ATTRIBUTE_OFFLINE(), - "r"=>FILE_ATTRIBUTE_READONLY(), "s"=>FILE_ATTRIBUTE_SYSTEM(), - "t"=>FILE_ATTRIBUTE_TEMPORARY() ); - my( $bits )= 0; - foreach( split(//,$lets) ) { - croak "Win32API::File::attrLetsToBits: Unknown attribute letter ($_)" - unless exists $a{$_}; - $bits |= $a{$_}; - } - return $bits; -} - -use vars qw( @_createFile_Opts %_createFile_Opts ); -@_createFile_Opts= qw( Access Create Share Attributes - Flags Security Model ); -@_createFile_Opts{@_createFile_Opts}= (1) x @_createFile_Opts; - -sub createFile -{ - my $opts= ""; - if( 2 <= @_ && "HASH" eq ref($_[$#_]) ) { - $opts= pop( @_ ); - } - my( $sPath, $svAccess, $svShare )= @_; - if( @_ < 1 || 3 < @_ ) { - croak "Win32API::File::createFile() usage: \$hObject= createFile(\n", - " \$sPath, [\$svAccess_qrw_ktn_ce,[\$svShare_rwd,]]", - " [{Option=>\$Value}] )\n", - " options: @_createFile_Opts\nCalled"; - } - my( $create, $flags, $sec, $model )= ( "", 0, [], 0 ); - if( ref($opts) ) { - my @err= grep( ! $_createFile_Opts{$_}, keys(%$opts) ); - @err and croak "_createFile: Invalid options (@err)"; - $flags= $opts->{Flags} if exists( $opts->{Flags} ); - $flags |= attrLetsToBits( $opts->{Attributes} ) - if exists( $opts->{Attributes} ); - $sec= $opts->{Security} if exists( $opts->{Security} ); - $model= $opts->{Model} if exists( $opts->{Model} ); - $svAccess= $opts->{Access} if exists( $opts->{Access} ); - $create= $opts->{Create} if exists( $opts->{Create} ); - $svShare= $opts->{Share} if exists( $opts->{Share} ); - } - $svAccess= "r" unless defined($svAccess); - $svShare= "rw" unless defined($svShare); - if( $svAccess =~ /^[qrw ktn ce]*$/i ) { - ( my $c= $svAccess ) =~ tr/qrw QRW//d; - $create= $c if "" ne $c && "" eq $create; - local( $_ )= $svAccess; - $svAccess= 0; - $svAccess |= GENERIC_READ() if /r/i; - $svAccess |= GENERIC_WRITE() if /w/i; - } elsif( "?" eq $svAccess ) { - croak - "Win32API::File::createFile: \$svAccess can use the following:\n", - " One or more of the following:\n", - "\tq -- Query access (same as 0)\n", - "\tr -- Read access (GENERIC_READ)\n", - "\tw -- Write access (GENERIC_WRITE)\n", - " At most one of the following:\n", - "\tk -- Keep if exists\n", - "\tt -- Truncate if exists\n", - "\tn -- New file only (fail if file already exists)\n", - " At most one of the following:\n", - "\tc -- Create if doesn't exist\n", - "\te -- Existing file only (fail if doesn't exist)\n", - " '' is the same as 'q k e'\n", - " 'r' is the same as 'r k e'\n", - " 'w' is the same as 'w t c'\n", - " 'rw' is the same as 'rw k c'\n", - " 'rt' or 'rn' implies 'c'.\n", - " Or \$svAccess can be numeric.\n", "Called from"; - } elsif( $svAccess == 0 && $svAccess !~ /^[-+.]*0/ ) { - croak "Win32API::File::createFile: Invalid \$svAccess ($svAccess)"; - } - if( $create =~ /^[ktn ce]*$/ ) { - local( $_ )= $create; - my( $k, $t, $n, $c, $e )= ( scalar(/k/i), scalar(/t/i), - scalar(/n/i), scalar(/c/i), scalar(/e/i) ); - if( 1 < $k + $t + $n ) { - croak "Win32API::File::createFile: \$create must not use ", - qq; - } - if( $c && $e ) { - croak "Win32API::File::createFile: \$create must not use ", - qq; - } - my $r= ( $svAccess & GENERIC_READ() ) == GENERIC_READ(); - my $w= ( $svAccess & GENERIC_WRITE() ) == GENERIC_WRITE(); - if( ! $k && ! $t && ! $n ) { - if( $w && ! $r ) { $t= 1; - } else { $k= 1; } - } - if( $k ) { - if( $c || $w && ! $e ) { $create= OPEN_ALWAYS(); - } else { $create= OPEN_EXISTING(); } - } elsif( $t ) { - if( $e ) { $create= TRUNCATE_EXISTING(); - } else { $create= CREATE_ALWAYS(); } - } else { # $n - if( ! $e ) { $create= CREATE_NEW(); - } else { - croak "Win32API::File::createFile: \$create must not use ", - qq; - } - } - } elsif( "?" eq $create ) { - croak 'Win32API::File::createFile: $create !~ /^[ktn ce]*$/;', - ' pass $svAccess as "?" for more information.'; - } elsif( $create == 0 && $create ne "0" ) { - croak "Win32API::File::createFile: Invalid \$create ($create)"; - } - if( $svShare =~ /^[drw]*$/ ) { - my %s= ( "d"=>FILE_SHARE_DELETE(), "r"=>FILE_SHARE_READ(), - "w"=>FILE_SHARE_WRITE() ); - my @s= split(//,$svShare); - $svShare= 0; - foreach( @s ) { - $svShare |= $s{$_}; - } - } elsif( $svShare == 0 && $svShare !~ /^[-+.]*0/ ) { - croak "Win32API::File::createFile: Invalid \$svShare ($svShare)"; - } - return CreateFileA( - $sPath, $svAccess, $svShare, $sec, $create, $flags, $model ); -} - - -sub getLogicalDrives -{ - my( $ref )= @_; - my $s= ""; - if( ! GetLogicalDriveStringsA( 256, $s ) ) { - return undef; - } - if( ! defined($ref) ) { - return split( /\0/, $s ); - } elsif( "ARRAY" ne ref($ref) ) { - croak 'Usage: C<@arr= getLogicalDrives()> ', - 'or C', "\n"; - } - @$ref= split( /\0/, $s ); - return $ref; -} - -############################################################################### -# Experimental Tied Handle and Object Oriented interface. # -############################################################################### - -sub new { - my $class = shift; - $class = ref $class || $class; - - my $self = IO::File::new($class); - tie *$self, __PACKAGE__; - - $self->open(@_) if @_; - - return $self; -} - -sub TIEHANDLE { - my ($class, $win32_handle) = @_; - $class = ref $class || $class; - - return bless { - _win32_handle => $win32_handle, - _binmode => 0, - _buffered => 0, - _buffer => '', - _eof => 0, - _fileno => undef, - _access => 'r', - _append => 0, - }, $class; -} - -# This is called for getting the tied object from hard refs to glob refs in -# some cases, for reasons I don't quite grok. - -sub FETCH { return $_[0] } - -# Public accessors - -sub win32_handle{ $_[0]->{_win32_handle}||= $_[1] } - -# Protected accessors - -sub _buffer { $_[0]->{_buffer} ||= $_[1] } -sub _binmode { $_[0]->{_binmode} ||= $_[1] } -sub _fileno { $_[0]->{_fileno} ||= $_[1] } -sub _access { $_[0]->{_access} ||= $_[1] } -sub _append { $_[0]->{_append} ||= $_[1] } - -# Tie interface - -sub OPEN { - my $self = shift; - my $expr = shift; - croak "Only the two argument form of open is supported at this time" if @_; -# FIXME: this needs to parse the full Perl open syntax in $expr - - my ($mixed, $mode, $path) = - ($expr =~ /^\s* (\+)? \s* (<|>|>>)? \s* (.*?) \s*$/x); - - croak "Unsupported open mode" if not $path; - - my $access = 'r'; - my $append = $mode eq '>>' ? 1 : 0; - - if ($mixed) { - $access = 'rw'; - } elsif($mode eq '>') { - $access = 'w'; - } - - my $w32_handle = createFile($path, $access); - - $self->win32_handle($w32_handle); - - $self->seek(1,2) if $append; - - $self->_access($access); - $self->_append($append); - - return 1; -} - -sub BINMODE { - $_[0]->_binmode(1); -} - -sub WRITE { - my ($self, $buf, $len, $offset, $overlap) = @_; - - if ($offset) { - $buf = substr($buf, $offset); - $len = length($buf); - } - - $len = length($buf) if not defined $len; - - $overlap = [] if not defined $overlap;; - - my $bytes_written = 0; - - WriteFile ( - $self->win32_handle, $buf, $len, - $bytes_written, $overlap - ); - - return $bytes_written; -} - -sub PRINT { - my $self = shift; - - my $buf = join defined $, ? $, : "" => @_; - - $buf =~ s/\012/\015\012/sg unless $self->_binmode(); - - $buf .= $\ if defined $\; - - $self->WRITE($buf, length($buf), 0); -} - -sub READ { - my $self = shift; - my $into = \$_[0]; shift; - my ($len, $offset, $overlap) = @_; - - my $buffer = defined $self->_buffer ? $self->_buffer : ""; - my $buf_length = length($buffer); - my $bytes_read = 0; - my $data; - $offset = 0 if not defined $offset; - - if ($buf_length >= $len) { - $data = substr($buffer, 0, $len => ""); - $bytes_read = $len; - $self->_buffer($buffer); - } else { - if ($buf_length > 0) { - $len -= $buf_length; - substr($$into, $offset) = $buffer; - $offset += $buf_length; - } - - $overlap ||= []; - - ReadFile ( - $self->win32_handle, $data, $len, - $bytes_read, $overlap - ); - } - - $$into = "" if not defined $$into; - - substr($$into, $offset) = $data; - - return $bytes_read; -} - -sub READLINE { - my $self = shift; - my $line = ""; - - while ((index $line, $/) == $[-1) { # read until end of line marker - my $char = $self->GETC(); - - last if !defined $char || $char eq ''; - - $line .= $char; - } - - return undef if $line eq ''; - - return $line; -} - - -sub FILENO { - my $self = shift; - - return $self->_fileno() if defined $self->_fileno(); - - return -1 if $^O eq 'cygwin'; - -# FIXME: We don't always open the handle, better to query the handle or to set -# the right access info at TIEHANDLE time. - - my $access = $self->_access(); - my $mode = $access eq 'rw' ? O_RDWR : - $access eq 'w' ? O_WRONLY : O_RDONLY; - - $mode |= O_APPEND if $self->_append(); - - $mode |= O_TEXT if not $self->_binmode(); - - return $self->_fileno ( OsfHandleOpenFd ( - $self->win32_handle, $mode - )); -} - -sub SEEK { - my ($self, $pos, $whence) = @_; - - $whence = 0 if not defined $whence; - my @file_consts = map { - fileConstant($_) - } qw(FILE_BEGIN FILE_CURRENT FILE_END); - - my $from_where = $file_consts[$whence]; - - return setFilePointer($self->win32_handle, $pos, $from_where); -} - -sub TELL { -# SetFilePointer with position 0 at FILE_CURRENT will return position. - return $_[0]->SEEK(0, 1); -} - -sub EOF { - my $self = shift; - - my $current = $self->TELL() + 0; - my $end = getFileSize($self->win32_handle) + 0; - - return $current == $end; -} - -sub CLOSE { - my $self = shift; - - my $retval = 1; - - if (defined $self->win32_handle) { - $retval = CloseHandle($self->win32_handle); - - $self->win32_handle(undef); - } - - return $retval; -} - -# Only close the handle on explicit close, too many problems otherwise. -sub UNTIE {} - -sub DESTROY {} - -# End of Tie/OO Interface - -# Autoload methods go after =cut, and are processed by the autosplit program. - -1; -__END__ - -=head1 NAME - -Win32API::File - Low-level access to Win32 system API calls for files/dirs. - -=head1 SYNOPSIS - - use Win32API::File 0.08 qw( :ALL ); - - MoveFile( $Source, $Destination ) - or die "Can't move $Source to $Destination: ",fileLastError(),"\n"; - MoveFileEx( $Source, $Destination, MOVEFILE_REPLACE_EXISTING() ) - or die "Can't move $Source to $Destination: ",fileLastError(),"\n"; - [...] - -=head1 DESCRIPTION - -This provides fairly low-level access to the Win32 System API -calls dealing with files and directories. - -To pass in C as the pointer to an optional buffer, pass in -an empty list reference, C<[]>. - -Beyond raw access to the API calls and related constants, this module -handles smart buffer allocation and translation of return codes. - -All functions, unless otherwise noted, return a true value for success -and a false value for failure and set C<$^E> on failure. - -=head2 Object Oriented/Tied Handle Interface - -WARNING: this is new code, use at your own risk. - -This version of C can be used like an C object: - - my $file = new Win32API::File "+> foo"; - binmode $file; - print $file "hello there\n"; - seek $file, 0, 0; - my $line = <$file>; - $file->close; - -It also supports tying via a win32 handle (for example, from C): - - tie FILE, 'Win32API::File', $win32_handle; - print FILE "..."; - -It has not been extensively tested yet and buffered I/O is not yet implemented. - -=head2 Exports - -Nothing is exported by default. The following tags can be used to -have large sets of symbols exported: C<":Func">, C<":FuncA">, -C<":FuncW">, C<":Misc">, C<":DDD_">, C<":DRIVE_">, C<":FILE_">, -C<":FILE_ATTRIBUTE_">, C<":FILE_FLAG_">, C<":FILE_SHARE_">, -C<":FILE_TYPE_">, C<":FS_">, C<":FSCTL_">, C<":HANDLE_FLAG_">, -C<":IOCTL_STORAGE_">, C<":IOCTL_DISK_">, C<":GENERIC_">, -C<":MEDIA_TYPE">, C<":MOVEFILE_">, C<":SECURITY_">, C<":SEM_">, -and C<":PARTITION_">. - -=over - -=item C<":Func"> - -The basic function names: C, C, -C, C, C, -C, C, -C, C, C, -C, C, C, -C, C, C, -C, C, C, -C, C, C, -C, C, C, -C, C, C, -C, C, C, -C, C, C, -C, and C. - -=over - -=item attrLetsToBits - -=item C<$uBits= attrLetsToBits( $sAttributeLetters )> - -Converts a string of file attribute letters into an unsigned value with -the corresponding bits set. C<$sAttributeLetters> should contain zero -or more letters from C<"achorst">: - -=over - -=item C<"a"> - -C - -=item C<"c"> - -C - -=item C<"h"> - -C - -=item C<"o"> - -C - -=item C<"r"> - -C - -=item C<"s"> - -C - -=item C<"t"> - -C - -=back - -=item createFile - -=item C<$hObject= createFile( $sPath )> - -=item C<$hObject= createFile( $sPath, $rvhvOptions )> - -=item C<$hObject= createFile( $sPath, $svAccess )> - -=item C<$hObject= createFile( $sPath, $svAccess, $rvhvOptions )> - -=item C<$hObject= createFile( $sPath, $svAccess, $svShare )> - -=item C<$hObject= createFile( $sPath, $svAccess, $svShare, $rvhvOptions )> - -This is a Perl-friendly wrapper around C. - -On failure, C<$hObject> gets set to a false value and C -and C<$^E> are set to the reason for the failure. Otherwise, -C<$hObject> gets set to a Win32 native file handle which is alwasy -a true value [returns C<"0 but true"> in the impossible(?) case of -the handle having a value of C<0>]. - -C<$sPath> is the path to the file [or device, etc.] to be opened. See -C for more information on possible special values for -C<$sPath>. - -C<$svAccess> can be a number containing the bit mask representing -the specific type(s) of access to the file that you desire. See the -C<$uAccess> parameter to C for more information on these -values. - -More likely, C<$svAccess> is a string describing the generic type of -access you desire and possibly the file creation options to use. In -this case, C<$svAccess> should contain zero or more characters from -C<"qrw"> [access desired], zero or one character each from C<"ktn"> -and C<"ce">, and optional white space. These letters stand for, -respectively, "Query access", "Read access", "Write access", "Keep if -exists", "Truncate if exists", "New file only", "Create if none", and -"Existing file only". Case is ignored. - -You can pass in C<"?"> for C<$svAccess> to have an error message -displayed summarizing its possible values. This is very handy when -doing on-the-fly programming using the Perl debugger: - - Win32API::File::createFile: $svAccess can use the following: - One or more of the following: - q -- Query access (same as 0) - r -- Read access (GENERIC_READ) - w -- Write access (GENERIC_WRITE) - At most one of the following: - k -- Keep if exists - t -- Truncate if exists - n -- New file only (fail if file already exists) - At most one of the following: - c -- Create if doesn't exist - e -- Existing file only (fail if doesn't exist) - '' is the same as 'q k e' - 'r' is the same as 'r k e' - 'w' is the same as 'w t c' - 'rw' is the same as 'rw k c' - 'rt' or 'rn' implies 'c'. - Or $access can be numeric. - -C<$svAccess> is designed to be "do what I mean", so you can skip -the rest of its explanation unless you are interested in the complex -details. Note that, if you want write access to a device, you need -to specify C<"k"> [and perhaps C<"e">, as in C<"w ke"> or C<"rw ke">] -since Win32 suggests C be used when opening a device. - -=over - -=item C<"q"> - -Stands for "Query access". This is really a no-op since you always have -query access when you open a file. You can specify C<"q"> to document -that you plan to query the file [or device, etc.]. This is especially -helpful when you don't want read nor write access since something like -C<"q"> or C<"q ke"> may be easier to understand than just C<""> or C<"ke">. - -=item C<"r"> - -Stands for "Read access". Sets the C bit(s) in the -C<$uAccess> that is passed to C. This is the default -access if the C<$svAccess> parameter is missing [or if it is C -and C<$rvhvOptions> doesn't specify an C<"Access"> option]. - -=item C<"w"> - -Stands for "Write access". Sets the C bit(s) in the -C<$uAccess> that is passed to C. - -=item C<"k"> - -Stands for "Keep if exists". If the requested file exists, then it is -opened. This is the default unless C access has been -requested but C access has not been requested. Contrast -with C<"t"> and C<"n">. - -=item C<"t"> - -Stands for "Truncate if exists". If the requested file exists, then -it is truncated to zero length and then opened. This is the default if -C access has been requested and C access -has not been requested. Contrast with C<"k"> and C<"n">. - -=item C<"n"> - -Stands for "New file only". If the requested file exists, then it is -not opened and the C call fails. Contrast with C<"k"> and -C<"t">. Can't be used with C<"e">. - -=item C<"c"> - -Stands for "Create if none". If the requested file does not -exist, then it is created and then opened. This is the default -if C access has been requested or if C<"t"> or -C<"n"> was specified. Contrast with C<"e">. - -=item C<"e"> - -Stands for "Existing file only". If the requested file does not -exist, then nothing is opened and the C call fails. This -is the default unless C access has been requested or -C<"t"> or C<"n"> was specified. Contrast with C<"c">. Can't be -used with C<"n">. - -=back - -The characters from C<"ktn"> and C<"ce"> are combined to determine the -what value for C<$uCreate> to pass to C [unless overridden -by C<$rvhvOptions>]: - -=over - -=item C<"kc"> - -C - -=item C<"ke"> - -C - -=item C<"tc"> - -C - -=item C<"te"> - -C - -=item C<"nc"> - -C - -=item C<"ne"> - -Illegal. - -=back - -C<$svShare> controls how the file is shared, that is, whether other -processes can have read, write, and/or delete access to the file while -we have it opened. C<$svShare> will usually be a string containing zero -or more characters from C<"rwd"> but can also be a numeric bit mask. - -C<"r"> sets the C bit which allows other processes to have -read access to the file. C<"w"> sets the C bit which -allows other processes to have write access to the file. C<"d"> sets the -C bit which allows other processes to have delete access -to the file [ignored under Windows 95]. - -The default for C<$svShare> is C<"rw"> which provides the same sharing as -using regular perl C. - -If another process currently has read, write, and/or delete access to -the file and you don't allow that level of sharing, then your call to -C will fail. If you requested read, write, and/or delete -access and another process already has the file open but doesn't allow -that level of sharing, then your call to C will fail. Once -you have the file open, if another process tries to open it with read, -write, and/or delete access and you don't allow that level of sharing, -then that process won't be allowed to open the file. - -C<$rvhvOptions> is a reference to a hash where any keys must be from -the list C. -The meaning of the value depends on the key name, as described below. -Any option values in C<$rvhvOptions> override the settings from -C<$svAccess> and C<$svShare> if they conflict. - -=over - -=item Flags => $uFlags - -C<$uFlags> is an unsigned value having any of the C or -C bits set. Any C bits set via the -C option are logically Ced with these bits. Defaults -to C<0>. - -If opening the client side of a named pipe, then you can also specify -C along with one of the other C -constants to specify the security quality of service to be used. - -=item Attributes => $sAttributes - -A string of zero or more characters from C<"achorst"> [see C -for more information] which are converted to C bits to -be set in the C<$uFlags> argument passed to C. - -=item Security => $pSecurityAttributes - -C<$pSecurityAttributes> should contain a C structure -packed into a string or C<[]> [the default]. - -=item Model => $hModelFile - -C<$hModelFile> should contain a handle opened with C -access to a model file from which file attributes and extended attributes -are to be copied. Or C<$hModelFile> can be C<0> [the default]. - -=item Access => $sAccess - -=item Access => $uAccess - -C<$sAccess> should be a string of zero or more characters from -C<"qrw"> specifying the type of access desired: "query" or C<0>, -"read" or C [the default], or "write" or -C. - -C<$uAccess> should be an unsigned value containing bits set to -indicate the type of access desired. C is the default. - -=item Create => $sCreate - -=item Create => $uCreate - -C<$sCreate> should be a string constaing zero or one character from -C<"ktn"> and zero or one character from C<"ce">. These stand for -"Keep if exists", "Truncate if exists", "New file only", "Create if -none", and "Existing file only". These are translated into a -C<$uCreate> value. - -C<$uCreate> should be one of C, C, -C, C, or C. - -=item Share => $sShare - -=item Share => $uShare - -C<$sShare> should be a string with zero or more characters from -C<"rwd"> that is translated into a C<$uShare> value. C<"rw"> is -the default. - -C<$uShare> should be an unsigned value having zero or more of the -following bits set: C, C, and -C. C is the -default. - -=back - -Examples: - - $hFlop= createFile( "//./A:", "r", "r" ) - or die "Can't prevent others from writing to floppy: $^E\n"; - $hDisk= createFile( "//./C:", "rw ke", "" ) - or die "Can't get exclusive access to C: $^E\n"; - $hDisk= createFile( $sFilePath, "ke", - { Access=>FILE_READ_ATTRIBUTES } ) - or die "Can't read attributes of $sFilePath: $^E\n"; - $hTemp= createFile( "$ENV{Temp}/temp.$$", "wn", "", - { Attributes=>"hst", Flags=>FILE_FLAG_DELETE_ON_CLOSE() } ) - or die "Can't create temporary file, temp.$$: $^E\n"; - -=item getLogicalDrives - -=item C<@roots= getLogicalDrives()> - -Returns the paths to the root directories of all logical drives -currently defined. This includes all types of drive lettters, such -as floppies, CD-ROMs, hard disks, and network shares. A typical -return value on a poorly equipped computer would be C<("A:\\","C:\\")>. - -=item CloseHandle - -=item C - -Closes a Win32 native handle, such as one opened via C. -Like most routines, returns a true value if successful and a false -value [and sets C<$^E> and C] on failure. - -=item CopyFile - -=item C - -C<$sOldFileName> is the path to the file to be copied. -C<$sNewFileName> is the path to where the file should be copied. -Note that you can B just specify a path to a directory in -C<$sNewFileName> to copy the file to that directory using the -same file name. - -If C<$bFailIfExists> is true and C<$sNewFileName> is the path to -a file that already exists, then C will fail. If -C<$bFailIfExists> is falsea, then the copy of the C<$sOldFileNmae> -file will overwrite the C<$sNewFileName> file if it already exists. - -Like most routines, returns a true value if successful and a false -value [and sets C<$^E> and C] on failure. - -=item CreateFile - -=item C<$hObject= CreateFile( $sPath, $uAccess, $uShare, $pSecAttr, $uCreate, $uFlags, $hModel )> - -On failure, C<$hObject> gets set to a false value and C<$^E> and -C are set to the reason for the failure. Otherwise, -C<$hObject> gets set to a Win32 native file handle which is always a -true value [returns C<"0 but true"> in the impossible(?) case of the -handle having a value of C<0>]. - -C<$sPath> is the path to the file [or device, etc.] to be opened. - -C<$sPath> can use C<"/"> or C<"\\"> as path delimiters and can even -mix the two. We will usually only use C<"/"> in our examples since -using C<"\\"> is usually harder to read. - -Under Windows NT, C<$sPath> can start with C<"//?/"> to allow the use -of paths longer than C [for UNC paths, replace the leading -C<"//"> with C<"//?/UNC/">, as in C<"//?/UNC/Server/Share/Dir/File.Ext">]. - -C<$sPath> can start with C<"//./"> to indicate that the rest of the -path is the name of a "DOS device." You can use C -to list all current DOS devices and can add or delete them with -C. If you get the source-code distribution of this -module from CPAN, then it includes an example script, F -that will list all current DOS devices and their "native" definition. -Again, note that this doesn't work under Win95 nor Win98. - -The most common such DOS devices include: - -=over - -=item C<"//./PhysicalDrive0"> - -Your entire first hard disk. Doesn't work under Windows 95. This -allows you to read or write raw sectors of your hard disk and to use -C to perform miscellaneous queries and operations -to the hard disk. Writing raw sectors and certain other operations -can seriously damage your files or the function of your computer. - -Locking this for exclusive access [by specifying C<0> for C<$uShare>] -doesn't prevent access to the partitions on the disk nor their file -systems. So other processes can still access any raw sectors within -a partition and can use the file system on the disk as usual. - -=item C<"//./C:"> - -Your F partition. Doesn't work under Windows 95. This allows -you to read or write raw sectors of that partition and to use -C to perform miscellaneous queries and operations -to the partition. Writing raw sectors and certain other operations -can seriously damage your files or the function of your computer. - -Locking this for exclusive access doesn't prevent access to the -physical drive that the partition is on so other processes can -still access the raw sectors that way. Locking this for exclusive -access B prevent other processes from opening the same raw -partition and B prevent access to the file system on it. It -even prevents the current process from accessing the file system -on that partition. - -=item C<"//./A:"> - -The raw floppy disk. Doesn't work under Windows 95. This allows -you to read or write raw sectors of the floppy disk and to use -C to perform miscellaneous queries and operations -to the floopy disk or drive. - -Locking this for exclusive access prevents all access to the floppy. - -=item C<"//./PIPE/PipeName"> - -A named pipe, created via C. - -=back - -C<$uAccess> is an unsigned value with bits set indicating the -type of access desired. Usually either C<0> ["query" access], -C, C, C, -or C. More specific types of access can be specified, -such as C or C. - -C<$uShare> controls how the file is shared, that is, whether other -processes can have read, write, and/or delete access to the file while -we have it opened. C<$uShare> is an unsigned value with zero or more -of these bits set: C, C, and -C. - -If another process currently has read, write, and/or delete access to -the file and you don't allow that level of sharing, then your call to -C will fail. If you requested read, write, and/or delete -access and another process already has the file open but doesn't allow -that level of sharing, thenn your call to C will fail. Once -you have the file open, if another process tries to open it with read, -write, and/or delete access and you don't allow that level of sharing, -then that process won't be allowed to open the file. - -C<$pSecAttr> should either be C<[]> [for C] or a -C data structure packed into a string. -For example, if C<$pSecDesc> contains a C -structure packed into a string, perhaps via: - - RegGetKeySecurity( $key, 4, $pSecDesc, 1024 ); - -then you can set C<$pSecAttr> via: - - $pSecAttr= pack( "L P i", 12, $pSecDesc, $bInheritHandle ); - -C<$uCreate> is one of the following values: C, -C, C, C, and -C. - -C<$uFlags> is an unsigned value with zero or more bits set indicating -attributes to associate with the file [C values] or -special options [C values]. - -If opening the client side of a named pipe, then you can also set -C<$uFlags> to include C along with one of the -other C constants to specify the security quality of -service to be used. - -C<$hModel> is C<0> [or C<[]>, both of which mean C] or a Win32 -native handle opened with C access to a model file from -which file attributes and extended attributes are to be copied if a -new file gets created. - -Examples: - - $hFlop= CreateFile( "//./A:", GENERIC_READ(), - FILE_SHARE_READ(), [], OPEN_EXISTING(), 0, [] ) - or die "Can't prevent others from writing to floppy: $^E\n"; - $hDisk= CreateFile( $sFilePath, FILE_READ_ATTRIBUTES(), - FILE_SHARE_READ()|FILE_SHARE_WRITE(), [], OPEN_EXISTING(), 0, [] ) - or die "Can't read attributes of $sFilePath: $^E\n"; - $hTemp= CreateFile( "$ENV{Temp}/temp.$$", GENERIC_WRITE(), 0, - CREATE_NEW(), FILE_FLAG_DELETE_ON_CLOSE()|attrLetsToBits("hst"), [] ) - or die "Can't create temporary file, temp.$$: $^E\n"; - -=item DefineDosDevice - -=item C - -Defines a new DOS device, overrides the current definition of a DOS -device, or deletes a definition of a DOS device. Like most routines, -returns a true value if successful and a false value [and sets C<$^E> -and C] on failure. - -C<$sDosDeviceName> is the name of a DOS device for which we'd like -to add or delete a definition. - -C<$uFlags> is an unsigned value with zero or more of the following -bits set: - -=over - -=item C - -Indicates that C<$sTargetPath> will be a raw Windows NT object name. -This usually means that C<$sTargetPath> starts with C<"\\Device\\">. -Note that you cannot use C<"/"> in place of C<"\\"> in raw target path -names. - -=item C - -Requests that a definition be deleted. If C<$sTargetPath> is -C<[]> [for C], then the most recently added definition for -C<$sDosDeviceName> is removed. Otherwise the most recently added -definition matching C<$sTargetPath> is removed. - -If the last definition is removed, then the DOS device name is -also deleted. - -=item C - -When deleting a definition, this bit causes each C<$sTargetPath> to -be compared to the full-length definition when searching for the most -recently added match. If this bit is not set, then C<$sTargetPath> -only needs to match a prefix of the definition. - -=back - -C<$sTargetPath> is the DOS device's specific definition that you -wish to add or delete. For C, these usually -start with C<"\\Device\\">. If the C bit is -not set, then C<$sTargetPath> is just an ordinary path to some file -or directory, providing the functionality of the B command. - -=item DeleteFile - -=item C - -Deletes the named file. Compared to Perl's C, C -has the advantage of not deleting read-only files. For B -versions of Perl, C silently calls C whether it needs -to or not before deleting the file so that files that you have -protected by marking them as read-only are not always protected from -Perl's C. - -Like most routines, returns a true value if successful and a false -value [and sets C<$^E> and C] on failure. - -=item DeviceIoControl - -=item C - -Requests a special operation on an I/O [input/output] device, such -as ejecting a tape or formatting a disk. Like most routines, returns -a true value if successful and a false value [and sets C<$^E> and -C] on failure. - -C<$hDevice> is a Win32 native file handle to a device [return value -from C]. - -C<$uIoControlCode> is an unsigned value [a C or C -constant] indicating the type query or other operation to be performed. - -C<$pInBuf> is C<[]> [for C] or a data structure packed into a -string. The type of data structure depends on the C<$uIoControlCode> -value. C<$lInBuf> is C<0> or the length of the structure in -C<$pInBuf>. If C<$pInBuf> is not C<[]> and C<$lInBuf> is C<0>, then -C<$lInBuf> will automatically be set to C for you. - -C<$opOutBuf> is C<[]> [for C] or will be set to contain a -returned data structure packed into a string. C<$lOutBuf> indicates -how much space to allocate in C<$opOutBuf> for C to -store the data structure. If C<$lOutBuf> is a number and C<$opOutBuf> -already has a buffer allocated for it that is larger than C<$lOutBuf> -bytes, then this larger buffer size will be passed to C. -However, you can force a specific buffer size to be passed to -C by prepending a C<"="> to the front of C<$lOutBuf>. - -C<$olRetBytes> is C<[]> or is a scalar to receive the number of bytes -written to C<$opOutBuf>. Even when C<$olRetBytes> is C<[]>, a valid -pointer to a C [and not C] is passed to C. -In this case, C<[]> just means that you don't care about the value -that might be written to C<$olRetBytes>, which is usually the case -since you can usually use C instead. - -C<$pOverlapped> is C<[]> or is a C structure packed into -a string. This is only useful if C<$hDevice> was opened with the -C flag set. - -=item FdGetOsFHandle - -=item C<$hNativeHandle= FdGetOsFHandle( $ivFd )> - -C simply calls C<_get_osfhandle()>. It was renamed -to better fit in with the rest the function names of this module, -in particular to distinguish it from C. It takes an -integer file descriptor [as from Perl's C] and returns the -Win32 native file handle associated with that file descriptor or -C if C<$ivFd> is not an open file descriptor. - -When you call Perl's C to set a Perl file handle [like C], -Perl calls C's C to set a stdio C. C's C calls -something like Unix's C, that is, Win32's C<_sopen>, to get an -integer file descriptor [where 0 is for C, 1 for C, etc.]. -Win32's C<_sopen> calls C to set a C, a Win32 native -file handle. So every Perl file handle [like C] has an integer -file descriptor associated with it that you can get via C. And, -under Win32, every file descriptor has a Win32 native file handle -associated with it. C lets you get access to that. - -C<$hNativeHandle> is set to C [and -C and C<$^E> are set] if C fails. -See also C which provides a friendlier interface. - -=item fileConstant - -=item C<$value= fileConstant( $sConstantName )> - -Fetch the value of a constant. Returns C if C<$sConstantName> -is not the name of a constant supported by this module. Never sets -C<$!> nor C<$^E>. - -This function is rarely used since you will usually get the value of a -constant by having that constant imported into your package by listing -the constant name in the C statement and then -simply using the constant name in your code [perhaps followed by -C<()>]. This function is useful for verifying constant names not in -Perl code, for example, after prompting a user to type in a constant -name. - -=item fileLastError - -=item C<$svError= fileLastError();> - -=item C - -Returns the last error encountered by a routine from this module. -It is just like C<$^E> except it isn't changed by anything except -routines from this module. Ideally you could just use C<$^E>, but -current versions of Perl often overwrite C<$^E> before you get a -chance to check it and really old versions of Perl don't really -support C<$^E> under Win32. - -Just like C<$^E>, in a numeric context C returns -the numeric error value while in a string context it returns a -text description of the error [actually it returns a Perl scalar -that contains both values so C<$x= fileLastError()> causes C<$x> -to give different values in string vs. numeric contexts]. - -The last form sets the error returned by future calls to -C and should not be used often. C<$uError> must -be a numeric error code. Also returns the dual-valued version -of C<$uError>. - -=item GetDriveType - -=item C<$uDriveType= GetDriveType( $sRootPath )> - -Takes a string giving the path to the root directory of a file system -[called a "drive" because every file system is assigned a "drive letter"] -and returns an unsigned value indicating the type of drive the file -system is on. The return value should be one of: - -=over - -=item C - -None of the following. - -=item C - -A "drive" that does not have a file system. This can be a drive letter -that hasn't been defined or a drive letter assigned to a partition -that hasn't been formatted yet. - -=item C - -A floppy diskette drive or other removable media drive, but not a CD-ROM -drive. - -=item C - -An ordinary hard disk partition. - -=item C - -A network share. - -=item C - -A CD-ROM drive. - -=item C - -A "ram disk" or memory-resident virtual file system used for high-speed -access to small amounts of temporary file space. - -=back - -=item GetFileAttributes - -=item C<$uAttrs = GetFileAttributes( $sPath )> - -Takes a path string and returns an unsigned value with attribute flags. -If it fails, it returns INVALID_FILE_ATTRIBUTES, otherwise it can be -one or more of the following values: - -=over - -=item C - -The file or directory is an archive file or directory. Applications use -this attribute to mark files for backup or removal. - -=item C - -The file or directory is compressed. For a file, this means that all of -the data in the file is compressed. For a directory, this means that -compression is the default for newly created files and subdirectories. - -=item C - -Reserved; do not use. - -=item C - -The handle identifies a directory. - -=item C - -The file or directory is encrypted. For a file, this means that all data -streams in the file are encrypted. For a directory, this means that -encryption is the default for newly created files and subdirectories. - -=item C - -The file or directory is hidden. It is not included in an ordinary directory -listing. - -=item C - -The file or directory has no other attributes set. This attribute is valid -only if used alone. - -=item C - -The file will not be indexed by the content indexing service. - -=item C - -The data of the file is not immediately available. This attribute indicates -that the file data has been physically moved to offline storage. This -attribute is used by Remote Storage, the hierarchical storage management -software. Applications should not arbitrarily change this attribute. - -=item C - -The file or directory is read-only. Applications can read the file but cannot -write to it or delete it. In the case of a directory, applications cannot -delete it. - -=item C - -The file or directory has an associated reparse point. - -=item C - -The file is a sparse file. - -=item C - -The file or directory is part of, or is used exclusively by, the operating -system. - -=item C - -The file is being used for temporary storage. File systems avoid writing -data back to mass storage if sufficient cache memory is available, because -often the application deletes the temporary file shortly after the handle is -closed. In that case, the system can entirely avoid writing the data. -Otherwise, the data will be written after the handle is closed. - -=back - -=item GetFileType - -=item C<$uFileType= GetFileType( $hFile )> - -Takes a Win32 native file handle and returns a C constant -indicating the type of the file opened on that handle: - -=over - -=item C - -None of the below. Often a special device. - -=item C - -An ordinary disk file. - -=item C - -What Unix would call a "character special file", that is, a device that -works on character streams such as a printer port or a console. - -=item C - -Either a named or anonymous pipe. - -=back - -=item getFileSize - -=item C<$size= getFileSize( $hFile )> - -This is a Perl-friendly wrapper for the C (below) API call. - -It takes a Win32 native file handle and returns the size in bytes. Since the -size can be a 64 bit value, on non 64 bit integer Perls the value returned will -be an object of type C. - -=item GetFileSize - -=item C<$iSizeLow= GetFileSize($win32Handle, $iSizeHigh)> - -Returns the size of a file pointed to by C<$win32Handle>, optionally storing -the high order 32 bits into C<$iSizeHigh> if it is not C<[]>. If $iSizeHigh is -C<[]>, a non-zero value indicates success. Otherwise, on failure the return -value will be C<0xffffffff> and C will not be C. - -=item GetOverlappedResult - -=item C<$bRetval= GetOverlappedResult( $win32Handle, $pOverlapped, - $numBytesTransferred, $bWait )> - -Used for asynchronous IO in Win32 to get the result of a pending IO operation, -such as when a file operation returns C. Returns a false -value on failure. The C<$overlapped> structure and C<$numBytesTransferred> -will be modified with the results of the operation. - -As far as creating the C<$pOverlapped> structure, you are currently on your own. - -See L for more information. - -=item GetLogicalDrives - -=item C<$uDriveBits= GetLogicalDrives()> - -Returns an unsigned value with one bit set for each drive letter currently -defined. If "A:" is currently a valid drive letter, then the C<1> bit -will be set in C<$uDriveBits>. If "B:" is valid, then the C<2> bit will -be set. If "Z:" is valid, then the C<2**26> [C<0x4000000>] bit will be -set. - -=item GetLogicalDriveStrings - -=item C<$olOutLength= GetLogicalDriveStrings( $lBufSize, $osBuffer )> - -For each currently defined drive letter, a C<'\0'>-terminated string -of the path to the root of its file system is constructed. All of -these strings are concatenated into a single larger string and an -extra terminating C<'\0'> is added. This larger string is returned -in C<$osBuffer>. Note that this includes drive letters that have -been defined but that have no file system, such as drive letters -assigned to unformatted partitions. - -C<$lBufSize> is the size of the buffer to allocate to store this -list of strings. C<26*4+1> is always sufficient and should usually -be used. - -C<$osBuffer> is a scalar to be set to contain the constructed string. - -C<$olOutLength> is the number of bytes actually written to C<$osBuffer> -but C can also be used to determine this. - -For example, on a poorly equipped computer, - - GetLogicalDriveStrings( 4*26+1, $osBuffer ); - -might set C<$osBuffer> to the 9-character string, C<"A:\\\0C:\\\0\0">. - -=item GetHandleInformation - -=item C - -Retrieves the flags associated with a Win32 native file handle or object -handle. - -C<$hObject> is an open Win32 native file handle or an open Win32 native -handle to some other type of object. - -C<$ouFlags> will be set to an unsigned value having zero or more of -the bits C and C -set. See the C<":HANDLE_FLAG_"> export class for the meanings of these -bits. - -=item GetOsFHandle - -=item C<$hNativeHandle= GetOsFHandle( FILE )> - -Takes a Perl file handle [like C] and returns the Win32 native -file handle associated with it. See C for more -information about Win32 native file handles. - -C<$hNativeHandle> is set to a false value [and C and -C<$^E> are set] if C fails. C returns -C<"0 but true"> in the impossible(?) case of the handle having a value -of C<0>. - -=item GetVolumeInformation - -=item C - -Gets information about a file system volume, returning a true -value if successful. On failure, returns a false value and sets -C and C<$^E>. - -C<$sRootPath> is a string specifying the path to the root of the file system, -for example, C<"C:/">. - -C<$osVolName> is a scalar to be set to the string representing the -volume name, also called the file system label. C<$lVolName> is the -number of bytes to allocate for the C<$osVolName> buffer [see -L for more information]. - -C<$ouSerialNum> is C<[]> [for C] or will be set to the numeric -value of the volume's serial number. - -C<$ouMaxNameLen> is C<[]> [for C] or will be set to the maximum -length allowed for a file name or directory name within the file system. - -C<$osFsType> is a scalar to be set to the string representing the -file system type, such as C<"FAT"> or C<"NTFS">. C<$lFsType> is the -number of bytes to allocate for the C<$osFsType> buffer [see -L for more information]. - -C<$ouFsFlags> is C<[]> [for C] or will be set to an unsigned integer -with bits set indicating properties of the file system: - -=over - -=item C - -The file system preserves the case of file names [usually true]. -That is, it doesn't change the case of file names such as forcing -them to upper- or lower-case. - -=item C - -The file system supports the ability to not ignore the case of file -names [but might ignore case the way you are using it]. That is, the -file system has the ability to force you to get the letter case of a -file's name exactly right to be able to open it. This is true for -"NTFS" file systems, even though case in file names is usually still -ignored. - -=item C - -The file system preserves Unicode in file names [true for "NTFS"]. - -=item C - -The file system supports setting Access Control Lists on files [true -for "NTFS"]. - -=item C - -The file system supports compression on a per-file basis [true for -"NTFS"]. - -=item C - -The entire file system is compressed such as via "DoubleSpace". - -=back - -=item IsRecognizedPartition - -=item C - -Takes a partition type and returns whether that partition type is -supported under Win32. C<$ivPartitonType> is an integer value as from -the operating system byte of a hard disk's DOS-compatible partition -table [that is, a partition table for x86-based Win32, not, for -example, one used with Windows NT for Alpha processors]. For example, -the C member of the C structure. - -Common values for C<$ivPartitionType> include C, -C, C, C. - -=item IsContainerPartition - -=item C - -Takes a partition type and returns whether that partition is a -"container" partition that is supported under Win32, that is, whether -it is an "extended" partition that can contain "logical" partitions. -C<$ivPartitonType> is as for C. - -=item MoveFile - -=item C - -Renames a file or directory. C<$sOldName> is the name of the existing -file or directory that is to be renamed. C<$sNewName> is the new name -to give the file or directory. Returns a true value if the move -succeeds. For failure, returns a false value and sets -C and C<$^E> to the reason for the failure. - -Files can be "renamed" between file systems and the file contents and -some attributes will be moved. Directories can only be renamed within -one file system. If there is already a file or directory named -C<$sNewName>, then C will fail. - -=item MoveFileEx - -=item C - -Renames a file or directory. C<$sOldName> is the name of the existing -file or directory that is to be renamed. C<$sNewName> is the new name -to give the file or directory. Returns a true value if the move -succeeds. For failure, returns a false value and sets -C and C<$^E> to the reason for the failure. - -C<$uFlags> is an unsigned value with zero or more of the following bits set: - -=over - -=item C - -If this bit is set and a file [but not a directory] named C<$sNewName> -already exists, then it will be replaced by C<$sOldName>. If this bit -is not set then C will fail rather than replace an existing -C<$sNewName>. - -=item C - -Allows files [but not directories] to be moved between file systems -by copying the C<$sOldName> file data and some attributes to -C<$sNewName> and then deleting C<$sOldName>. If this bit is not set -[or if C<$sOldName> denotes a directory] and C<$sNewName> refers to a -different file system than C<$sOldName>, then C will fail. - -=item C - -Preliminary verifications are made and then an entry is added to the -Registry to cause the rename [or delete] operation to be done the -next time this copy of the operating system is booted [right after -any automatic file system checks have completed]. This is not -supported under Windows 95. - -When this bit is set, C<$sNewName> can be C<[]> [for C] to -indicate that C<$sOldName> should be deleted during the next boot -rather than renamed. - -Setting both the C and -C bits will cause C to fail. - -=item C - -Ensures that C won't return until the operation has -finished and been flushed to disk. This is not supported under -Windows 95. Only affects file renames to another file system, -forcing a buffer flush at the end of the copy operation. - -=back - -=item OsFHandleOpen - -=item C - -Opens a Perl file handle based on an already open Win32 native -file handle [much like C's C does with a file descriptor]. -Returns a true value if the open operation succeeded. For failure, -returns a false value and sets C<$!> [and possibly C -and C<$^E>] to the reason for the failure. - -C is a Perl file handle [in any of the supported forms, a -bareword, a string, a typeglob, or a reference to a typeglob] that -will be opened. If C is already open, it will automatically -be closed before it is reopened. - -C<$hNativeHandle> is an open Win32 native file handle, probably the -return value from C or C. - -C<$sMode> is string of zero or more letters from C<"rwatb">. These -are translated into a combination C [C<"r">], C -[C<"w">], C [C<"rw">], C [C<"a">], C -[C<"t">], and C [C<"b">] flags [see the L module] -that is passed to C. Currently only C -and C have any significance. - -Also, a C<"r"> and/or C<"w"> in C<$sMode> is used to decide how the -file descriptor is converted into a Perl file handle, even though this -doesn't appear to make a difference. One of the following is used: - - open( FILE, "<&=".$ivFd ) # "r" w/o "w" - open( FILE, ">&=".$ivFd ) # "w" w/o "r" - open( FILE, "+<&=".$ivFd ) # both "r" and "w" - -C eventually calls the Win32-specific C routine -C<_open_osfhandle()> or Perl's "improved" version called -C. Prior to Perl5.005, C's -C<_open_osfhandle()> is called which will fail if -C would return C. For -Perl5.005 and later, C calls C -from the Perl DLL which doesn't have this restriction. - -=item OsFHandleOpenFd - -=item C<$ivFD= OsFHandleOpenFd( $hNativeHandle, $uMode )> - -Opens a file descriptor [C<$ivFD>] based on an already open Win32 -native file handle, C<$hNativeHandle>. This just calls the -Win32-specific C routine C<_open_osfhandle()> or Perl's "improved" -version called C. Prior to Perl5.005 and in Cygwin -Perl, C's C<_open_osfhandle()> is called which will fail if -C would return C. For -Perl5.005 and later, C calls C from -the Perl DLL which doesn't have this restriction. - -C<$uMode> the logical combination of zero or more C constants -exported by the C module. Currently only C and -C have any significance. - -C<$ivFD> will be non-negative if the open operation was successful. -For failure, C<-1> is returned and C<$!> [and possibly -C and C<$^E>] is set to the reason for the failure. - -=item QueryDosDevice - -=item C<$olTargetLen= QueryDosDevice( $sDosDeviceName, $osTargetPath, $lTargetBuf )> - -Looks up the definition of a given "DOS" device name, yielding the -active Windows NT native device name along with any currently dormant -definitions. - -C<$sDosDeviceName> is the name of the "DOS" device whose definitions -we want. For example, C<"C:">, C<"COM1">, or C<"PhysicalDrive0">. -If C<$sDosDeviceName> is C<[]> [for C], the list of all DOS -device names is returned instead. - -C<$osTargetPath> will be assigned a string containing the list of -definitions. The definitions are each C<'\0'>-terminate and are -concatenated into the string, most recent first, with an extra C<'\0'> -at the end of the whole string [see C for -a sample of this format]. - -C<$lTargetBuf> is the size [in bytes] of the buffer to allocate for -C<$osTargetPath>. See L for more information. - -C<$olTargetLen> is set to the number of bytes written to -C<$osTargetPath> but you can also use C -to determine this. - -For failure, C<0> is returned and C and C<$^E> are -set to the reason for the failure. - -=item ReadFile - -=item C - -Reads bytes from a file or file-like device. Returns a true value if -the read operation was successful. For failure, returns a false value -and sets C and C<$^E> for the reason for the failure. - -C<$hFile> is a Win32 native file handle that is already open to the -file or device to read from. - -C<$opBuffer> will be set to a string containing the bytes read. - -C<$lBytes> is the number of bytes you would like to read. -C<$opBuffer> is automatically initialized to have a buffer large -enough to hold that many bytes. Unlike other buffer sizes, C<$lBytes> -does not need to have a C<"="> prepended to it to prevent a larger -value to be passed to the underlying Win32 C API. However, -a leading C<"="> will be silently ignored, even if Perl warnings are -enabled. - -If C<$olBytesRead> is not C<[]>, it will be set to the actual number -of bytes read, though C can also be used to -determine this. - -C<$pOverlapped> is C<[]> or is a C structure packed -into a string. This is only useful if C<$hFile> was opened with -the C flag set. - -=item SetErrorMode - -=item C<$uOldMode= SetErrorMode( $uNewMode )> - -Sets the mode controlling system error handling B returns the -previous mode value. Both C<$uOldMode> and C<$uNewMode> will have -zero or more of the following bits set: - -=over - -=item C - -If set, indicates that when a critical error is encountered, the call -that triggered the error fails immediately. Normally this bit is not -set, which means that a critical error causes a dialogue box to appear -notifying the desktop user that some application has triggered a -critical error. The dialogue box allows the desktop user to decide -whether the critical error is returned to the process, is ignored, or -the offending operation is retried. - -This affects the C and C calls. - -Setting this bit is useful for allowing you to check whether a floppy -diskette is in the floppy drive. - -=item C - -If set, this causes memory access misalignment faults to be -automatically fixed in a manner invisible to the process. This flag -is ignored on x86-based versions of Windows NT. This flag is not -supported on Windows 95. - -=item C - -If set, general protection faults do not generate a dialogue box but -can instead be handled by the process via an exception handler. This -bit should not be set by programs that don't know how to handle such -faults. - -=item C - -If set, then when an attempt to continue reading from or writing to -an already open file [usually on a removable medium like a floppy -diskette] finds the file no longer available, the call will -immediately fail. Normally this bit is not set, which means that -instead a dialogue box will appear notifying the desktop user that -some application has run into this problem. The dialogue box allows -the desktop user to decide whether the failure is returned to the -process, is ignored, or the offending operation is retried. - -This affects the C and C calls. - -=back - -=item setFilePointer - -=item C<$uNewPos = setFilePointer( $hFile, $ivOffset, $uFromWhere )> - -This is a perl-friendly wrapper for the SetFilePointer API (below). -C<$ivOffset> can be a 64 bit integer or C object if your Perl -doesn't have 64 bit integers. The return value is the new offset and will -likewise be a 64 bit integer or a C object. - -=item SetFilePointer - -=item C<$uNewPos = SetFilePointer( $hFile, $ivOffset, $ioivOffsetHigh, $uFromWhere )> - -The native Win32 version of C. C sets the -position within a file where the next read or write operation will -start from. - -C<$hFile> is a Win32 native file handle. - -C<$uFromWhere> is either C, C, or -C, indicating that the new file position is being specified -relative to the beginning of the file, the current file pointer, or -the end of the file, respectively. - -C<$ivOffset> is [if C<$ioivOffsetHigh> is C<[]>] the offset [in bytes] -to the new file position from the position specified via -C<$uFromWhere>. If C<$ioivOffsetHigh> is not C<[]>, then C<$ivOffset> -is converted to an unsigned value to be used as the low-order 4 bytes -of the offset. - -C<$ioivOffsetHigh> can be C<[]> [for C] to indicate that you are -only specifying a 4-byte offset and the resulting file position will -be 0xFFFFFFFE or less [just under 4GB]. Otherwise C<$ioivOfffsetHigh> -starts out with the high-order 4 bytes [signed] of the offset and gets -set to the [unsigned] high-order 4 bytes of the resulting file position. - -The underlying C returns C<0xFFFFFFFF> to indicate -failure, but if C<$ioivOffsetHigh> is not C<[]>, you would also have -to check C<$^E> to determine whether C<0xFFFFFFFF> indicates an error -or not. C does this checking for you -and returns a false value if and only if the underlying -C failed. For this reason, C<$uNewPos> is set to -C<"0 but true"> if you set the file pointer to the beginning of the -file [or any position with 0 for the low-order 4 bytes]. - -So the return value will be true if the seek operation was successful. -For failure, a false value is returned and C and -C<$^E> are set to the reason for the failure. - -=item SetHandleInformation - -=item C - -Sets the flags associated with a Win32 native file handle or object -handle. Returns a true value if the operation was successful. For -failure, returns a false value and sets C and C<$^E> -for the reason for the failure. - -C<$hObject> is an open Win32 native file handle or an open Win32 native -handle to some other type of object. - -C<$uMask> is an unsigned value having one or more of the bits -C and C set. -Only bits set in C<$uMask> will be modified by C. - -C<$uFlags> is an unsigned value having zero or more of the bits -C and C set. -For each bit set in C<$uMask>, the cooresponding bit in the handle's -flags is set to the value of the cooresponding bit in C<$uFlags>. - -If C<$uOldFlags> were the value of the handle's flags before the -call to C, then the value of the handle's -flags afterward would be: - - ( $uOldFlags & ~$uMask ) | ( $uFlags & $uMask ) - -[at least as far as the C and -C bits are concerned.] - -See the C<":HANDLE_FLAG_"> export class for the meanings of these bits. - -=item WriteFile - -=item C - -Write bytes to a file or file-like device. Returns a true value if -the operation was successful. For failure, returns a false value and -sets C and C<$^E> for the reason for the failure. - -C<$hFile> is a Win32 native file handle that is already open to the -file or device to be written to. - -C<$pBuffer> is a string containing the bytes to be written. - -C<$lBytes> is the number of bytes you would like to write. If -C<$pBuffer> is not at least C<$lBytes> long, C croaks. You -can specify C<0> for C<$lBytes> to write C bytes. -A leading C<"="> on C<$lBytes> will be silently ignored, even if Perl -warnings are enabled. - -C<$ouBytesWritten> will be set to the actual number of bytes written -unless you specify it as C<[]>. - -C<$pOverlapped> is C<[]> or is an C structure packed -into a string. This is only useful if C<$hFile> was opened with -the C flag set. - -=back - -=item C<":FuncA"> - -The ASCII-specific functions. Each of these is just the same as the -version without the trailing "A". - - CopyFileA - CreateFileA - DefineDosDeviceA - DeleteFileA - GetDriveTypeA - GetFileAttributesA - GetLogicalDriveStringsA - GetVolumeInformationA - MoveFileA - MoveFileExA - QueryDosDeviceA - -=item C<":FuncW"> - -The wide-character-specific (Unicode) functions. Each of these is -just the same as the version without the trailing "W" except that -strings are expected in Unicode and some lengths are measured as -number of Cs instead of number of bytes, as indicated below. - -=over - -=item CopyFileW - -=item C - -C<$swOldFileName> and C<$swNewFileName> are Unicode strings. - -=item CreateFileW - -=item C<$hObject= CreateFileW( $swPath, $uAccess, $uShare, $pSecAttr, $uCreate, $uFlags, $hModel )> - -C<$swPath> is Unicode. - -=item DefineDosDeviceW - -=item C - -C<$swDosDeviceName> and C<$swTargetPath> are Unicode. - -=item DeleteFileW - -=item C - -C<$swFileName> is Unicode. - -=item GetDriveTypeW - -=item C<$uDriveType= GetDriveTypeW( $swRootPath )> - -C<$swRootPath> is Unicode. - -=item GetFileAttributesW - -=item C<$uAttrs= GetFileAttributesW( $swPath )> - -C<$swPath> is Unicode. - -=item GetLogicalDriveStringsW - -=item C<$olwOutLength= GetLogicalDriveStringsW( $lwBufSize, $oswBuffer )> - -Unicode is stored in C<$oswBuffer>. C<$lwBufSize> and C<$olwOutLength> -are measured as number of Cs. - -=item GetVolumeInformationW - -=item C - -C<$swRootPath> is Unicode and Unicode is written to C<$oswVolName> and -C<$oswFsType>. C<$lwVolName> and C<$lwFsType> are measures as number -of Cs. - -=item MoveFileW - -=item C - -C<$swOldName> and C<$swNewName> are Unicode. - -=item MoveFileExW - -=item C - -C<$swOldName> and C<$swNewName> are Unicode. - -=item QueryDosDeviceW - -=item C<$olwTargetLen= QueryDosDeviceW( $swDeviceName, $oswTargetPath, $lwTargetBuf )> - -C<$swDeviceName> is Unicode and Unicode is written to -C<$oswTargetPath>. C<$lwTargetBuf> and C<$olwTargetLen> are measured -as number of Cs. - -=back - -=item C<":Misc"> - -Miscellaneous constants. Used for the C<$uCreate> argument of -C or the C<$uFromWhere> argument of C. -Plus C, which you usually won't need to check -for since most routines translate it into a false value. - - CREATE_ALWAYS CREATE_NEW OPEN_ALWAYS - OPEN_EXISTING TRUNCATE_EXISTING INVALID_HANDLE_VALUE - FILE_BEGIN FILE_CURRENT FILE_END - -=item C<":DDD_"> - -Constants for the C<$uFlags> argument of C. - - DDD_EXACT_MATCH_ON_REMOVE - DDD_RAW_TARGET_PATH - DDD_REMOVE_DEFINITION - -=item C<":DRIVE_"> - -Constants returned by C. - - DRIVE_UNKNOWN DRIVE_NO_ROOT_DIR DRIVE_REMOVABLE - DRIVE_FIXED DRIVE_REMOTE DRIVE_CDROM - DRIVE_RAMDISK - -=item C<":FILE_"> - -Specific types of access to files that can be requested via the -C<$uAccess> argument to C. - - FILE_READ_DATA FILE_LIST_DIRECTORY - FILE_WRITE_DATA FILE_ADD_FILE - FILE_APPEND_DATA FILE_ADD_SUBDIRECTORY - FILE_CREATE_PIPE_INSTANCE FILE_READ_EA - FILE_WRITE_EA FILE_EXECUTE - FILE_TRAVERSE FILE_DELETE_CHILD - FILE_READ_ATTRIBUTES FILE_WRITE_ATTRIBUTES - FILE_ALL_ACCESS FILE_GENERIC_READ - FILE_GENERIC_WRITE FILE_GENERIC_EXECUTE )], - -=item C<":FILE_ATTRIBUTE_"> - -File attribute constants. Returned by C and used in -the C<$uFlags> argument to C. - - FILE_ATTRIBUTE_ARCHIVE FILE_ATTRIBUTE_COMPRESSED - FILE_ATTRIBUTE_HIDDEN FILE_ATTRIBUTE_NORMAL - FILE_ATTRIBUTE_OFFLINE FILE_ATTRIBUTE_READONLY - FILE_ATTRIBUTE_SYSTEM FILE_ATTRIBUTE_TEMPORARY - -In addition, C can return these constants (or -INVALID_FILE_ATTRIBUTES in case of an error). - - FILE_ATTRIBUTE_DEVICE FILE_ATTRIBUTE_DIRECTORY - FILE_ATTRIBUTE_ENCRYPTED FILE_ATTRIBUTE_NOT_CONTENT_INDEXED - FILE_ATTRIBUTE_REPARSE_POINT FILE_ATTRIBUTE_SPARSE_FILE - -=item C<":FILE_FLAG_"> - -File option flag constants. Used in the C<$uFlags> argument to -C. - - FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_DELETE_ON_CLOSE - FILE_FLAG_NO_BUFFERING FILE_FLAG_OVERLAPPED - FILE_FLAG_POSIX_SEMANTICS FILE_FLAG_RANDOM_ACCESS - FILE_FLAG_SEQUENTIAL_SCAN FILE_FLAG_WRITE_THROUGH - FILE_FLAG_OPEN_REPARSE_POINT - -=item C<":FILE_SHARE_"> - -File sharing constants. Used in the C<$uShare> argument to -C. - - FILE_SHARE_DELETE FILE_SHARE_READ FILE_SHARE_WRITE - -=item C<":FILE_TYPE_"> - -File type constants. Returned by C. - - FILE_TYPE_CHAR FILE_TYPE_DISK - FILE_TYPE_PIPE FILE_TYPE_UNKNOWN - -=item C<":FS_"> - -File system characteristics constants. Placed in the C<$ouFsFlags> -argument to C. - - FS_CASE_IS_PRESERVED FS_CASE_SENSITIVE - FS_UNICODE_STORED_ON_DISK FS_PERSISTENT_ACLS - FS_FILE_COMPRESSION FS_VOL_IS_COMPRESSED - -=item C<":HANDLE_FLAG_"> - -Flag bits modifying the behavior of an object handle and accessed via -C and C. - -=over - -=item HANDLE_FLAG_INHERIT - -If this bit is set, then children of this process who inherit handles -[that is, processes created by calls to the Win32 C API -with the C parameter specified as C], will inherit -this particular object handle. - -=item HANDLE_FLAG_PROTECT_FROM_CLOSE - -If this bit is set, then calls to C against this handle -will be ignored, leaving the handle open and usable. - -=back - -=item C<":IOCTL_STORAGE_"> - -I/O control operations for generic storage devices. Used in the -C<$uIoControlCode> argument to C. Includes -C, C, -C, C, -C, C, -C, and -C. - -=over - -=item C - -Verify that a device's media is accessible. C<$pInBuf> and C<$opOutBuf> -should both be C<[]>. If C returns a true value, then -the media is currently accessible. - -=item C - -Allows the device's media to be locked or unlocked. C<$opOutBuf> should -be C<[]>. C<$pInBuf> should be a C data structure, -which is simply an interger containing a boolean value: - - $pInBuf= pack( "i", $bPreventMediaRemoval ); - -=item C - -Requests that the device eject the media. C<$pInBuf> and C<$opOutBuf> -should both be C<[]>. - -=item C - -Requests that the device load the media. C<$pInBuf> and C<$opOutBuf> -should both be C<[]>. - -=item C - -Requests that the device be reserved. C<$pInBuf> and C<$opOutBuf> -should both be C<[]>. - -=item C - -Releases a previous device reservation. C<$pInBuf> and C<$opOutBuf> -should both be C<[]>. - -=item C - -No documentation on this IOCTL operation was found. - -=item C - -Requests information about the type of media supported by the device. -C<$pInBuf> should be C<[]>. C<$opOutBuf> will be set to contain a -vector of C data structures, which can be decoded via: - - # Calculate the number of DISK_GEOMETRY structures returned: - my $cStructs= length($opOutBuf)/(4+4+4+4+4+4); - my @fields= unpack( "L l I L L L" x $cStructs, $opOutBuf ) - my( @ucCylsLow, @ivcCylsHigh, @uMediaType, @uTracksPerCyl, - @uSectsPerTrack, @uBytesPerSect )= (); - while( @fields ) { - push( @ucCylsLow, unshift @fields ); - push( @ivcCylsHigh, unshift @fields ); - push( @uMediaType, unshift @fields ); - push( @uTracksPerCyl, unshift @fields ); - push( @uSectsPerTrack, unshift @fields ); - push( @uBytesPerSect, unshift @fields ); - } - -For the C<$i>th type of supported media, the following variables will -contain the following data. - -=over - -=item C<$ucCylsLow[$i]> - -The low-order 4 bytes of the total number of cylinders. - -=item C<$ivcCylsHigh[$i]> - -The high-order 4 bytes of the total number of cylinders. - -=item C<$uMediaType[$i]> - -A code for the type of media. See the C<":MEDIA_TYPE"> export class. - -=item C<$uTracksPerCyl[$i]> - -The number of tracks in each cylinder. - -=item C<$uSectsPerTrack[$i]> - -The number of sectors in each track. - -=item C<$uBytesPerSect[$i]> - -The number of bytes in each sector. - -=back - -=back - -=item C<":IOCTL_DISK_"> - -I/O control operations for disk devices. Used in the C<$uIoControlCode> -argument to C. Most of these are to be used on -physical drive devices like C<"//./PhysicalDrive0">. However, -C and C -should only be used on a single-partition device like C<"//./C:">. Also, -C is documented as having been superceded but -is still useful when used on a floppy device like C<"//./A:">. - -Includes C, C, -C, C, -C, C, -C, C, -C, C, -C, C, -C, C, -C, C, -C, and C. - -=over - -=item C - -Request information about the size and geometry of the disk. C<$pInBuf> -should be C<[]>. C<$opOutBuf> will be set to a C data -structure which can be decode via: - - ( $ucCylsLow, $ivcCylsHigh, $uMediaType, $uTracksPerCyl, - $uSectsPerTrack, $uBytesPerSect )= unpack( "L l I L L L", $opOutBuf ); - -=over - -=item C<$ucCylsLow> - -The low-order 4 bytes of the total number of cylinders. - -=item C<$ivcCylsHigh> - -The high-order 4 bytes of the total number of cylinders. - -=item C<$uMediaType> - -A code for the type of media. See the C<":MEDIA_TYPE"> export class. - -=item C<$uTracksPerCyl> - -The number of tracks in each cylinder. - -=item C<$uSectsPerTrack> - -The number of sectors in each track. - -=item C<$uBytesPerSect> - -The number of bytes in each sector. - -=back - -=item C - -Request information about the size and geometry of the partition. -C<$pInBuf> should be C<[]>. C<$opOutBuf> will be set to a -C data structure which can be decode via: - - ( $uStartLow, $ivStartHigh, $ucHiddenSects, $uPartitionSeqNumber, - $uPartitionType, $bActive, $bRecognized, $bToRewrite )= - unpack( "L l L L C c c c", $opOutBuf ); - -=over - -=item C<$uStartLow> and C<$ivStartHigh> - -The low-order and high-order [respectively] 4 bytes of the starting -offset of the partition, measured in bytes. - -=item C<$ucHiddenSects> - -The number of "hidden" sectors for this partition. Actually this is -the number of sectors found prior to this partiton, that is, the -starting offset [as found in C<$uStartLow> and C<$ivStartHigh>] -divided by the number of bytes per sector. - -=item C<$uPartitionSeqNumber> - -The sequence number of this partition. Partitions are numbered -starting as C<1> [with "partition 0" meaning the entire disk]. -Sometimes this field may be C<0> and you'll have to infer the -partition sequence number from how many partitions preceed it on -the disk. - -=item C<$uPartitionType> - -The type of partition. See the C<":PARTITION_"> export class for a -list of known types. See also C and -C. - -=item C<$bActive> - -C<1> for the active [boot] partition, C<0> otherwise. - -=item C<$bRecognized> - -Whether this type of partition is support under Win32. - -=item C<$bToRewrite> - -Whether to update this partition information. This field is not used -by C. For -C, you must set this field to a true -value for any partitions you wish to have changed, added, or deleted. - -=back - -=item C - -Change the type of the partition. C<$opOutBuf> should be C<[]>. -C<$pInBuf> should be a C data structure -which is just a single byte containing the new parition type [see -the C<":PARTITION_"> export class for a list of known types]: - - $pInBuf= pack( "C", $uPartitionType ); - -=item C - -Request information about the disk layout. C<$pInBuf> should be C<[]>. -C<$opOutBuf> will be set to contain C -structure including several C structures: - - my( $cPartitions, $uDiskSignature )= unpack( "L L", $opOutBuf ); - my @fields= unpack( "x8" . ( "L l L L C c c c" x $cPartitions ), - $opOutBuf ); - my( @uStartLow, @ivStartHigh, @ucHiddenSects, - @uPartitionSeqNumber, @uPartitionType, @bActive, - @bRecognized, @bToRewrite )= (); - for( 1..$cPartition ) { - push( @uStartLow, unshift @fields ); - push( @ivStartHigh, unshift @fields ); - push( @ucHiddenSects, unshift @fields ); - push( @uPartitionSeqNumber, unshift @fields ); - push( @uPartitionType, unshift @fields ); - push( @bActive, unshift @fields ); - push( @bRecognized, unshift @fields ); - push( @bToRewrite, unshift @fields ); - } - -=over - -=item C<$cPartitions> - -If the number of partitions on the disk. - -=item C<$uDiskSignature> - -Is the disk signature, a unique number assigned by Disk Administrator -[F] and used to identify the disk. This allows drive -letters for partitions on that disk to remain constant even if the -SCSI Target ID of the disk gets changed. - -=back - -See C for information on the -remaining these fields. - -=item C - -Is supposed to be superseded by C but -is still useful for determining the types of floppy diskette formats -that can be produced by a given floppy drive. See -F for an example. - -=item C - -Change the partition layout of the disk. C<$pOutBuf> should be C<[]>. -C<$pInBuf> should be a C data structure -including several C data structures. - - # Already set: $cPartitions, $uDiskSignature, @uStartLow, @ivStartHigh, - # @ucHiddenSects, @uPartitionSeqNumber, @uPartitionType, @bActive, - # @bRecognized, and @bToRewrite. - my( @fields, $prtn )= (); - for $prtn ( 1..$cPartition ) { - push( @fields, $uStartLow[$prtn-1], $ivStartHigh[$prtn-1], - $ucHiddenSects[$prtn-1], $uPartitionSeqNumber[$prtn-1], - $uPartitionType[$prtn-1], $bActive[$prtn-1], - $bRecognized[$prtn-1], $bToRewrite[$prtn-1] ); - } - $pInBuf= pack( "L L" . ( "L l L L C c c c" x $cPartitions ), - $cPartitions, $uDiskSignature, @fields ); - -To delete a partition, zero out all fields except for C<$bToRewrite> -which should be set to C<1>. To add a partition, increment -C<$cPartitions> and add the information for the new partition -into the arrays, making sure that you insert C<1> into @bToRewrite. - -See C and -C for descriptions of the -fields. - -=item C - -Performs a logical format of [part of] the disk. C<$opOutBuf> should -be C<[]>. C<$pInBuf> should contain a C data -structure: - - $pInBuf= pack( "L l L", - $uStartOffsetLow, $ivStartOffsetHigh, $uLength ); - -=over - -=item C<$uStartOffsetLow> and C<$ivStartOffsetHigh> - -The low-order and high-order [respectively] 4 bytes of the offset [in -bytes] where the formatting should begin. - -=item C<$uLength> - -The length [in bytes] of the section to be formatted. - -=back - -=item C - -Format a range of tracks on the disk. C<$opOutBuf> should be C<[]>. -C<$pInBuf> should contain a C data structure: - - $pInBuf= pack( "L L L L L", $uMediaType, - $uStartCyl, $uEndCyl, $uStartHead, $uEndHead ); - -C<$uMediaType> if the type of media to be formatted. Mostly used to -specify the density to use when formatting a floppy diskette. See the -C<":MEDIA_TYPE"> export class for more information. - -The remaining fields specify the starting and ending cylinder and -head of the range of tracks to be formatted. - -=item C - -Reassign a list of disk blocks to the disk's spare-block pool. -C<$opOutBuf> should be C<[]>. C<$pInBuf> should be a -C data structure: - - $pInBuf= pack( "S S L*", 0, $cBlocks, @uBlockNumbers ); - -=item C - -Request information about disk performance. C<$pInBuf> should be C<[]>. -C<$opOutBuf> will be set to contain a C data structure: - - my( $ucBytesReadLow, $ivcBytesReadHigh, - $ucBytesWrittenLow, $ivcBytesWrittenHigh, - $uReadTimeLow, $ivReadTimeHigh, - $uWriteTimeLow, $ivWriteTimeHigh, - $ucReads, $ucWrites, $uQueueDepth )= - unpack( "L l L l L l L l L L L", $opOutBuf ); - -=item C - -No documentation on this IOCTL operation was found. - -=item C - -Control disk logging. Little documentation for this IOCTL operation -was found. It makes use of a C data structure: - -=over - -=item DISK_LOGGING_START - -Start logging each disk request in a buffer internal to the disk device -driver of size C<$uLogBufferSize>: - - $pInBuf= pack( "C L L", 0, 0, $uLogBufferSize ); - -=item DISK_LOGGING_STOP - -Stop loggin each disk request: - - $pInBuf= pack( "C L L", 1, 0, 0 ); - -=item DISK_LOGGING_DUMP - -Copy the interal log into the supplied buffer: - - $pLogBuffer= ' ' x $uLogBufferSize - $pInBuf= pack( "C P L", 2, $pLogBuffer, $uLogBufferSize ); - - ( $uByteOffsetLow[$i], $ivByteOffsetHigh[$i], - $uStartTimeLow[$i], $ivStartTimeHigh[$i], - $uEndTimeLog[$i], $ivEndTimeHigh[$i], - $hVirtualAddress[$i], $ucBytes[$i], - $uDeviceNumber[$i], $bWasReading[$i] )= - unpack( "x".(8+8+8+4+4+1+1+2)." L l L l L l L L C c x2", $pLogBuffer ); - -=item DISK_LOGGING_BINNING - -Keep statics grouped into bins based on request sizes. - - $pInBuf= pack( "C P L", 3, $pUnknown, $uUnknownSize ); - -=back - -=item C - -No documentation on this IOCTL is included. - -=item C - -No documentation on this IOCTL is included. - -=item C - -No documentation on this IOCTL is included. - -=item C - -No documentation on this IOCTL is included. - -=item C - -No documentation on this IOCTL operation was found. - -=item C - -No documentation on this IOCTL operation was found. - -=back - -=item C<":FSCTL_"> - -File system control operations. Used in the C<$uIoControlCode> -argument to C. - -Includes C, C, -C. - -=over - -=item C - -Sets reparse point data to be associated with $hDevice. - -=item C - -Retrieves the reparse point data associated with $hDevice. - -=item C - -Deletes the reparse point data associated with $hDevice. - -=back - -=item C<":GENERIC_"> - -Constants specifying generic access permissions that are not specific -to one type of object. - - GENERIC_ALL GENERIC_EXECUTE - GENERIC_READ GENERIC_WRITE - -=item C<":MEDIA_TYPE"> - -Different classes of media that a device can support. Used in the -C<$uMediaType> field of a C structure. - -=over - -=item C - -Format is unknown. - -=item C - -5.25" floppy, 1.2MB [really 1,200KB] total space, 512 bytes/sector. - -=item C - -3.5" floppy, 1.44MB [really 1,440KB] total space, 512 bytes/sector. - -=item C - -3.5" floppy, 2.88MB [really 2,880KB] total space, 512 bytes/sector. - -=item C - -3.5" floppy, 20.8MB total space, 512 bytes/sector. - -=item C - -3.5" floppy, 720KB total space, 512 bytes/sector. - -=item C - -5.25" floppy, 360KB total space, 512 bytes/sector. - -=item C - -5.25" floppy, 320KB total space, 512 bytes/sector. - -=item C - -5.25" floppy, 320KB total space, 1024 bytes/sector. - -=item C - -5.25" floppy, 180KB total space, 512 bytes/sector. - -=item C - -5.25" floppy, 160KB total space, 512 bytes/sector. - -=item C - -Some type of removable media other than a floppy diskette. - -=item C - -A fixed hard disk. - -=item C - -3.5" floppy, 120MB total space. - -=back - -=item C<":MOVEFILE_"> - -Constants for use in C<$uFlags> arguments to C. - - MOVEFILE_COPY_ALLOWED MOVEFILE_DELAY_UNTIL_REBOOT - MOVEFILE_REPLACE_EXISTING MOVEFILE_WRITE_THROUGH - -=item C<":SECURITY_"> - -Security quality of service values that can be used in the C<$uFlags> -argument to C if opening the client side of a named pipe. - - SECURITY_ANONYMOUS SECURITY_CONTEXT_TRACKING - SECURITY_DELEGATION SECURITY_EFFECTIVE_ONLY - SECURITY_IDENTIFICATION SECURITY_IMPERSONATION - SECURITY_SQOS_PRESENT - -=item C<":SEM_"> - -Constants to be used with C. - - SEM_FAILCRITICALERRORS SEM_NOGPFAULTERRORBOX - SEM_NOALIGNMENTFAULTEXCEPT SEM_NOOPENFILEERRORBOX - -=item C<":PARTITION_"> - -Constants describing partition types. - - PARTITION_ENTRY_UNUSED PARTITION_FAT_12 - PARTITION_XENIX_1 PARTITION_XENIX_2 - PARTITION_FAT_16 PARTITION_EXTENDED - PARTITION_HUGE PARTITION_IFS - PARTITION_FAT32 PARTITION_FAT32_XINT13 - PARTITION_XINT13 PARTITION_XINT13_EXTENDED - PARTITION_PREP PARTITION_UNIX - VALID_NTFT PARTITION_NTFT - -=item C<":ALL"> - -All of the above. - -=back - -=head1 BUGS - -None known at this time. - -=head1 AUTHOR - -Tye McQueen, tye@metronet.com, http://www.metronet.com/~tye/. - -=head1 SEE ALSO - -The pyramids. - -=cut diff --git a/win32/ext/Win32API/File/File.xs b/win32/ext/Win32API/File/File.xs deleted file mode 100644 index 7dbe783c0e..0000000000 --- a/win32/ext/Win32API/File/File.xs +++ /dev/null @@ -1,647 +0,0 @@ -/* Win32API/File.xs */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -/*#include "patchlevel.h"*/ - -/* Uncomment the next line unless set "WRITE_PERL=>1" in Makefile.PL: */ -#define NEED_newCONSTSUB -#include "ppport.h" - -#ifdef WORD -# undef WORD -#endif - -#define WIN32_LEAN_AND_MEAN /* Tell windows.h to skip much */ -#include -#include - -/*CONSTS_DEFINED*/ - -#ifndef INVALID_SET_FILE_POINTER -# define INVALID_SET_FILE_POINTER ((DWORD)-1) -#endif - -#define oDWORD DWORD - -#if (PERL_REVISION <= 5 && PERL_VERSION < 5) || defined(__CYGWIN__) -# define win32_get_osfhandle _get_osfhandle -# ifdef __CYGWIN__ -# define win32_open_osfhandle(handle,mode) \ - (Perl_croak(aTHX_ "_open_osfhandle not implemented on Cygwin!"), -1) -# else -# define win32_open_osfhandle _open_osfhandle -# endif -# ifdef _get_osfhandle -# undef _get_osfhandle /* stolen_get_osfhandle() isn't available here */ -# endif -# ifdef _open_osfhandle -# undef _open_osfhandle /* stolen_open_osfhandle() isn't available here */ -# endif -#endif - -#ifndef XST_mUV -# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) -#endif - -#ifndef XSRETURN_UV -# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END -#endif - -#ifndef DEBUGGING -# define Debug(list) /*Nothing*/ -#else -# define Debug(list) ErrPrintf list -# include - static void - ErrPrintf( const char *sFmt, ... ) - { - va_list pAList; - static char *sEnv= NULL; - DWORD uErr= GetLastError(); - if( NULL == sEnv ) { - if( NULL == ( sEnv= getenv("DEBUG_WIN32API_FILE") ) ) - sEnv= ""; - } - if( '\0' == *sEnv ) - return; - va_start( pAList, sFmt ); - vfprintf( stderr, sFmt, pAList ); - va_end( pAList ); - SetLastError( uErr ); - } -#endif /* DEBUGGING */ - - -#include "buffers.h" /* Include this after DEBUGGING setup finished */ - -static LONG uLastFileErr= 0; - -static void -SaveErr( BOOL bFailed ) -{ - if( bFailed ) { - uLastFileErr= GetLastError(); - } -} - -MODULE = Win32API::File PACKAGE = Win32API::File - -PROTOTYPES: DISABLE - - -LONG -_fileLastError( uError=0 ) - DWORD uError - CODE: - if( 1 <= items ) { - uLastFileErr= uError; - } - RETVAL= uLastFileErr; - OUTPUT: - RETVAL - - -BOOL -CloseHandle( hObject ) - HANDLE hObject - CODE: - RETVAL = CloseHandle( hObject ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -BOOL -CopyFileA( sOldFileName, sNewFileName, bFailIfExists ) - char * sOldFileName - char * sNewFileName - BOOL bFailIfExists - CODE: - RETVAL = CopyFileA( sOldFileName, sNewFileName, bFailIfExists ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -BOOL -CopyFileW( swOldFileName, swNewFileName, bFailIfExists ) - WCHAR * swOldFileName - WCHAR * swNewFileName - BOOL bFailIfExists - CODE: - RETVAL = CopyFileW( swOldFileName, swNewFileName, bFailIfExists ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -HANDLE -CreateFileA( sPath, uAccess, uShare, pSecAttr, uCreate, uFlags, hModel ) - char * sPath - DWORD uAccess - DWORD uShare - void * pSecAttr - DWORD uCreate - DWORD uFlags - HANDLE hModel - CODE: - RETVAL= CreateFileA( sPath, uAccess, uShare, - pSecAttr, uCreate, uFlags, hModel ); - if( INVALID_HANDLE_VALUE == RETVAL ) { - SaveErr( 1 ); - XSRETURN_NO; - } else if( 0 == RETVAL ) { - XSRETURN_PV( "0 but true" ); - } else { - XSRETURN_UV( PTR2UV(RETVAL) ); - } - - -HANDLE -CreateFileW( swPath, uAccess, uShare, pSecAttr, uCreate, uFlags, hModel ) - WCHAR * swPath - DWORD uAccess - DWORD uShare - void * pSecAttr - DWORD uCreate - DWORD uFlags - HANDLE hModel - CODE: - RETVAL= CreateFileW( swPath, uAccess, uShare, - pSecAttr, uCreate, uFlags, hModel ); - if( INVALID_HANDLE_VALUE == RETVAL ) { - SaveErr( 1 ); - XSRETURN_NO; - } else if( 0 == RETVAL ) { - XSRETURN_PV( "0 but true" ); - } else { - XSRETURN_UV( PTR2UV(RETVAL) ); - } - - -BOOL -DefineDosDeviceA( uFlags, sDosDeviceName, sTargetPath ) - DWORD uFlags - char * sDosDeviceName - char * sTargetPath - CODE: - RETVAL = DefineDosDeviceA( uFlags, sDosDeviceName, sTargetPath ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -BOOL -DefineDosDeviceW( uFlags, swDosDeviceName, swTargetPath ) - DWORD uFlags - WCHAR * swDosDeviceName - WCHAR * swTargetPath - CODE: - RETVAL = DefineDosDeviceW( uFlags, swDosDeviceName, swTargetPath ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -BOOL -DeleteFileA( sFileName ) - char * sFileName - CODE: - RETVAL = DeleteFileA( sFileName ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -BOOL -DeleteFileW( swFileName ) - WCHAR * swFileName - CODE: - RETVAL = DeleteFileW( swFileName ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -BOOL -DeviceIoControl( hDevice, uIoControlCode, pInBuf, lInBuf, opOutBuf, lOutBuf, olRetBytes, pOverlapped ) - HANDLE hDevice - DWORD uIoControlCode - char * pInBuf - DWORD lInBuf = init_buf_l($arg); - char * opOutBuf = NO_INIT - DWORD lOutBuf = init_buf_l($arg); - oDWORD &olRetBytes - void * pOverlapped - CODE: - if( NULL != pInBuf ) { - if( 0 == lInBuf ) { - lInBuf= SvCUR(ST(2)); - } else if( SvCUR(ST(2)) < lInBuf ) { - croak( "%s: pInBuf shorter than specified (%d < %d)", - "Win32API::File::DeviceIoControl", SvCUR(ST(2)), lInBuf ); - } - } - grow_buf_l( opOutBuf,ST(4),char *, lOutBuf,ST(5) ); - RETVAL= DeviceIoControl( hDevice, uIoControlCode, pInBuf, lInBuf, - opOutBuf, lOutBuf, &olRetBytes, pOverlapped ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - opOutBuf trunc_buf_l( RETVAL, opOutBuf,ST(4), olRetBytes ); - olRetBytes - - -HANDLE -FdGetOsFHandle( ivFd ) - int ivFd - CODE: - RETVAL= (HANDLE) win32_get_osfhandle( ivFd ); - SaveErr( INVALID_HANDLE_VALUE == RETVAL ); - OUTPUT: - RETVAL - - -DWORD -GetDriveTypeA( sRootPath ) - char * sRootPath - CODE: - RETVAL = GetDriveTypeA( sRootPath ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -DWORD -GetDriveTypeW( swRootPath ) - WCHAR * swRootPath - CODE: - RETVAL = GetDriveTypeW( swRootPath ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -DWORD -GetFileAttributesA( sPath ) - char * sPath - CODE: - RETVAL = GetFileAttributesA( sPath ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -DWORD -GetFileAttributesW( swPath ) - WCHAR * swPath - CODE: - RETVAL = GetFileAttributesW( swPath ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -DWORD -GetFileType( hFile ) - HANDLE hFile - CODE: - RETVAL = GetFileType( hFile ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -BOOL -GetHandleInformation( hObject, ouFlags ) - HANDLE hObject - oDWORD * ouFlags - CODE: - RETVAL = GetHandleInformation( hObject, ouFlags ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - ouFlags - - -DWORD -GetLogicalDrives() - CODE: - RETVAL = GetLogicalDrives(); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -DWORD -GetLogicalDriveStringsA( lBufSize, osBuffer ) - DWORD lBufSize = init_buf_l($arg); - char * osBuffer = NO_INIT - CODE: - grow_buf_l( osBuffer,ST(1),char *, lBufSize,ST(0) ); - RETVAL= GetLogicalDriveStringsA( lBufSize, osBuffer ); - if( lBufSize < RETVAL && autosize(ST(0)) ) { - lBufSize= RETVAL; - grow_buf_l( osBuffer,ST(1),char *, lBufSize,ST(0) ); - RETVAL= GetLogicalDriveStringsA( lBufSize, osBuffer ); - } - if( 0 == RETVAL || lBufSize < RETVAL ) { - SaveErr( 1 ); - } else { - trunc_buf_l( 1, osBuffer,ST(1), RETVAL ); - } - OUTPUT: - RETVAL - osBuffer ;/* The code for this appears above. */ - - -DWORD -GetLogicalDriveStringsW( lwBufSize, oswBuffer ) - DWORD lwBufSize = init_buf_lw($arg); - WCHAR * oswBuffer = NO_INIT - CODE: - grow_buf_lw( oswBuffer,ST(1), lwBufSize,ST(0) ); - RETVAL= GetLogicalDriveStringsW( lwBufSize, oswBuffer ); - if( lwBufSize < RETVAL && autosize(ST(0)) ) { - lwBufSize= RETVAL; - grow_buf_lw( oswBuffer,ST(1), lwBufSize,ST(0) ); - RETVAL= GetLogicalDriveStringsW( lwBufSize, oswBuffer ); - } - if( 0 == RETVAL || lwBufSize < RETVAL ) { - SaveErr( 1 ); - } else { - trunc_buf_lw( 1, oswBuffer,ST(1), RETVAL ); - } - OUTPUT: - RETVAL - oswBuffer ;/* The code for this appears above. */ - - -BOOL -GetVolumeInformationA( sRootPath, osVolName, lVolName, ouSerialNum, ouMaxNameLen, ouFsFlags, osFsType, lFsType ) - char * sRootPath - char * osVolName = NO_INIT - DWORD lVolName = init_buf_l($arg); - oDWORD &ouSerialNum = optUV($arg); - oDWORD &ouMaxNameLen = optUV($arg); - oDWORD &ouFsFlags = optUV($arg); - char * osFsType = NO_INIT - DWORD lFsType = init_buf_l($arg); - CODE: - grow_buf_l( osVolName,ST(1),char *, lVolName,ST(2) ); - grow_buf_l( osFsType,ST(6),char *, lFsType,ST(7) ); - RETVAL= GetVolumeInformationA( sRootPath, osVolName, lVolName, - &ouSerialNum, &ouMaxNameLen, &ouFsFlags, osFsType, lFsType ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - osVolName trunc_buf_z( RETVAL, osVolName,ST(1) ); - osFsType trunc_buf_z( RETVAL, osFsType,ST(6) ); - ouSerialNum - ouMaxNameLen - ouFsFlags - - -BOOL -GetVolumeInformationW( swRootPath, oswVolName, lwVolName, ouSerialNum, ouMaxNameLen, ouFsFlags, oswFsType, lwFsType ) - WCHAR * swRootPath - WCHAR * oswVolName = NO_INIT - DWORD lwVolName = init_buf_lw($arg); - oDWORD &ouSerialNum = optUV($arg); - oDWORD &ouMaxNameLen = optUV($arg); - oDWORD &ouFsFlags = optUV($arg); - WCHAR * oswFsType = NO_INIT - DWORD lwFsType = init_buf_lw($arg); - CODE: - grow_buf_lw( oswVolName,ST(1), lwVolName,ST(2) ); - grow_buf_lw( oswFsType,ST(6), lwFsType,ST(7) ); - RETVAL= GetVolumeInformationW( swRootPath, oswVolName, lwVolName, - &ouSerialNum, &ouMaxNameLen, &ouFsFlags, oswFsType, lwFsType ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - oswVolName trunc_buf_zw( RETVAL, oswVolName,ST(1) ); - oswFsType trunc_buf_zw( RETVAL, oswFsType,ST(6) ); - ouSerialNum - ouMaxNameLen - ouFsFlags - - -BOOL -IsRecognizedPartition( ivPartitionType ) - int ivPartitionType - CODE: - RETVAL = IsRecognizedPartition( ivPartitionType ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -BOOL -IsContainerPartition( ivPartitionType ) - int ivPartitionType - CODE: - RETVAL = IsContainerPartition( ivPartitionType ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -BOOL -MoveFileA( sOldName, sNewName ) - char * sOldName - char * sNewName - CODE: - RETVAL = MoveFileA( sOldName, sNewName ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -BOOL -MoveFileW( swOldName, swNewName ) - WCHAR * swOldName - WCHAR * swNewName - CODE: - RETVAL = MoveFileW( swOldName, swNewName ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -BOOL -MoveFileExA( sOldName, sNewName, uFlags ) - char * sOldName - char * sNewName - DWORD uFlags - CODE: - RETVAL = MoveFileExA( sOldName, sNewName, uFlags ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -BOOL -MoveFileExW( swOldName, swNewName, uFlags ) - WCHAR * swOldName - WCHAR * swNewName - DWORD uFlags - CODE: - RETVAL = MoveFileExW( swOldName, swNewName, uFlags ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -long -OsFHandleOpenFd( hOsFHandle, uMode ) - long hOsFHandle - DWORD uMode - CODE: - RETVAL= win32_open_osfhandle( hOsFHandle, uMode ); - if( RETVAL < 0 ) { - SaveErr( 1 ); - XSRETURN_NO; - } else if( 0 == RETVAL ) { - XSRETURN_PV( "0 but true" ); - } else { - XSRETURN_IV( (IV) RETVAL ); - } - - -DWORD -QueryDosDeviceA( sDeviceName, osTargetPath, lTargetBuf ) - char * sDeviceName - char * osTargetPath = NO_INIT - DWORD lTargetBuf = init_buf_l($arg); - CODE: - grow_buf_l( osTargetPath,ST(1),char *, lTargetBuf,ST(2) ); - RETVAL= QueryDosDeviceA( sDeviceName, osTargetPath, lTargetBuf ); - SaveErr( 0 == RETVAL ); - OUTPUT: - RETVAL - osTargetPath trunc_buf_l( 1, osTargetPath,ST(1), RETVAL ); - - -DWORD -QueryDosDeviceW( swDeviceName, oswTargetPath, lwTargetBuf ) - WCHAR * swDeviceName - WCHAR * oswTargetPath = NO_INIT - DWORD lwTargetBuf = init_buf_lw($arg); - CODE: - grow_buf_lw( oswTargetPath,ST(1), lwTargetBuf,ST(2) ); - RETVAL= QueryDosDeviceW( swDeviceName, oswTargetPath, lwTargetBuf ); - SaveErr( 0 == RETVAL ); - OUTPUT: - RETVAL - oswTargetPath trunc_buf_lw( 1, oswTargetPath,ST(1), RETVAL ); - - -BOOL -ReadFile( hFile, opBuffer, lBytes, olBytesRead, pOverlapped ) - HANDLE hFile - BYTE * opBuffer = NO_INIT - DWORD lBytes = init_buf_l($arg); - oDWORD &olBytesRead - void * pOverlapped - CODE: - grow_buf_l( opBuffer,ST(1),BYTE *, lBytes,ST(2) ); - /* Don't read more bytes than asked for if buffer is already big: */ - lBytes= init_buf_l(ST(2)); - if( 0 == lBytes && autosize(ST(2)) ) { - lBytes= SvLEN( ST(1) ) - 1; - } - RETVAL= ReadFile( hFile, opBuffer, lBytes, &olBytesRead, pOverlapped ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - opBuffer trunc_buf_l( RETVAL, opBuffer,ST(1), olBytesRead ); - olBytesRead - - -BOOL -GetOverlappedResult( hFile, lpOverlapped, lpNumberOfBytesTransferred, bWait) - HANDLE hFile - LPOVERLAPPED lpOverlapped - LPDWORD lpNumberOfBytesTransferred - BOOL bWait - CODE: - RETVAL= GetOverlappedResult( hFile, lpOverlapped, - lpNumberOfBytesTransferred, bWait); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - lpOverlapped - lpNumberOfBytesTransferred - -DWORD -GetFileSize( hFile, lpFileSizeHigh ) - HANDLE hFile - LPDWORD lpFileSizeHigh - CODE: - RETVAL= GetFileSize( hFile, lpFileSizeHigh ); - SaveErr( NO_ERROR != GetLastError() ); - OUTPUT: - RETVAL - lpFileSizeHigh - -UINT -SetErrorMode( uNewMode ) - UINT uNewMode - - -LONG -SetFilePointer( hFile, ivOffset, ioivOffsetHigh, uFromWhere ) - HANDLE hFile - LONG ivOffset - LONG * ioivOffsetHigh - DWORD uFromWhere - CODE: - RETVAL= SetFilePointer( hFile, ivOffset, ioivOffsetHigh, uFromWhere ); - if( RETVAL == INVALID_SET_FILE_POINTER && (GetLastError() != NO_ERROR) ) { - SaveErr( 1 ); - XST_mNO(0); - } else if( 0 == RETVAL ) { - XST_mPV(0,"0 but true"); - } else { - XST_mIV(0,RETVAL); - } - OUTPUT: - ioivOffsetHigh - - -BOOL -SetHandleInformation( hObject, uMask, uFlags ) - HANDLE hObject - DWORD uMask - DWORD uFlags - CODE: - RETVAL = SetHandleInformation( hObject, uMask, uFlags ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - - -BOOL -WriteFile( hFile, pBuffer, lBytes, ouBytesWritten, pOverlapped ) - HANDLE hFile - BYTE * pBuffer - DWORD lBytes = init_buf_l($arg); - oDWORD &ouBytesWritten - void * pOverlapped - CODE: - /* SvCUR(ST(1)) might "panic" if pBuffer isn't valid */ - if( 0 == lBytes ) { - lBytes= SvCUR(ST(1)); - } else if( SvCUR(ST(1)) < lBytes ) { - croak( "%s: pBuffer value too short (%d < %d)", - "Win32API::File::WriteFile", SvCUR(ST(1)), lBytes ); - } - RETVAL= WriteFile( hFile, pBuffer, lBytes, - &ouBytesWritten, pOverlapped ); - SaveErr( !RETVAL ); - OUTPUT: - RETVAL - ouBytesWritten diff --git a/win32/ext/Win32API/File/Makefile.PL b/win32/ext/Win32API/File/Makefile.PL deleted file mode 100644 index c84d1de4cd..0000000000 --- a/win32/ext/Win32API/File/Makefile.PL +++ /dev/null @@ -1,127 +0,0 @@ -#!/usr/bin/perl -w -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. -WriteMakefile( - 'NAME' => 'Win32API::File', - 'VERSION_FROM' => 'File.pm', # finds $VERSION - ( $Config{archname} =~ /-object\b/i ? ( 'CAPI' => 'TRUE' ) : () ), - ( $] < 5.005 ? () : - ( 'AUTHOR' => 'Tye McQueen ', - 'ABSTRACT_FROM' => 'File.pm' ) - ), - 'postamble' => { IMPORT_LIST => [qw(/._/ !/[a-z]/ :MEDIA_TYPE)], - IFDEF => "!/[a-z\\d]/", - CPLUSPLUS => 1, - WRITE_PERL => 1, - # Comment out next line to rebuild constants defs: - NO_REBUILD => 1, - }, - ( ! $Config{libperl} ? () : ( LIBPERL_A => $Config{libperl} ) ), -); - -# 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 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 . '}= ' - . 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.\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\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 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); -} diff --git a/win32/ext/Win32API/File/README b/win32/ext/Win32API/File/README deleted file mode 100644 index c460844d4d..0000000000 --- a/win32/ext/Win32API/File/README +++ /dev/null @@ -1,133 +0,0 @@ -Win32API::File v0.08 -- Low-level access to Win32 API calls for files. - -New since v0.07: - - GetHandleInformation SetHandleInformation - HANDLE_FLAG_INHERIT HANDLE_FLAG_PROTECT_FROM_CLOSE - fileConstant fileLastError - -Low-level and full-power access to the following routines are provided: - - CloseHandle CopyFile CreateFile - DefineDosDevice DeleteFile DeviceIoControl - GetDriveType GetFileType GetHandleInformation - GetLogicalDrives GetLogicalDriveStrings GetVolumeInformation - IsRecognizedPartition IsContainerPartition MoveFile - MoveFileEx QueryDosDevice ReadFile - SetFilePointer SetErrorMode SetHandleInformation - WriteFile - -Plus the Unicode versions: - - CopyFileW CreateFileW DefineDosDeviceW - DeleteFileW GetDriveTypeW GetLogicalDriveStringsW - GetVolumeInformationW MoveFileW MoveFileExW - QueryDosDeviceW - -Full conversion between Win32-native file handles and Perl file handles is -also supported. Access to the following C run-time library routines [or at -least the Perl run-time library wrappers for them] is provided: - - _get_osfhandle or win32_get_osfhandle as FdGetOsFHandle - _open_osfhandle or win32_open_osfhandle as OsFHandleOpenFd - -The following Perl-friendly wrappers and helper functions are also provided: - - OsFHandleOpen GetOsFHandle attrLetsToBits - createFile fileConstant fileLastError - getLogicalDrives - -Plus the following constants: - - CREATE_ALWAYS CREATE_NEW FILE_BEGIN - FILE_CURRENT FILE_END INVALID_HANDLE_VALUE - OPEN_ALWAYS OPEN_EXISTING TRUNCATE_EXISTING - - DDD_EXACT_MATCH_ON_REMOVE DDD_RAW_TARGET_PATH - DDD_REMOVE_DEFINITION - - DRIVE_UNKNOWN DRIVE_NO_ROOT_DIR DRIVE_REMOVABLE - DRIVE_FIXED DRIVE_REMOTE DRIVE_CDROM - DRIVE_RAMDISK - - FILE_READ_DATA FILE_LIST_DIRECTORY - FILE_WRITE_DATA FILE_ADD_FILE - FILE_APPEND_DATA FILE_ADD_SUBDIRECTORY - FILE_CREATE_PIPE_INSTANCE FILE_READ_EA - FILE_WRITE_EA FILE_EXECUTE - FILE_TRAVERSE FILE_DELETE_CHILD - FILE_READ_ATTRIBUTES FILE_WRITE_ATTRIBUTES - FILE_ALL_ACCESS FILE_GENERIC_READ - FILE_GENERIC_WRITE FILE_GENERIC_EXECUTE - - FILE_ATTRIBUTE_ARCHIVE FILE_ATTRIBUTE_COMPRESSED - FILE_ATTRIBUTE_HIDDEN FILE_ATTRIBUTE_NORMAL - FILE_ATTRIBUTE_OFFLINE FILE_ATTRIBUTE_READONLY - FILE_ATTRIBUTE_SYSTEM FILE_ATTRIBUTE_TEMPORARY - - FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_DELETE_ON_CLOSE - FILE_FLAG_NO_BUFFERING FILE_FLAG_OVERLAPPED - FILE_FLAG_POSIX_SEMANTICS FILE_FLAG_RANDOM_ACCESS - FILE_FLAG_SEQUENTIAL_SCAN FILE_FLAG_WRITE_THROUGH - - FILE_SHARE_DELETE FILE_SHARE_READ FILE_SHARE_WRITE - - FILE_TYPE_CHAR FILE_TYPE_DISK FILE_TYPE_PIPE - FILE_TYPE_UNKNOWN - - FS_CASE_IS_PRESERVED FS_CASE_SENSITIVE - FS_UNICODE_STORED_ON_DISK FS_PERSISTENT_ACLS - FS_FILE_COMPRESSION FS_VOL_IS_COMPRESSED - - HANDLE_FLAG_INHERIT HANDLE_FLAG_PROTECT_FROM_CLOSE - - IOCTL_STORAGE_CHECK_VERIFY IOCTL_STORAGE_MEDIA_REMOVAL - IOCTL_STORAGE_EJECT_MEDIA IOCTL_STORAGE_LOAD_MEDIA - IOCTL_STORAGE_RESERVE IOCTL_STORAGE_RELEASE - IOCTL_STORAGE_FIND_NEW_DEVICES IOCTL_STORAGE_GET_MEDIA_TYPES - - IOCTL_DISK_GET_DRIVE_GEOMETRY IOCTL_DISK_GET_PARTITION_INFO - IOCTL_DISK_SET_PARTITION_INFO IOCTL_DISK_GET_DRIVE_LAYOUT - IOCTL_DISK_SET_DRIVE_LAYOUT IOCTL_DISK_VERIFY - IOCTL_DISK_FORMAT_TRACKS IOCTL_DISK_REASSIGN_BLOCKS - IOCTL_DISK_PERFORMANCE IOCTL_DISK_IS_WRITABLE - IOCTL_DISK_LOGGING IOCTL_DISK_FORMAT_TRACKS_EX - IOCTL_DISK_HISTOGRAM_STRUCTURE IOCTL_DISK_HISTOGRAM_DATA - IOCTL_DISK_HISTOGRAM_RESET IOCTL_DISK_REQUEST_STRUCTURE - IOCTL_DISK_REQUEST_DATA - - GENERIC_ALL GENERIC_EXECUTE - GENERIC_READ GENERIC_WRITE - - Unknown F5_1Pt2_512 F3_1Pt44_512 - F3_2Pt88_512 F3_20Pt8_512 F3_720_512 - F5_360_512 F5_320_512 F5_320_1024 - F5_180_512 F5_160_512 RemovableMedia - FixedMedia F3_120M_512 - - MOVEFILE_COPY_ALLOWED MOVEFILE_DELAY_UNTIL_REBOOT - MOVEFILE_REPLACE_EXISTING MOVEFILE_WRITE_THROUGH - - SECURITY_ANONYMOUS SECURITY_CONTEXT_TRACKING - SECURITY_DELEGATION SECURITY_EFFECTIVE_ONLY - SECURITY_IDENTIFICATION SECURITY_IMPERSONATION - SECURITY_SQOS_PRESENT - - SEM_FAILCRITICALERRORS SEM_NOGPFAULTERRORBOX - SEM_NOALIGNMENTFAULTEXCEPT SEM_NOOPENFILEERRORBOX - - PARTITION_ENTRY_UNUSED PARTITION_FAT_12 - PARTITION_XENIX_1 PARTITION_XENIX_2 - PARTITION_FAT_16 PARTITION_EXTENDED - PARTITION_HUGE PARTITION_IFS - PARTITION_FAT32 PARTITION_FAT32_XINT13 - PARTITION_XINT13 PARTITION_XINT13_EXTENDED - PARTITION_PREP PARTITION_UNIX - VALID_NTFT PARTITION_NTFT - -Comments, additions, and bug reports are welcomed. Please address -technical questions that are not full bug reports to - -http://perlmonks.org/index.pl?node=Seekers%20of%20Perl%20Wisdom - -Tye McQueen, tye@metronet.com, http://www.metronet.com/~tye/. diff --git a/win32/ext/Win32API/File/buffers.h b/win32/ext/Win32API/File/buffers.h deleted file mode 100644 index 2ae74e690b..0000000000 --- a/win32/ext/Win32API/File/buffers.h +++ /dev/null @@ -1,423 +0,0 @@ -/* 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 substract 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 - * 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 alloated 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 initialied with C<= NO_INIT> [or C<= NULL;>]. - * - * See also the F file. C, for example, is for an output- - * only parameter of type C and you should simply C<#define> it to be - * C. In F, C is treated differently than C - * in two ways. - * - * First, if C is passed in, a C could generate a warning - * when it gets converted to 0 while C will never generate such a - * warning for C. 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 to 0 without - * ever producing a warning. - * - * Second, passing in a read-only SV for a C parameter will generate - * a fatal error on output when we try to update the SV. For C, 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 paremter is listed in - * the OUTPUT: section without specific output instructions. We define - * no macros for outputing buffer length parameters so be careful to use - * C [for example] for them if and only if they are output-only. - * - * Note that C is the same as C 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 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 in place of C. The only possible - * advantage would be that C would be passed in for C if - * _both_ C<$oswText> and C<$iolwText> were specified as C<[]>. The *_pl*() - * macros are defined [and C specified in F] 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 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 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(expr) - *# else*/ -# define CAST(type,expr) (type)(expr) -/*# endif - *#endif*/ - -/* Is an argument C<[]>, meaning we should pass C? */ -#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(sv,PL_na) ) - -/* 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(sv,PL_na) && '=' == *SvPV(sv,PL_na) )) - -/* Get the IV/UV for a parameter that might be C<[]> or C: */ -#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(svSize,PL_na), 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, 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 poitner 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 poitner 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 diff --git a/win32/ext/Win32API/File/cFile.h b/win32/ext/Win32API/File/cFile.h deleted file mode 100644 index 23e7ed89f5..0000000000 --- a/win32/ext/Win32API/File/cFile.h +++ /dev/null @@ -1 +0,0 @@ -/* Would contain C code to generate Perl constants if not using cFile.pc */ diff --git a/win32/ext/Win32API/File/cFile.pc b/win32/ext/Win32API/File/cFile.pc deleted file mode 100644 index da00f413aa..0000000000 --- a/win32/ext/Win32API/File/cFile.pc +++ /dev/null @@ -1,165 +0,0 @@ -# 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 } -1; diff --git a/win32/ext/Win32API/File/const2perl.h b/win32/ext/Win32API/File/const2perl.h deleted file mode 100644 index dbd94c10a8..0000000000 --- a/win32/ext/Win32API/File/const2perl.h +++ /dev/null @@ -1,193 +0,0 @@ -/* 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 /* Probably already included, but shouldn't hurt */ -# include /* 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 -// { -// 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 */ diff --git a/win32/ext/Win32API/File/t/file.t b/win32/ext/Win32API/File/t/file.t deleted file mode 100644 index f7f16c5744..0000000000 --- a/win32/ext/Win32API/File/t/file.t +++ /dev/null @@ -1,408 +0,0 @@ -#!/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; print "1..267\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 Win32API::File qw(:ALL); -$loaded = 1; -print "ok 1\n"; - -######################### End of black magic. - -$test= 1; - -use strict qw(subs); - -$temp= $ENV{"TMP"}; -$temp= $ENV{"TEMP"} unless -d $temp; -$temp= "C:/Temp" unless -d $temp; -$temp= "." unless -d $temp; -$dir= "W32ApiF.tmp"; - -$ENV{WINDIR} = $ENV{SYSTEMROOT} if not exists $ENV{WINDIR}; - -chdir( $temp ) - or die "# Can't cd to temp directory, $temp: $!\n"; - -if( -d $dir ) { - print "# deleting $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, $temp/$dir: $!\n"; -print "# chdir $temp\\$dir\n"; -chdir( $dir ) - or die "# Can't cd to my dir, $temp/$dir: $!\n"; - -$h1= createFile( "ReadOnly.txt", "r", { Attributes=>"r" } ); -$ok= ! $h1 && fileLastError() =~ /not find the file?/i; -$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 && fileLastError() =~ /file exists?/i; -$ok or print "# ",fileLastError(),"\n"; -print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 5 -if( ! $ok ) { CloseHandle($h2); } - -$h2= createFile( "ReadOnly.txt", "rwke" ); -$ok= ! $h2 && fileLastError() =~ /access is denied?/i; -$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 .\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, [] ) - && fileLastError() =~ /handle is invalid?/i; -$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 \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( $h1 ); - -$ok= ! DeleteFile( "ReadOnly.txt" ) - && fileLastError() =~ /access is denied?/i; -$ok or print "# ",fileLastError(),"\n"; -print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 23 - -$ok= ! CopyFile( "ReadOnly.txt", "CanWrite.txt", 1 ) - && fileLastError() =~ /file exists?/i; -$ok or print "# ",fileLastError(),"\n"; -print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 24 - -$ok= ! CopyFile( "CanWrite.txt", "ReadOnly.txt", 0 ) - && fileLastError() =~ /access is denied?/i; -$ok or print "# ",fileLastError(),"\n"; -print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 25 - -$ok= ! MoveFile( "NoSuchFile", "NoSuchDest" ) - && fileLastError() =~ /not find the file/i; -$ok or print "# ",fileLastError(),"\n"; -print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 26 - -$ok= ! MoveFileEx( "NoSuchFile", "NoSuchDest", 0 ) - && fileLastError() =~ /not find the file/i; -$ok or print "# ",fileLastError(),"\n"; -print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 27 - -$ok= ! MoveFile( "ReadOnly.txt", "CanWrite.txt" ) - && fileLastError() =~ /file already exists?/i; -$ok or print "# ",fileLastError(),"\n"; -print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 28 - -$ok= ! MoveFileEx( "ReadOnly.txt", "CanWrite.txt", 0 ) - && fileLastError() =~ /file already exists?/i; -$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 ) - && fileLastError() =~ /access is denied?|cannot create/i; -$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" ) - && fileLastError() =~ /access is denied?/i; -$ok or print "# ",fileLastError(),"\n"; -print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 35 - -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 - -$ok= -f $let.substr($ENV{WINDIR},3)."/win.ini"; -$ok or print "# ",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 $path = $ENV{WINDIR}; -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__ diff --git a/win32/ext/Win32API/File/t/tie.t b/win32/ext/Win32API/File/t/tie.t deleted file mode 100644 index ec2f7c2cf9..0000000000 --- a/win32/ext/Win32API/File/t/tie.t +++ /dev/null @@ -1,79 +0,0 @@ -#!perl -# vim:syntax=perl: - -BEGIN { $|= 1; print "1..10\n"; } -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"; - -unlink "foo.txt"; - -my $fh = new Win32API::File "+> foo.txt" - or die fileLastError(); - -my $tell = tell $fh; -print "# tell \$fh == '$tell'\n"; -print "not " unless - tell $fh == 0; -print "ok 2\n"; - -my $text = "some text\n"; - -print "not " unless - print $fh $text; -print "ok 3\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"; - -print "not " unless - seek($fh, 0, 0) == 0; -print "ok 5\n"; - -print "not " unless - not eof $fh; -print "ok 6\n"; - -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"; - -print "not " unless - eof $fh; -print "ok 8\n"; - -print "not " unless - close $fh; -print "ok 9\n"; - -# Test out binmode (should be only LF with print, no CR). - -$fh = new Win32API::File "+> foo.txt" - 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"; - -close $fh; - -unlink "foo.txt"; diff --git a/win32/ext/Win32API/File/typemap b/win32/ext/Win32API/File/typemap deleted file mode 100644 index d5957652f9..0000000000 --- a/win32/ext/Win32API/File/typemap +++ /dev/null @@ -1,140 +0,0 @@ -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( $arg, PL_na ) -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) ); diff --git a/win32/makefile.mk b/win32/makefile.mk index 7b6a1d35c9..aba1945e11 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -938,7 +938,7 @@ SETARGV_OBJ = setargv$(o) # specify static extensions here #STATIC_EXT = Cwd Compress/Raw/Zlib -STATIC_EXT = +STATIC_EXT = Win32CORE DYNALOADER = $(EXTDIR)\DynaLoader\DynaLoader @@ -1336,26 +1336,26 @@ MakePPPort_clean: Extensions : buildext.pl $(PERLDEP) $(CONFIGPM) $(XCOPY) ..\*.h $(COREDIR)\*.* $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --dynamic - $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic + -if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic Extensions_reonly : buildext.pl $(PERLDEP) $(CONFIGPM) $(XCOPY) ..\*.h $(COREDIR)\*.* $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --dynamic +re - $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic +re + -if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic +re Extensions_static : buildext.pl $(PERLDEP) $(CONFIGPM) $(XCOPY) ..\*.h $(COREDIR)\*.* $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --static - $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --static + -if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --static $(MINIPERL) -I..\lib buildext.pl --list-static-libs > Extensions_static Extensions_clean : -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) clean - -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext clean + -if exist $(MINIPERL) if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext clean Extensions_realclean : -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) realclean - -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext realclean + -if exist $(MINIPERL) if exist ext $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext realclean #------------------------------------------------------------------------------- diff --git a/win32/win32.c b/win32/win32.c index cbd3a36399..aacc656da8 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -4561,73 +4561,21 @@ XS(w32_SetChildShowWindow) XSRETURN(1); } -static void -forward(pTHX_ const char *function) -{ - dXSARGS; - Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn("Win32",5), newSVnv(0.27)); - SPAGAIN; - PUSHMARK(SP-items); - call_pv(function, GIMME_V); -} - -#define FORWARD(function) XS(w32_##function){ forward(aTHX_ "Win32::"#function); } -FORWARD(GetCwd) -FORWARD(SetCwd) -FORWARD(GetNextAvailDrive) -FORWARD(GetLastError) -FORWARD(SetLastError) -FORWARD(LoginName) -FORWARD(NodeName) -FORWARD(DomainName) -FORWARD(FsType) -FORWARD(GetOSVersion) -FORWARD(IsWinNT) -FORWARD(IsWin95) -FORWARD(FormatMessage) -FORWARD(Spawn) -FORWARD(GetTickCount) -FORWARD(GetShortPathName) -FORWARD(GetFullPathName) -FORWARD(GetLongPathName) -FORWARD(CopyFile) -FORWARD(Sleep) - -/* Don't forward Win32::SetChildShowWindow(). It accesses the internal variable - * w32_showwindow in thread_intern and is therefore not implemented in Win32.xs. - */ -/* FORWARD(SetChildShowWindow) */ - -#undef FORWARD - void Perl_init_os_extras(void) { dTHX; char *file = __FILE__; + CV *cv; dXSUB_SYS; - /* these names are Activeware compatible */ - newXS("Win32::GetCwd", w32_GetCwd, file); - newXS("Win32::SetCwd", w32_SetCwd, file); - newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file); - newXS("Win32::GetLastError", w32_GetLastError, file); - newXS("Win32::SetLastError", w32_SetLastError, file); - newXS("Win32::LoginName", w32_LoginName, file); - newXS("Win32::NodeName", w32_NodeName, file); - newXS("Win32::DomainName", w32_DomainName, file); - newXS("Win32::FsType", w32_FsType, file); - newXS("Win32::GetOSVersion", w32_GetOSVersion, file); - newXS("Win32::IsWinNT", w32_IsWinNT, file); - newXS("Win32::IsWin95", w32_IsWin95, file); - newXS("Win32::FormatMessage", w32_FormatMessage, file); - newXS("Win32::Spawn", w32_Spawn, file); - newXS("Win32::GetTickCount", w32_GetTickCount, file); - newXS("Win32::GetShortPathName", w32_GetShortPathName, file); - newXS("Win32::GetFullPathName", w32_GetFullPathName, file); - newXS("Win32::GetLongPathName", w32_GetLongPathName, file); - newXS("Win32::CopyFile", w32_CopyFile, file); - newXS("Win32::Sleep", w32_Sleep, file); + /* load Win32 CORE stubs, assuming Win32CORE was statically linked */ + if ((cv = get_cv("Win32CORE::bootstrap", 0))) { + dSP; + PUSHMARK(SP); + (void)call_sv((SV *)cv, G_EVAL|G_DISCARD|G_VOID); + } + newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file); } -- cgit v1.2.1