← Back to branch summary

~diego-fmpwizard/mysql-sandbox/repl-topo-aggr-support

« back to all changes in this revision

Viewing changes to lib/MySQL/Sandbox.pm

  • Committer: Giuseppe Maxia
  • Date: 2009-03-29 09:38:55 UTC
  • Revision ID: g.maxia@gmail.com-20090329093855-uie8syy1r12x6brj
- Preparation for version 3.0
- refactoring code to use with ExtUtilis::MakeMaker and install a proper Perl module 

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/MySQL/Sandbox.pm
 
1
package MySQL::Sandbox;
 
2
use strict;
 
3
use warnings;
 
4
use English qw( -no_match_vars ); 
 
5
use Socket;
 
6
 
 
7
# use base qw( Exporter);
 
8
# our @ISA= qw(Exporter);
 
9
 
 
10
our $VERSION='2.0.98';
 
11
our $DEBUG;
 
12
 
 
13
BEGIN {
 
14
    $DEBUG = $ENV{'SBDEBUG'} || $ENV{'SBVERBOSE'} || 0;
 
15
    unless ( $ENV{SANDBOX_HOME} ) { 
 
16
        $ENV{SANDBOX_HOME} = "$ENV{HOME}/sandboxes";
 
17
    }
 
18
 
 
19
    if ( -d "$ENV{HOME}/sandboxes" ) {
 
20
        $ENV{SANDBOX_HOME} = $ENV{SANDBOX_HOME} || "$ENV{HOME}/sandboxes";
 
21
    }
 
22
}
 
23
 
 
24
my @supported_versions = qw( 3.23 4.0 4.1 5.0 5.1 5.2 6.0);
 
25
 
 
26
our %default_base_port = (
 
27
    replication => 11000,
 
28
    circular    => 14000,
 
29
    multiple    =>  7000,
 
30
    custom      =>  5000,
 
31
); 
 
32
 
 
33
 
 
34
sub new {
 
35
    my ($class) = @_;
 
36
    my $self = bless {
 
37
        parse_options => undef,
 
38
    }, $class;
 
39
    # my $version = get_version( $install_dir);
 
40
    # $self->{version} = $VERSION;
 
41
    return $self;
 
42
}
 
43
 
 
44
sub parse_options {
 
45
    my ($self, $opt ) = @_;
 
46
    if ($opt) {
 
47
        $self->{parse_options} = $opt;
 
48
    }
 
49
    return $self->{parse_options};
 
50
}
 
51
 
 
52
sub get_help {
 
53
    my ($self, $msg) = @_;
 
54
    if ($msg) {
 
55
        warn "[***] $msg\n\n";
 
56
    }
 
57
 
 
58
    my $HELP_MSG = q{};
 
59
    for my $op ( 
 
60
                sort { $self->parse_options->{$a}{so} <=> $self->parse_options->{$b}{so} } 
 
61
                grep { $self->parse_options->{$_}{parse}}  keys %{ $self->parse_options } ) {
 
62
        my $param =  $self->parse_options->{$op}{parse};
 
63
        my $param_str = q{    };
 
64
        my ($short, $long ) = $param =~ / (?: (\w) \| )? (\S+) /x;
 
65
        if ($short) {
 
66
            $param_str .= q{-} . $short . q{ };
 
67
        } 
 
68
        $long =~ s/ = s \@? / = name/x;
 
69
        $long =~ s/ = i / = number/x;
 
70
        $param_str .= q{--} . $long;
 
71
        $param_str .= (q{ } x (40 - length($param_str)) );
 
72
        my $text_items = $self->parse_options->{$op}{help};
 
73
        for my $titem (@{$text_items}) {
 
74
            $HELP_MSG .= $param_str . $titem . "\n";
 
75
            $param_str = q{ } x 40;
 
76
        }
 
77
        if (@{$text_items} > 1) {
 
78
            $HELP_MSG .= "\n";
 
79
        }
 
80
        # $HELP_MSG .= "\n";
 
81
   }
 
82
 
 
83
   print $self->credits(),
 
84
          "syntax: $PROGRAM_NAME [options] \n", 
 
85
          $HELP_MSG, 
 
86
        "\nExample:\n",
 
87
        "     $PROGRAM_NAME --my_file=large --sandbox_directory=my_sandbox\n\n";
 
88
 
 
89
    exit(1);
 
90
}
 
91
 
 
92
sub credits {
 
93
    my ($self) = @_;
 
94
    my $CREDITS = 
 
95
          qq(    The MySQL Sandbox,  version $VERSION\n) 
 
96
        . qq(    (C) 2006,2007,2008 Giuseppe Maxia, Sun Microsystems, Database Group\n);
 
97
    return $CREDITS;
 
98
}
 
99
 
 
100
#sub get_version {
 
101
#    my ($install_dir) = @_;
 
102
#    open my $VER , q{<}, "$install_dir/VERSION"
 
103
#    #open my $VER , q{<}, "VERSION"
 
104
#        or die "file 'VERSION' not found\n";
 
105
#    my $version = <$VER>;
 
106
#    chomp $version;
 
107
#    close $VER;
 
108
#    return $version;
 
109
#}
 
110
 
 
111
sub write_to {
 
112
    my ($self, $fname, $mode, $contents) = @_;
 
113
    open my $FILE, $mode, $fname
 
114
        or die "can't open file $fname\n";
 
115
    print $FILE $contents, "\n";
 
116
    close $FILE;
 
117
}
 
118
 
 
119
sub supported_versions {
 
120
    return \@supported_versions;
 
121
}
 
122
 
 
123
sub is_port_open {
 
124
    my ($port) = @_;
 
125
    die "No port" unless $port;
 
126
    my ($host, $iaddr, $paddr, $proto);
 
127
 
 
128
    $host  =  '127.0.0.1';
 
129
    $iaddr   = inet_aton($host)               
 
130
        or die "no host: $host";
 
131
    $paddr   = sockaddr_in($port, $iaddr);
 
132
 
 
133
    $proto   = getprotobyname('tcp');
 
134
    socket(SOCK, PF_INET, SOCK_STREAM, $proto)
 
135
        or die "error creating test socket for port $port: $!";
 
136
    if (connect(SOCK, $paddr)) {
 
137
        close (SOCK)
 
138
            or die "error closing test socket: $!";
 
139
        return 1;
 
140
    }
 
141
    return 0; 
 
142
}
 
143
 
 
144
sub first_unused_port {
 
145
    my ($port) = @_;
 
146
    while (is_port_open($port)) {
 
147
        $port++;
 
148
        if ($port > 0xFFF0) {
 
149
            die "no ports available\n";
 
150
        }
 
151
    }
 
152
    return $port;
 
153
}
 
154
 
 
155
 
 
156
1;
 
157
__END__
 
158
 
 
159