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 .
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   43719 use JSON;
  7         92952  
  7         159  
31              
32 7     7   2350 use strict;
  7         99  
  7         3282  
33              
34             our $VERSION = '0.001';
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 92 my $class = shift;
49 3         13 my %opts = @_;
50              
51 3         36 my $json = new JSON();
52 3         25 $json->convert_blessed(1);
53              
54 3 100       38 if (exists $opts{'filter_single'}) {
55 2         4 $json->filter_json_single_key_object(@{$opts{'filter_single'}});
  2         34  
56             }
57              
58 3         16 my $self = {
59             in => $opts{'in'},
60             out => $opts{'out'},
61             json => $json,
62             };
63              
64 3         23 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 790 my $self = shift;
76 6         15 my $in = $self->{'in'};
77              
78 6         13 my $text = '';
79 6         27 while (<$in>) {
80 12 100       313 last if /^\/\/ END/;
81 6         22 $text .= $_;
82             }
83              
84 6 50       18 return undef unless $text;
85 6         76 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 12 my $self = shift;
96 5         16 my $out = $self->{'out'};
97              
98 5         61 my $text = $self->{'json'}->encode(shift);
99              
100 5         23 local $\ = '';
101 5         23 print $out $text;
102 5         130 print $out "\n\/\/ END\n";
103 5         89 $out->flush();
104             }
105              
106             1;
107              
108             __END__