← Back to branch summary

~ubuntu-branches/ubuntu/precise/mysql-5.1/precise

« back to all changes in this revision

Viewing changes to mysql-test/lib/My/Platform.pm

  • Committer: Bazaar Package Importer
  • Author(s): Norbert Tretkowski
  • Date: 2010-03-17 14:56:02 UTC
  • Revision ID: james.westby@ubuntu.com-20100317145602-x7e30l1b2sb5s6w6
Tags: upstream-5.1.45
Import upstream version 5.1.45

Show diffs side-by-side

added added

removed removed

Lines of Context:
mysql-test/lib/My/Platform.pm
 
1
# -*- cperl -*-
 
2
# Copyright (C) 2004-2006 MySQL AB
 
3
#
 
4
# This program is free software; you can redistribute it and/or modify
 
5
# it under the terms of the GNU General Public License as published by
 
6
# the Free Software Foundation; version 2 of the License.
 
7
#
 
8
# This program is distributed in the hope that it will be useful,
 
9
# but WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
11
# GNU General Public License for more details.
 
12
#
 
13
# You should have received a copy of the GNU General Public License
 
14
# along with this program; if not, write to the Free Software
 
15
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 
16
 
 
17
package My::Platform;
 
18
 
 
19
use strict;
 
20
use File::Basename;
 
21
use File::Path;
 
22
 
 
23
use base qw(Exporter);
 
24
our @EXPORT= qw(IS_CYGWIN IS_WINDOWS IS_WIN32PERL
 
25
                native_path posix_path mixed_path
 
26
                check_socket_path_length process_alive);
 
27
 
 
28
BEGIN {
 
29
  if ($^O eq "cygwin") {
 
30
    # Make sure cygpath works
 
31
    if ((system("cygpath > /dev/null 2>&1") >> 8) != 1){
 
32
      die "Could not execute 'cygpath': $!";
 
33
    }
 
34
    eval 'sub IS_CYGWIN { 1 }';
 
35
  }
 
36
  else {
 
37
    eval 'sub IS_CYGWIN { 0 }';
 
38
  }
 
39
  if ($^O eq "MSWin32") {
 
40
    eval 'sub IS_WIN32PERL { 1 }';
 
41
  }
 
42
  else {
 
43
    eval 'sub IS_WIN32PERL { 0 }';
 
44
  }
 
45
}
 
46
 
 
47
BEGIN {
 
48
  if (IS_CYGWIN or IS_WIN32PERL) {
 
49
    eval 'sub IS_WINDOWS { 1 }';
 
50
  }
 
51
  else {
 
52
    eval 'sub IS_WINDOWS { 0 }';
 
53
  }
 
54
}
 
55
 
 
56
 
 
57
#
 
58
# native_path
 
59
# Convert from path format used by perl to the underlying
 
60
# operating systems format
 
61
#
 
62
# NOTE
 
63
#  Used when running windows binaries (that expect windows paths)
 
64
#  in cygwin perl (that uses unix paths)
 
65
#
 
66
 
 
67
use Memoize;
 
68
if (!IS_WIN32PERL){
 
69
  memoize('mixed_path');
 
70
  memoize('native_path');
 
71
  memoize('posix_path');
 
72
}
 
73
 
 
74
sub mixed_path {
 
75
  my ($path)= @_;
 
76
  if (IS_CYGWIN){
 
77
    return unless defined $path;
 
78
    my $cmd= "cygpath -m $path";
 
79
    $path= `$cmd` or
 
80
      print "Failed to run: '$cmd', $!\n";
 
81
    chomp $path;
 
82
  }
 
83
  return $path;
 
84
}
 
85
 
 
86
sub native_path {
 
87
  my ($path)= @_;
 
88
  $path=~ s/\//\\/g
 
89
    if (IS_CYGWIN or IS_WIN32PERL);
 
90
  return $path;
 
91
}
 
92
 
 
93
sub posix_path {
 
94
  my ($path)= @_;
 
95
  if (IS_CYGWIN){
 
96
    return unless defined $path;
 
97
    $path= `cygpath $path`;
 
98
    chomp $path;
 
99
  }
 
100
  return $path;
 
101
}
 
102
 
 
103
use File::Temp qw /tempdir/;
 
104
 
 
105
sub check_socket_path_length {
 
106
  my ($path)= @_;
 
107
 
 
108
  return 0 if IS_WINDOWS;
 
109
  # This may not be true, but we can't test for it on AIX due to Perl bug
 
110
  # See Bug #45771
 
111
  return 0 if ($^O eq 'aix');
 
112
 
 
113
  require IO::Socket::UNIX;
 
114
 
 
115
  my $truncated= undef;
 
116
 
 
117
  # Create a tempfile name with same length as "path"
 
118
  my $tmpdir = tempdir( CLEANUP => 0);
 
119
  my $len = length($path) - length($tmpdir) - 1;
 
120
  my $testfile = $tmpdir . "/" . "x" x ($len  > 0 ? $len : 1);
 
121
  my $sock;
 
122
  eval {
 
123
    $sock= new IO::Socket::UNIX
 
124
      (
 
125
       Local => $testfile,
 
126
       Listen => 1,
 
127
      );
 
128
    $truncated= 1; # Be negatvie
 
129
 
 
130
    die "Could not create UNIX domain socket: $!"
 
131
      unless defined $sock;
 
132
 
 
133
    die "UNIX domain socket path was truncated"
 
134
      unless ($testfile eq $sock->hostpath());
 
135
 
 
136
    $truncated= 0; # Yes, it worked!
 
137
 
 
138
  };
 
139
 
 
140
  die "Unexpected failure when checking socket path length: $@"
 
141
    if $@ and not defined $truncated;
 
142
 
 
143
  $sock= undef;  # Close socket
 
144
  rmtree($tmpdir); # Remove the tempdir and any socket file created
 
145
  return $truncated;
 
146
}
 
147
 
 
148
 
 
149
sub process_alive {
 
150
  my ($pid)= @_;
 
151
  die "usage: process_alive(pid)" unless $pid;
 
152
 
 
153
  return kill(0, $pid) unless IS_WINDOWS;
 
154
 
 
155
  my @list= split(/,/, `tasklist /FI "PID eq $pid" /NH /FO CSV`);
 
156
  my $ret_pid= eval($list[1]);
 
157
  return ($ret_pid == $pid);
 
158
}
 
159
 
 
160
 
 
161
1;