release/src/router/mysql/mysql-test/lib/My/Test.pm

   1 # -*- cperl -*-
   2 # Copyright (c) 2008 MySQL AB, 2008 Sun Microsystems, Inc.
   3 # Use is subject to license terms.
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; version 2 of the License.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program; if not, write to the Free Software
  16 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  17
  18
  19 #
  20 # One test
  21 #
  22 package My::Test;
  23
  24 use strict;
  25 use warnings;
  26 use Carp;
  27
  28
  29 sub new {
  30   my $class= shift;
  31   my $self= bless {
  32                    @_,
  33                   }, $class;
  34   return $self;
  35 }
  36
  37
  38 #
  39 # Return a unique key that can be used to
  40 # identify this test in a hash
  41 #
  42 sub key {
  43   my ($self)= @_;
  44   return $self->{key};
  45 }
  46
  47
  48 sub _encode {
  49   my ($value)= @_;
  50   $value =~ s/([|\\\x{0a}\x{0d}])/sprintf('\%02X', ord($1))/eg;
  51   return $value;
  52 }
  53
  54 sub _decode {
  55   my ($value)= @_;
  56   $value =~ s/\\([0-9a-fA-F]{2})/chr(hex($1))/ge;
  57   return $value;
  58 }
  59
  60 sub is_failed {
  61   my ($self)= @_;
  62   my $result= $self->{result};
  63   croak "'is_failed' can't be called until test has been run!"
  64     unless defined $result;
  65
  66   return ($result eq 'MTR_RES_FAILED');
  67 }
  68
  69
  70 sub write_test {
  71   my ($test, $sock, $header)= @_;
  72
  73   # Give the test a unique key before serializing it
  74   $test->{key}= "$test" unless defined $test->{key};
  75
  76   print $sock $header, "\n";
  77   while ((my ($key, $value)) = each(%$test)) {
  78     print $sock  $key, "= ";
  79     if (ref $value eq "ARRAY") {
  80       print $sock "[", _encode(join(", ", @$value)), "]";
  81     } else {
  82       print $sock _encode($value);
  83     }
  84     print $sock "\n";
  85   }
  86   print $sock "\n";
  87 }
  88
  89
  90 sub read_test {
  91   my ($sock)= @_;
  92   my $test= My::Test->new();
  93   # Read the : separated key value pairs until a
  94   # single newline on it's own line
  95   my $line;
  96   while (defined($line= <$sock>)) {
  97     # List is terminated by newline on it's own
  98     if ($line eq "\n") {
  99       # Correctly terminated reply
 100       # print "Got newline\n";
 101       last;
 102     }
 103     chomp($line);
 104
 105     # Split key/value on the first "="
 106     my ($key, $value)= split("= ", $line, 2);
 107
 108     if ($value =~ /^\[(.*)\]/){
 109       my @values= split(", ", _decode($1));
 110       push(@{$test->{$key}}, @values);
 111     }
 112     else
 113     {
 114       $test->{$key}= _decode($value);
 115     }
 116   }
 117   return $test;
 118 }
 119
 120
 121 sub print_test {
 122   my ($self)= @_;
 123
 124   print "[", $self->{name}, "]", "\n";
 125   while ((my ($key, $value)) = each(%$self)) {
 126     print " ", $key, "= ";
 127     if (ref $value eq "ARRAY") {
 128       print "[", join(", ", @$value), "]";
 129     } else {
 130       print $value;
 131     }
 132     print "\n";
 133   }
 134   print "\n";
 135 }
 136
 137
 138 1;