|  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__  |