File Coverage

blib/lib/IO/Buffered/Last.pm
Criterion Covered Total %
statement 32 38 84.2
branch 4 8 50.0
condition 2 9 22.2
subroutine 10 12 83.3
pod 7 7 100.0
total 55 74 74.3


line stmt bran cond sub pod time code
1             package IO::Buffered::Last;
2 8     8   41 use strict;
  8         15  
  8         252  
3 8     8   37 use warnings;
  8         17  
  8         223  
4 8     8   78 use Carp;
  8         34  
  8         462  
5              
6 8     8   39 use base ("IO::Buffered");
  8         15  
  8         766  
7              
8             # FIXME: Write documentation
9              
10             our $VERSION = '1.00';
11              
12             =head1 NAME
13              
14             IO::Buffered::Last - Last read buffering
15              
16             =head1 DESCRIPTION
17              
18             =head1 SYNOPSIS
19              
20             =head1 METHODS
21              
22             =over
23              
24             =cut
25              
26 8     8   43 use base "Exporter";
  8         13  
  8         3550  
27              
28             our @EXPORT_OK = qw();
29              
30             =item new()
31              
32             =cut
33              
34             sub new {
35 1     1 1 2 my ($class, %opts) = @_;
36            
37             # Check that $regexp is a Regexp or a non empty string
38 1 50 0     7 croak "Option MaxSize should be a positiv integer" if $opts{MaxSize} and !(
      33        
39             $opts{MaxSize} =~ /^\d+$/ and $opts{MaxSize} > 0);
40              
41 1         6 my %self = (
42             buffer => '',
43             maxsize => $opts{MaxSize},
44             );
45            
46 1   33     21 return bless \%self, (ref $class || $class);
47             }
48              
49             =item flush($str, ...)
50              
51             =cut
52              
53             sub flush {
54 0     0 1 0 my $self = shift;
55 0         0 $self->{buffer} = join ('', @_);
56             }
57              
58             =item buffer()
59              
60             =cut
61              
62             sub buffer {
63 2     2 1 536 my $self = shift;
64 2         13 return $self->{buffer};
65             }
66              
67             =item write($str, ...)
68              
69             =cut
70              
71             sub write {
72 2     2 1 616 my $self = shift;
73 2         7 my $str = join ('', @_);
74            
75 2 50       7 if(my $maxsize = $self->{maxsize}) {
76 0         0 my $length = length($str) + length($self->{buffer});
77 0 0       0 if($length > $maxsize) {
78 0         0 croak "Buffer overrun";
79             }
80             }
81              
82 2         6 $self->{buffer} .= $str;
83             }
84              
85             =item read()
86              
87             =cut
88              
89             sub read {
90 2     2 1 4 my @array;
91 2         6 return @array;
92             }
93              
94             =item returns_last()
95              
96             =cut
97              
98             sub returns_last {
99 0     0 1 0 return 0;
100             }
101              
102             =item read_last()
103              
104             =cut
105              
106             sub read_last {
107 2     2 1 8 my ($self) = @_;
108 2         4 my @records;
109 2 100       10 push(@records, $self->{buffer}) if $self->{buffer} ne '';
110 2         3 $self->{buffer} = '';
111 2         8 return @records;
112             }
113              
114             =back
115              
116             =head1 AUTHOR
117              
118             Troels Liebe Bentsen
119              
120             =head1 COPYRIGHT
121              
122             Copyright(C) 2008 Troels Liebe Bentsen
123              
124             This library is free software; you can redistribute it and/or modify
125             it under the same terms as Perl itself.
126              
127             =cut
128              
129             1;
130