File Coverage

blib/lib/IO/TieCombine/Scalar.pm
Criterion Covered Total %
statement 23 23 100.0
branch 2 2 100.0
condition n/a
subroutine 6 6 100.0
pod n/a
total 31 31 100.0


line stmt bran cond sub pod time code
1 1     1   4 use strict;
  1         2  
  1         22  
2 1     1   10 use warnings;
  1         2  
  1         43  
3             package IO::TieCombine::Scalar;
4             # ABSTRACT: tied scalars for IO::TieCombine
5             $IO::TieCombine::Scalar::VERSION = '1.005';
6 1     1   5 use Carp ();
  1         1  
  1         254  
7              
8             sub TIESCALAR {
9 3     3   6 my ($class, $arg) = @_;
10              
11             my $self = {
12             slot_name => $arg->{slot_name},
13             combined_ref => $arg->{combined_ref},
14             output_ref => $arg->{output_ref},
15 3         11 };
16              
17 3         46 bless $self => $class;
18             }
19              
20             sub FETCH {
21 5     5   21 return ${ $_[0]->{output_ref} }
  5         26  
22             }
23              
24             sub STORE {
25 6     6   14 my ($self, $value) = @_;
26 6         10 my $class = ref $self;
27 6         10 my $output_ref = $self->{output_ref};
28              
29 6 100       187 Carp::croak "you may only append, not reassign, a $class tie"
30             unless index($value, $$output_ref) == 0;
31            
32 5         9 my $extra = substr $value, length $$output_ref, length $value;
33              
34 5         6 ${ $self->{combined_ref} } .= $extra;
  5         11  
35 5         6 return ${ $self->{output_ref} } = $value;
  5         18  
36             }
37              
38             1;
39              
40             __END__