File Coverage

blib/lib/KiokuDB/Backend/Serialize/YAML.pm
Criterion Covered Total %
statement 36 36 100.0
branch 4 4 100.0
condition 3 3 100.0
subroutine 8 8 100.0
pod 4 4 100.0
total 55 55 100.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package KiokuDB::Backend::Serialize::YAML;
4 5     5   2998 use Moose::Role;
  5         10  
  5         36  
5              
6 5     5   21185 use IO::Handle;
  5         10  
  5         261  
7              
8 5     5   479 use YAML::XS qw(Load Dump);
  5         2185  
  5         326  
9              
10 5     5   26 use namespace::clean -except => 'meta';
  5         7  
  5         36  
11              
12             with qw(
13             KiokuDB::Backend::Serialize
14             KiokuDB::Backend::Role::UnicodeSafe
15             KiokuDB::Backend::TypeMap::Default::Storable
16             );
17              
18             sub serialize {
19 733     733 1 40082 my ( $self, $entry ) = @_;
20              
21 733         2745 my $clone = $entry->clone;
22              
23 733         1385617 $clone->clear_prev;
24 733         16955 $clone->root( $entry->root );
25              
26 733         70368 Dump($clone);
27             }
28              
29             sub deserialize {
30 1743     1743 1 19236 my ( $self, $blob ) = @_;
31              
32 1743         89711 return Load($blob);
33             }
34              
35             sub serialize_to_stream {
36 3     3 1 60 my ( $self, $fh, $entry ) = @_;
37 3         8 $fh->print( $self->serialize($entry) );
38             }
39              
40             has _deserialize_buffer => (
41             isa => "ScalarRef",
42             is => "ro",
43             default => sub { my $x = ''; \$x },
44             );
45              
46             sub deserialize_from_stream {
47 4     4 1 561 my ( $self, $fh ) = @_;
48              
49 4         4 local $_;
50 4         12 local $/ = "\n";
51              
52 4         133 my $buf = $self->_deserialize_buffer;
53              
54 4         12 while ( <$fh> ) {
55 15 100 100     34 if ( /^---/ and length($$buf) ) {
56 2         6 my @data = $self->deserialize($$buf);
57 2         5 $$buf = $_;
58 2         8 return @data;
59             } else {
60 13         23 $$buf .= $_;
61             }
62             }
63              
64 2 100       7 if ( length $$buf ) {
65 1         2 my @data = $self->deserialize($$buf);
66 1         3 $$buf = '';
67 1         4 return @data;
68             } else {
69 1         4 return;
70             }
71             }
72              
73             __PACKAGE__
74              
75             __END__
76              
77             =pod
78              
79             =head1 NAME
80              
81             KiokuDB::Backend::Serialize::YAML - L<YAML::XS> based serialization of
82             L<KiokuDB::Entry> objects.
83              
84             =head1 SYNOPSIS
85              
86             package MyBackend;
87             use Moose;
88              
89             with qw(KiokuDB::Backend::Serialize::YAML);
90              
91             =head1 DESCRIPTION
92              
93             L<KiokuDB::Backend::Serialize::Delegate> is preferred to using this directly.
94              
95             =head1 METHODS
96              
97             =over 4
98              
99             =item serialize $entry
100              
101             Calls L<YAML::XS::Dump>
102              
103             =item deserialize $str
104              
105             Calls L<YAML::XS::Load>
106              
107             =item serialize_to_stream $fh, $entry
108              
109             Serializes the entry and prints to the file handle.
110              
111             =item deserialize_from_stream $fh
112              
113             Reads until a YAML document boundry is reached, and then deserializes the
114             current buffer.
115              
116             =back