File Coverage

blib/lib/Data/Sah/Object/Schema.pm
Criterion Covered Total %
statement 50 53 94.3
branch 8 8 100.0
condition 1 2 50.0
subroutine 8 9 88.8
pod 6 6 100.0
total 73 78 93.5


line stmt bran cond sub pod time code
1             package Data::Sah::Object::Schema;
2              
3             our $DATE = '2015-09-06'; # DATE
4             our $VERSION = '0.02'; # VERSION
5              
6 1     1   38 use 5.010;
  1         3  
7 1     1   5 use strict;
  1         1  
  1         27  
8 1     1   4 use warnings;
  1         2  
  1         460  
9              
10             sub new {
11 7     7 1 13 my ($class, $sch, $is_normalized) = @_;
12 7   50     17 $sch //= [undef, {}, {}];
13              
14 7 100       14 unless ($is_normalized) {
15 6         800 require Data::Sah::Normalize;
16 6         1520 $sch = Data::Sah::Normalize::normalize_schema($sch);
17             }
18              
19 7         204 my $obj = \$sch;
20 7         24 bless $obj, $class;
21             }
22              
23             sub type {
24 9     9 1 27 my $self = shift;
25 9 100       21 if (@_) {
26 1         2 my $old = ${$self}->[0];
  1         3  
27 1         2 ${$self}->[0] = $_[0];
  1         4  
28 1         2 return $old;
29             } else {
30 8         9 return ${$self}->[0];
  8         40  
31             }
32             }
33              
34             sub clause {
35 10     10 1 16 my $self = shift;
36 10         14 my $name = shift;
37 10 100       23 if (@_) {
38 1         2 my $old = ${$self}->[1]{$name};
  1         3  
39 1         2 ${$self}->[1]{$name} = $_[0];
  1         2  
40 1         3 return $old;
41             } else {
42 9         12 return ${$self}->[1]{$name};
  9         40  
43             }
44             }
45              
46             sub req {
47 4     4 1 6 my $self = shift;
48 4 100       10 if (@_) {
49 1         2 my $old = ${$self}->[1]{req};
  1         3  
50 1         2 ${$self}->[1]{req} = $_[0];
  1         2  
51 1         3 return $old;
52             } else {
53 3         5 return ${$self}->[1]{req};
  3         11  
54             }
55             }
56              
57             sub delete_clause {
58 1     1 1 3 my $self = shift;
59 1         2 my $name = shift;
60 1         1 my $old = ${$self}->[1]{$name};
  1         3  
61 1         1 delete ${$self}->[1]{$name};
  1         3  
62 1         2 return $old;
63             }
64              
65             sub as_struct {
66 0     0 1   my $self = shift;
67 0           ${$self};
  0            
68             }
69              
70             1;
71             # ABSTRACT: Represent Sah schema
72              
73             __END__