← 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/Options.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/Options.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
 
 
18
package My::Options;
 
19
 
 
20
#
 
21
# Utility functions to work with list of options
 
22
#
 
23
 
 
24
use strict;
 
25
 
 
26
 
 
27
sub same($$) {
 
28
  my $l1= shift;
 
29
  my $l2= shift;
 
30
  return compare($l1,$l2) == 0;
 
31
}
 
32
 
 
33
 
 
34
sub compare ($$) {
 
35
  my $l1= shift;
 
36
  my $l2= shift;
 
37
 
 
38
  my @l1= @$l1;
 
39
  my @l2= @$l2;
 
40
 
 
41
  return -1 if @l1 < @l2;
 
42
  return  1 if @l1 > @l2;
 
43
 
 
44
  while ( @l1 )                         # Same length
 
45
  {
 
46
    my $e1= shift @l1;
 
47
    my $e2= shift @l2;
 
48
    my $cmp= ($e1 cmp $e2);
 
49
    return $cmp if $cmp != 0;
 
50
  }
 
51
 
 
52
  return 0;                             # They are the same
 
53
}
 
54
 
 
55
 
 
56
sub _split_option {
 
57
  my ($option)= @_;
 
58
  if ($option=~ /^--(.*)=(.*)$/){
 
59
    return ($1, $2);
 
60
  }
 
61
  elsif ($option=~ /^--(.*)$/){
 
62
    return ($1, undef)
 
63
  }
 
64
  elsif ($option=~ /^\$(.*)$/){ # $VAR
 
65
    return ($1, undef)
 
66
  }
 
67
  elsif ($option=~ /^(.*)=(.*)$/){
 
68
    return ($1, $2)
 
69
  }
 
70
  elsif ($option=~ /^-O$/){
 
71
    return (undef, undef);
 
72
  }
 
73
  die "Unknown option format '$option'";
 
74
}
 
75
 
 
76
 
 
77
sub _build_option {
 
78
  my ($name, $value)= @_;
 
79
  if ($name =~ /^O, /){
 
80
    return "-".$name."=".$value;
 
81
  }
 
82
  elsif ($value){
 
83
    return "--".$name."=".$value;
 
84
  }
 
85
  return "--".$name;
 
86
}
 
87
 
 
88
 
 
89
#
 
90
# Compare two list of options and return what would need
 
91
# to be done to get the server running with the new settings
 
92
#
 
93
sub diff {
 
94
  my ($from_opts, $to_opts)= @_;
 
95
 
 
96
  my %from;
 
97
  foreach my $from (@$from_opts)
 
98
  {
 
99
    my ($opt, $value)= _split_option($from);
 
100
    next unless defined($opt);
 
101
    $from{$opt}= $value;
 
102
  }
 
103
 
 
104
  #print "from: ", %from, "\n";
 
105
 
 
106
  my %to;
 
107
  foreach my $to (@$to_opts)
 
108
  {
 
109
    my ($opt, $value)= _split_option($to);
 
110
    next unless defined($opt);
 
111
    $to{$opt}= $value;
 
112
  }
 
113
 
 
114
  #print "to: ", %to, "\n";
 
115
 
 
116
  # Remove the ones that are in both lists
 
117
  foreach my $name (keys %from){
 
118
    if (exists $to{$name} and $to{$name} eq $from{$name}){
 
119
      #print "removing '$name'  from both lists\n";
 
120
      delete $to{$name};
 
121
      delete $from{$name};
 
122
    }
 
123
  }
 
124
 
 
125
  #print "from: ", %from, "\n";
 
126
  #print "to: ", %to, "\n";
 
127
 
 
128
  # Add all keys in "to" to result
 
129
  my @result;
 
130
  foreach my $name (keys %to){
 
131
    push(@result, _build_option($name, $to{$name}));
 
132
  }
 
133
 
 
134
  # Add all keys in "from" that are not in "to"
 
135
  # to result as "set to default"
 
136
  foreach my $name (keys %from){
 
137
    if (not exists $to{$name}) {
 
138
      push(@result, _build_option($name, "default"));
 
139
    }
 
140
  }
 
141
 
 
142
  return @result;
 
143
}
 
144
 
 
145
 
 
146
sub is_set {
 
147
  my ($opts, $set_opts)= @_;
 
148
 
 
149
  foreach my $opt (@$opts){
 
150
 
 
151
    my ($opt_name1, $value1)= _split_option($opt);
 
152
 
 
153
    foreach my $set_opt (@$set_opts){
 
154
      my ($opt_name2, $value2)= _split_option($set_opt);
 
155
 
 
156
      if ($opt_name1 eq $opt_name2){
 
157
        # Option already set
 
158
        return 1;
 
159
      }
 
160
    }
 
161
  }
 
162
 
 
163
  return 0;
 
164
}
 
165
 
 
166
 
 
167
sub toSQL {
 
168
  my (@options)= @_;
 
169
  my @sql;
 
170
 
 
171
  foreach my $option (@options) {
 
172
    my ($name, $value)= _split_option($option);
 
173
    #print "name: $name\n";
 
174
    #print "value: $value\n";
 
175
    if ($name =~ /^O, (.*)/){
 
176
      push(@sql, "SET GLOBAL $1=$value");
 
177
    }
 
178
    elsif ($name =~ /^set-variable=(.*)/){
 
179
      push(@sql, "SET GLOBAL $1=$value");
 
180
    }
 
181
    else {
 
182
      my $sql_name= $name;
 
183
      $sql_name=~ s/-/_/g;
 
184
      push(@sql, "SET GLOBAL $sql_name=$value");
 
185
    }
 
186
  }
 
187
  return join("; ", @sql);
 
188
}
 
189
 
 
190
 
 
191
sub toStr {
 
192
  my $name= shift;
 
193
  return "$name: ",
 
194
    "['", join("', '", @_), "']\n";
 
195
}
 
196
 
 
197
 
 
198
1;
 
199