File Coverage

blib/lib/Metabase/Fact/Hash.pm
Criterion Covered Total %
statement 37 39 94.8
branch 5 6 83.3
condition 2 4 50.0
subroutine 9 11 81.8
pod 3 3 100.0
total 56 63 88.8


line stmt bran cond sub pod time code
1 5     5   8620 use 5.006;
  5         17  
  5         198  
2 5     5   26 use strict;
  5         8  
  5         158  
3 5     5   27 use warnings;
  5         8  
  5         256  
4              
5             package Metabase::Fact::Hash;
6             our $VERSION = '0.024'; # VERSION
7              
8 5     5   33 use Carp ();
  5         9  
  5         83  
9 5     5   30 use JSON 2 ();
  5         120  
  5         101  
10              
11 5     5   29 use Metabase::Fact;
  5         9  
  5         2377  
12             our @ISA = qw/Metabase::Fact/;
13              
14             sub validate_content {
15 7     7 1 10 my ($self) = @_;
16 7         35 my $content = $self->content;
17 7         14 my $class = ref $self;
18 7 50       23 Carp::confess "content must be a hashref"
19             unless ref $content eq 'HASH';
20 7   50 0   36 my $get_req = $self->can('required_keys') || sub { () };
  0         0  
21 7   50 0   30 my $get_opt = $self->can('optional_keys') || sub { () };
  0         0  
22             # find missing
23 7         24 my @missing = grep { !exists $content->{$_} } $get_req->();
  7         53  
24 7 100       264 Carp::croak "missing required keys for $class\: @missing\n" if @missing;
25             # check for invalid
26 6         17 my %valid = map { $_ => 1 } ( $get_req->(), $get_opt->() );
  12         57  
27 6         17 my @invalid = grep { !exists $valid{$_} } keys %$content;
  10         27  
28 6 100       224 Carp::croak "invalid keys for $class\: @invalid\n" if @invalid;
29 5         21 return 1;
30             }
31              
32             sub content_as_bytes {
33 5     5 1 9 my ($self) = @_;
34 5         58 return JSON->new->ascii->encode( $self->content );
35             }
36              
37             sub content_from_bytes {
38 1     1 1 10 my ( $class, $bytes ) = @_;
39 1         45 return JSON->new->ascii->decode($bytes);
40             }
41              
42             1;
43              
44             # ABSTRACT: fact subtype for simple hashes
45              
46             __END__