File Coverage

blib/lib/Alien/Taco/Transport.pm
Criterion Covered Total %
statement 30 30 100.0
branch 5 6 83.3
condition n/a
subroutine 5 5 100.0
pod 3 3 100.0
total 43 44 97.7


line stmt bran cond sub pod time code
1             # Taco Perl transport module.
2             # Copyright (C) 2013-2014 Graham Bell
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, either version 3 of the License, or
7             # (at your option) any later version.
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, see <http://www.gnu.org/licenses/>.
16              
17             =head1 NAME
18              
19             Alien::Taco::Transport - Taco Perl transport module
20              
21             =head1 DESCRIPTION
22              
23             This package implements the communication between Taco clients
24             and servers.
25              
26             =cut
27              
28             package Alien::Taco::Transport;
29              
30 7     7   92774 use JSON;
  7         67775  
  7         35  
31              
32 7     7   1364 use strict;
  7         13  
  7         1726  
33              
34             our $VERSION = '0.002';
35              
36             =head1 METHODS
37              
38             =over 4
39              
40             =item new(in => $input, out => $output)
41              
42             Construct a new object. This stores the given input and output file
43             handles and instantiates a JSON processor object.
44              
45             =cut
46              
47             sub new {
48 3     3 1 184 my $class = shift;
49 3         13 my %opts = @_;
50              
51 3         31 my $json = new JSON();
52 3         29 $json->convert_blessed(1);
53              
54 3 100       11 if (exists $opts{'filter_single'}) {
55 2         3 $json->filter_json_single_key_object(@{$opts{'filter_single'}});
  2         12  
56             }
57              
58             my $self = {
59             in => $opts{'in'},
60 3         12 out => $opts{'out'},
61             json => $json,
62             };
63              
64 3         15 return bless $self, $class;
65             }
66              
67             =item read()
68              
69             Attempt to read a message from the input filehandle. Returns the decoded
70             message as a data structure or undef if nothing was read.
71              
72             =cut
73              
74             sub read {
75 6     6 1 685 my $self = shift;
76 6         13 my $in = $self->{'in'};
77              
78 6         10 my $text = '';
79 6         22 while (<$in>) {
80 12 100       288 last if /^\/\/ END/;
81 6         18 $text .= $_;
82             }
83              
84 6 50       15 return undef unless $text;
85 6         51 return $self->{'json'}->decode($text);
86             }
87              
88             =item write(\%message)
89              
90             Encode the message and write it to the output filehandle.
91              
92             =cut
93              
94             sub write {
95 5     5 1 10 my $self = shift;
96 5         11 my $out = $self->{'out'};
97              
98 5         36 my $text = $self->{'json'}->encode(shift);
99              
100 5         17 local $\ = '';
101 5         22 print $out $text;
102 5         142 print $out "\n\/\/ END\n";
103 5         93 $out->flush();
104             }
105              
106             1;
107              
108             __END__
109              
110             =back
111              
112             =cut