diff options
Diffstat (limited to 'mysql-test/lib/My/Platform.pm')
-rw-r--r-- | mysql-test/lib/My/Platform.pm | 156 |
1 files changed, 156 insertions, 0 deletions
diff --git a/mysql-test/lib/My/Platform.pm b/mysql-test/lib/My/Platform.pm new file mode 100644 index 00000000000..3dd5c552b10 --- /dev/null +++ b/mysql-test/lib/My/Platform.pm @@ -0,0 +1,156 @@ +# -*- cperl -*- +# Copyright (C) 2004-2006 MySQL AB +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; version 2 of the License. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +package My::Platform; + +use strict; +use File::Basename; +use File::Path; + +use base qw(Exporter); +our @EXPORT= qw(IS_CYGWIN IS_WINDOWS IS_WIN32PERL + native_path posix_path mixed_path + check_socket_path_length process_alive); + +BEGIN { + if ($^O eq "cygwin") { + # Make sure cygpath works + if ((system("cygpath > /dev/null 2>&1") >> 8) != 1){ + die "Could not execute 'cygpath': $!"; + } + eval 'sub IS_CYGWIN { 1 }'; + } + else { + eval 'sub IS_CYGWIN { 0 }'; + } + if ($^O eq "MSWin32") { + eval 'sub IS_WIN32PERL { 1 }'; + } + else { + eval 'sub IS_WIN32PERL { 0 }'; + } +} + +BEGIN { + if (IS_CYGWIN or IS_WIN32PERL) { + eval 'sub IS_WINDOWS { 1 }'; + } + else { + eval 'sub IS_WINDOWS { 0 }'; + } +} + + +# +# native_path +# Convert from path format used by perl to the underlying +# operating systems format +# +# NOTE +# Used when running windows binaries (that expect windows paths) +# in cygwin perl (that uses unix paths) +# + +use Memoize; +if (!IS_WIN32PERL){ + memoize('mixed_path'); + memoize('native_path'); + memoize('posix_path'); +} + +sub mixed_path { + my ($path)= @_; + if (IS_CYGWIN){ + return unless defined $path; + my $cmd= "cygpath -m $path"; + $path= `$cmd` or + print "Failed to run: '$cmd', $!\n"; + chomp $path; + } + return $path; +} + +sub native_path { + my ($path)= @_; + $path=~ s/\//\\/g + if (IS_CYGWIN or IS_WIN32PERL); + return $path; +} + +sub posix_path { + my ($path)= @_; + if (IS_CYGWIN){ + return unless defined $path; + $path= `cygpath $path`; + chomp $path; + } + return $path; +} + +use File::Temp qw /tempdir/; + +sub check_socket_path_length { + my ($path)= @_; + + return 0 if IS_WINDOWS; + + require IO::Socket::UNIX; + + my $truncated= 1; # Be negative + + # Create a tempfile name with same length as "path" + my $tmpdir = tempdir( CLEANUP => 0); + my $len = length($path) - length($tmpdir); + my $testfile = $tmpdir . "x" x ($len > 0 ? $len : 1); + my $sock; + eval { + $sock= new IO::Socket::UNIX + ( + Local => $testfile, + Listen => 1, + ); + + die "Could not create UNIX domain socket: $!" + unless defined $sock; + + die "UNIX domain socket patch was truncated" + unless ($testfile eq $sock->hostpath()); + + $truncated= 0; # Yes, it worked! + + }; + #print "check_socket_path_length, failed: ", $@, '\n' if ($@); + + $sock= undef; # Close socket + unlink($testfile); # Remove the physical file + rmdir($tmpdir); # Remove the tempdir + return $truncated; +} + + +sub process_alive { + my ($pid)= @_; + die "usage: process_alive(pid)" unless $pid; + + return kill(0, $pid) unless IS_WINDOWS; + + my @list= split(/,/, `tasklist /FI "PID eq $pid" /NH /FO CSV`); + my $ret_pid= eval($list[1]); + return ($ret_pid == $pid); +} + + +1; |