File Coverage

blib/lib/JSON/Streaming/Reader/EventWrapper.pm
Criterion Covered Total %
statement 41 46 89.1
branch 7 10 70.0
condition n/a
subroutine 11 13 84.6
pod 0 8 0.0
total 59 77 76.6


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             JSON::Streaming::Reader::EventWrapper - Internal utility package for JSON::Streaming::Reader
5              
6             =cut
7              
8             package JSON::Streaming::Reader::EventWrapper;
9              
10 7     7   47 use strict;
  7         21  
  7         269  
11 7     7   43 use warnings;
  7         15  
  7         272  
12              
13             # Make a dummy ref that can be used as a singleton exception to signal a buffer underrun.
14 7     7   38 use constant UNDERRUN => {};
  7         14  
  7         4970  
15              
16             sub new {
17 65     65 0 102 my ($class) = @_;
18              
19 65         194 my $self = bless {}, $class;
20              
21 65         165 $self->{buffer} = "";
22 65         106 $self->{offset} = 0;
23 65         98 $self->{txn_offset} = undef;
24              
25 65         166 return $self;
26             }
27              
28             sub feed_buffer {
29 171     171 0 221 my ($self, $data) = @_;
30              
31 171         436 $self->{buffer} .= $$data;
32             }
33              
34             sub signal_eof {
35 65     65 0 90 my ($self) = @_;
36              
37 65         172 $self->{eof} = 1;
38             }
39              
40             sub begin_reading {
41 402     402 0 477 my ($self) = @_;
42              
43 402         1430 $self->{txn_offset} = $self->{offset};
44             }
45              
46             sub roll_back_reading {
47 88     88 0 113 my ($self) = @_;
48              
49 88         149 $self->{offset} = $self->{txn_offset};
50 88         197 $self->{txn_offset} = undef;
51              
52             }
53              
54             sub complete_reading {
55 314     314 0 384 my ($self) = @_;
56              
57 314         438 $self->{txn_offset} = undef;
58 314         581 $self->_trim_buffer();
59             }
60              
61             sub is_reading {
62 0     0 0 0 return defined($_[0]->{txn_offset});
63             }
64              
65             sub read {
66 846     846 0 1111 my ($self) = @_;
67              
68 846         1063 my $length = $_[2];
69 846 50       1700 die "Can only read a single byte" if $length != 1;
70              
71 846 100       1992 if ($self->{offset} < length($self->{buffer})) {
72 649         1232 $_[1] = substr($self->{buffer}, $self->{offset}, 1);
73 649         836 $self->{offset}++;
74 649         1626 return 1;
75             }
76             else {
77 197 100       410 if ($self->{eof}) {
78 109         271 return 0;
79             }
80             else {
81             #print STDERR "Underrun!\n";
82             #$self->_show_buffer();
83 88         531 die(UNDERRUN);
84             }
85             }
86             }
87              
88             # Discard anything we've already read from the buffer
89             sub _trim_buffer {
90 314     314   393 my ($self) = @_;
91              
92 314 100       896 return if $self->{offset} == 0;
93 183         371 $self->{buffer} = substr($self->{buffer}, $self->{offset});
94 183         533 $self->{offset} = 0;
95             }
96              
97             # For debugging
98             sub _show_buffer {
99 0     0     my ($self, $offset) = @_;
100              
101 0 0         $offset = $self->{offset} unless defined($offset);
102              
103 0           print STDERR "Buffer: ", $self->{buffer}, "\n";
104 0           print STDERR " ", " " x $offset, "^\n";
105             }
106              
107             1;
108              
109             =head1 DESCRIPTION
110              
111             This package is an internal implementation detail of L. It is used
112             to provide an API that looks like it blocks on top of a handle that doesn't block,
113             so the parsing functions can pretend they have a blocking handle.
114              
115             Instances of this class support enough of the C interface to satisfy L
116             and no more. In other words, they support only the C method and assume that the caller will only ever
117             want 1 character at a time.
118              
119             This is not a public API. See the event-based API on L, which is
120             implemented in terms of this class. This class may go away in future versions,
121             once refactoring renders it no longer necessary.
122              
123             =head1 SYNOPSIS
124              
125             my $event_wrapper = JSON::Streaming::Reader::EventWrapper->new();
126             $event_wrapper->feed_buffer(\$string_of_data);
127             $event_wrapper->begin_reading();
128             my $char;
129             eval {
130             $event_wrapper->read($char, 1);
131             };
132             if ($@ == JSON::Streaming::Reader::EventWrapper::UNDERRUN) {
133             $event_wrapper->roll_back_reading();
134             }
135             else {
136             $event_wrapper->complete_reading();
137             # Do something with $char
138             }
139