~ubuntu-branches/ubuntu/trusty/drizzle/trusty

« back to all changes in this revision

Viewing changes to tests/randgen/lib/GenTest/IPC/Channel.pm

  • Committer: Package Import Robot
  • Author(s): Clint Byrum
  • Date: 2012-06-19 10:46:49 UTC
  • mfrom: (1.1.6)
  • mto: This revision was merged to the branch mainline in revision 29.
  • Revision ID: package-import@ubuntu.com-20120619104649-e2l0ggd4oz3um0f4
Tags: upstream-7.1.36-stable
ImportĀ upstreamĀ versionĀ 7.1.36-stable

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
# Copyright (C) 2010 Sun Microsystems, Inc. All rights reserved.
 
2
# Use is subject to license terms.
 
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, but
 
9
# WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 
11
# 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
 
16
# USA
 
17
 
 
18
package GenTest::IPC::Channel;
 
19
 
 
20
@ISA = qw(GenTest);
 
21
 
 
22
use strict;
 
23
 
 
24
use Carp;
 
25
 
 
26
use IO::Handle;
 
27
use IO::Pipe;
 
28
use Data::Dumper;
 
29
use GenTest;
 
30
 
 
31
use constant CHANNEL_IN => 0;
 
32
use constant CHANNEL_OUT => 1;
 
33
use constant CHANNEL_PIPE => 2;
 
34
use constant CHANNEL_EOF => 3;
 
35
use constant CHANNEL_READER => 4;
 
36
 
 
37
sub new {
 
38
    my $class = shift;
 
39
 
 
40
    my $self = $class->SUPER::new({},@_);
 
41
 
 
42
    ## open  bi-directional pipe
 
43
 
 
44
    $self->[CHANNEL_IN] = IO::Handle->new();
 
45
    $self->[CHANNEL_OUT] = IO::Handle->new();
 
46
    $self->[CHANNEL_PIPE] = IO::Pipe->new($self->[CHANNEL_IN],$self->[CHANNEL_OUT]);
 
47
    
 
48
    $self->[CHANNEL_EOF]= 0;
 
49
    $self->[CHANNEL_READER] = undef;
 
50
    
 
51
    ## Turn off buffering of output. Each object is sent as one
 
52
    ## print-statement
 
53
    $self->[CHANNEL_OUT]->autoflush(1);
 
54
 
 
55
    return $self;
 
56
}
 
57
 
 
58
sub send {
 
59
    my ($self,$obj) = @_;
 
60
 
 
61
    croak "OUT pipe closed" if defined $self->[CHANNEL_READER] and $self->[CHANNEL_READER];
 
62
 
 
63
    ## Preliminary save Data::Dumper settings since this is a global setting
 
64
    my $oldindent = $Data::Dumper::Indent;
 
65
    my $oldpurity = $Data::Dumper::Purity;
 
66
 
 
67
    ## Make output with no newlines and suitable for eval
 
68
    $Data::Dumper::Indent = 0;
 
69
    $Data::Dumper::Purity = 1;
 
70
 
 
71
    my $msg = Dumper($obj);
 
72
 
 
73
    ## Encode newline because that is used as message separator
 
74
    ## (readline on the other end)
 
75
    $msg =~ s/\n/&NEWLINE;/g;
 
76
 
 
77
    my $chn = $self->[CHANNEL_OUT];
 
78
    print $chn $msg,"\n";
 
79
 
 
80
    ## Reset indent to old value
 
81
    $Data::Dumper::Indent = $oldindent;
 
82
    $Data::Dumper::Purity = $oldpurity;
 
83
}
 
84
 
 
85
sub recv {
 
86
    my ($self) = @_;
 
87
    my $obj;
 
88
 
 
89
    croak "IN pipe closed" if defined $self->[CHANNEL_READER] and !$self->[CHANNEL_READER];
 
90
    ## Read until eof or an object that may be evaluated is recieved
 
91
    while (!(defined $obj) and (!$self->[CHANNEL_EOF])) {
 
92
        my $line = readline $self->[CHANNEL_IN];
 
93
 
 
94
        ## Decode eol
 
95
        $line =~ s/&NEWLINE;/\n/g;
 
96
 
 
97
        ## Turn off strict vars since received message uses variables
 
98
        ## without "my"
 
99
        no strict "vars";
 
100
 
 
101
        ## Evaluate object
 
102
        $obj = eval $line;
 
103
        use strict "vars";
 
104
        $self->[CHANNEL_EOF] = eof $self->[CHANNEL_IN];
 
105
    };
 
106
    return $obj;
 
107
}
 
108
 
 
109
sub reader{
 
110
    my ($self) = @_;
 
111
    
 
112
    ## Readers don't need the output part
 
113
    close $self->[CHANNEL_OUT];
 
114
    $self->[CHANNEL_READER] = 1;
 
115
}
 
116
 
 
117
sub writer {
 
118
    my ($self) = @_;
 
119
 
 
120
    ## Writers don't need the input part
 
121
    close $self->[CHANNEL_IN];
 
122
    $self->[CHANNEL_READER] = 0;
 
123
}
 
124
 
 
125
sub close {
 
126
    my ($self) = @_;
 
127
    if (not defined $self->[CHANNEL_READER]) {
 
128
        close $self->[CHANNEL_OUT];
 
129
        close $self->[CHANNEL_IN];
 
130
    } elsif ($self->[CHANNEL_READER]) {
 
131
        close $self->[CHANNEL_IN];
 
132
    } else {
 
133
        close $self->[CHANNEL_OUT];
 
134
    }
 
135
}
 
136
 
 
137
sub more {
 
138
    my ($self) = @_;
 
139
    return not $self->[CHANNEL_EOF];
 
140
}
 
141
 
 
142
1;
 
143