← 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/Test.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/Test.pm
 
1
# -*- cperl -*-
 
2
 
 
3
 
 
4
#
 
5
# One test
 
6
#
 
7
package My::Test;
 
8
 
 
9
use strict;
 
10
use warnings;
 
11
use Carp;
 
12
 
 
13
 
 
14
sub new {
 
15
  my $class= shift;
 
16
  my $self= bless {
 
17
                   @_,
 
18
                  }, $class;
 
19
  return $self;
 
20
}
 
21
 
 
22
 
 
23
#
 
24
# Return a unique key that can be used to
 
25
# identify this test in a hash
 
26
#
 
27
sub key {
 
28
  my ($self)= @_;
 
29
  return $self->{key};
 
30
}
 
31
 
 
32
 
 
33
sub _encode {
 
34
  my ($value)= @_;
 
35
  $value =~ s/([|\\\x{0a}\x{0d}])/sprintf('\%02X', ord($1))/eg;
 
36
  return $value;
 
37
}
 
38
 
 
39
sub _decode {
 
40
  my ($value)= @_;
 
41
  $value =~ s/\\([0-9a-fA-F]{2})/chr(hex($1))/ge;
 
42
  return $value;
 
43
}
 
44
 
 
45
sub is_failed {
 
46
  my ($self)= @_;
 
47
  my $result= $self->{result};
 
48
  croak "'is_failed' can't be called until test has been run!"
 
49
    unless defined $result;
 
50
 
 
51
  return ($result eq 'MTR_RES_FAILED');
 
52
}
 
53
 
 
54
 
 
55
sub write_test {
 
56
  my ($test, $sock, $header)= @_;
 
57
 
 
58
  # Give the test a unique key before serializing it
 
59
  $test->{key}= "$test" unless defined $test->{key};
 
60
 
 
61
  print $sock $header, "\n";
 
62
  while ((my ($key, $value)) = each(%$test)) {
 
63
    print $sock  $key, "= ";
 
64
    if (ref $value eq "ARRAY") {
 
65
      print $sock "[", _encode(join(", ", @$value)), "]";
 
66
    } else {
 
67
      print $sock _encode($value);
 
68
    }
 
69
    print $sock "\n";
 
70
  }
 
71
  print $sock "\n";
 
72
}
 
73
 
 
74
 
 
75
sub read_test {
 
76
  my ($sock)= @_;
 
77
  my $test= My::Test->new();
 
78
  # Read the : separated key value pairs until a
 
79
  # single newline on it's own line
 
80
  my $line;
 
81
  while (defined($line= <$sock>)) {
 
82
    # List is terminated by newline on it's own
 
83
    if ($line eq "\n") {
 
84
      # Correctly terminated reply
 
85
      # print "Got newline\n";
 
86
      last;
 
87
    }
 
88
    chomp($line);
 
89
 
 
90
    # Split key/value on the first "="
 
91
    my ($key, $value)= split("= ", $line, 2);
 
92
 
 
93
    if ($value =~ /^\[(.*)\]/){
 
94
      my @values= split(", ", _decode($1));
 
95
      push(@{$test->{$key}}, @values);
 
96
    }
 
97
    else
 
98
    {
 
99
      $test->{$key}= _decode($value);
 
100
    }
 
101
  }
 
102
  return $test;
 
103
}
 
104
 
 
105
 
 
106
sub print_test {
 
107
  my ($self)= @_;
 
108
 
 
109
  print "[", $self->{name}, "]", "\n";
 
110
  while ((my ($key, $value)) = each(%$self)) {
 
111
    print " ", $key, "= ";
 
112
    if (ref $value eq "ARRAY") {
 
113
      print "[", join(", ", @$value), "]";
 
114
    } else {
 
115
      print $value;
 
116
    }
 
117
    print "\n";
 
118
  }
 
119
  print "\n";
 
120
}
 
121
 
 
122
 
 
123
1;