File Coverage

blib/lib/DataStore/CAS/FS/DirCodec/Universal.pm
Criterion Covered Total %
statement 57 57 100.0
branch 19 24 79.1
condition 14 26 53.8
subroutine 10 10 100.0
pod 2 2 100.0
total 102 119 85.7


line stmt bran cond sub pod time code
1             package DataStore::CAS::FS::DirCodec::Universal;
2 5     5   38723 use 5.0080001;
  5         11  
3 5     5   16 use strict;
  5         5  
  5         70  
4 5     5   25 use warnings;
  5         7  
  5         119  
5 5     5   14 use Try::Tiny;
  5         5  
  5         197  
6 5     5   16 use Carp;
  5         5  
  5         216  
7 5     5   17 use JSON 2.53 ();
  5         94  
  5         234  
8             require DataStore::CAS::FS::Dir;
9             require DataStore::CAS::FS::DirEnt;
10             require DataStore::CAS::FS::InvalidUTF8;
11             *decode_utf8= *DataStore::CAS::FS::InvalidUTF8::decode_utf8;
12              
13 5     5   19 use parent 'DataStore::CAS::FS::DirCodec';
  5         11  
  5         23  
14              
15             our $VERSION= '0.011000';
16              
17             __PACKAGE__->register_format( universal => __PACKAGE__ );
18              
19             # ABSTRACT: Codec for saving all arbitrary fields of a DirEnt
20              
21              
22             our $_json_coder;
23             sub _build_json_coder {
24 3     3   69 DataStore::CAS::FS::InvalidUTF8->add_json_filter(
25             JSON->new->utf8->canonical->convert_blessed, 1
26             );
27             }
28              
29             sub encode {
30 30     30 1 3416 my ($class, $entry_list, $metadata)= @_;
31 30 50 33     81 ref($metadata) eq 'HASH' or croak "Metadata must be a hashref"
32             if $metadata;
33              
34 53         97 my @entries= sort { $a->{name} cmp $b->{name} }
35             map {
36 30 100       38 my $entry= ref $_ eq 'HASH'? $_ : $_->as_hash;
  62         100  
37 62 100       187 defined $entry->{name} or croak "Can't serialize nameless directory entry: ".JSON::encode_json($entry);
38 61 100       248 defined $entry->{type} or croak "Can't serialize typeless directory entry: ".JSON::encode_json($entry);
39             !defined($_) || (ref $_? ref($_)->can("TO_JSON") : &utf8::is_utf8($_) || !($_ =~ /[\x80-\xFF]/))
40             or croak "Can't serialize $entry->{name}, all attributes must be unicode string, or have TO_JSON: '$_'"
41 60 100 100     1261 for values %$entry;
      66        
      66        
42 57         127 $entry;
43             } @$entry_list;
44              
45 25   66     61 $_json_coder ||= _build_json_coder();
46              
47 25   50     133 my $json= $_json_coder->encode($metadata || {});
48 25         47 my $ret= "CAS_Dir 09 universal\n"
49             ."{\"metadata\":$json,\n"
50             ." \"entries\":[\n";
51 25         27 for (@entries) {
52 57         229 $ret .= $_json_coder->encode($_).",\n"
53             }
54              
55             # remove trailing comma
56 25 100       54 substr($ret, -2)= "\n" if @entries;
57 25         83 return $ret."]}";
58             }
59              
60              
61             sub decode {
62 50     50 1 708 my ($class, $params)= @_;
63 50 100       94 defined $params->{format} or $params->{format}= $class->_read_format($params);
64 50         50 my $bytes= $params->{data};
65 50         41 my $handle= $params->{handle};
66              
67             # This implementation just processes the file as a whole.
68             # Read it in if we don't have it yet.
69 50         104 my $header_len= $class->_calc_header_length($params->{format});
70 50 100       88 if (defined $bytes) {
71 1         2 substr($bytes, 0, $header_len)= '';
72             }
73             else {
74 49 50       69 defined $handle or $handle= $params->{file}->open;
75 49 50       79 seek($handle, $header_len, 0) or croak "seek: $!";
76 49         104 local $/= undef;
77 49         146 $bytes= <$handle>;
78             }
79              
80 50   33     86 $_json_coder ||= _build_json_coder();
81              
82 50         526 my $data= $_json_coder->decode($bytes);
83 50 50 33     218 defined $data->{metadata} && ref($data->{metadata}) eq 'HASH'
84             or croak "Directory data is missing 'metadata'";
85 50 50 33     151 defined $data->{entries} && ref($data->{entries}) eq 'ARRAY'
86             or croak "Directory data is missing 'entries'";
87 50         48 my @entries;
88 50         40 for my $ent (@{$data->{entries}}) {
  50         84  
89 128         290 push @entries, DataStore::CAS::FS::DirEnt->new($ent);
90             };
91             return DataStore::CAS::FS::Dir->new(
92             file => $params->{file},
93             format => $params->{format},
94             entries => \@entries,
95             metadata => $data->{metadata}
96 50         196 );
97             }
98              
99             1;
100              
101             __END__