File Coverage

blib/lib/SQL/Translator/Schema/Role/Extra.pm
Criterion Covered Total %
statement 11 11 100.0
branch 2 2 100.0
condition n/a
subroutine 3 3 100.0
pod 1 1 100.0
total 17 17 100.0


line stmt bran cond sub pod time code
1             package SQL::Translator::Schema::Role::Extra;
2              
3             =head1 NAME
4              
5             SQL::Translator::Schema::Role::Extra - "extra" attribute for schema classes
6              
7             =head1 SYNOPSIS
8              
9             package Foo;
10             use Moo;
11             with qw(SQL::Translator::Schema::Role::Extra);
12              
13             =head1 DESCRIPTION
14              
15             This role provides methods to set and get a hashref of extra attributes
16             for schema objects.
17              
18             =cut
19              
20 77     77   47703 use Moo::Role;
  77         2361  
  77         623  
21 77     77   45263 use Sub::Quote qw(quote_sub);
  77         310  
  77         29253  
22              
23             =head1 METHODS
24              
25             =head2 extra
26              
27             Get or set the objects "extra" attributes (e.g., "ZEROFILL" for MySQL fields).
28             Call with no args to get all the extra data.
29             Call with a single name arg to get the value of the named extra attribute,
30             returned as a scalar. Call with a hash or hashref to set extra attributes.
31             Returns a hash or a hashref.
32              
33             $field->extra( qualifier => 'ZEROFILL' );
34              
35             $qualifier = $field->extra('qualifier');
36              
37             %extra = $field->extra;
38             $extra = $field->extra;
39              
40             =cut
41              
42             has extra => (is => 'rwp', default => quote_sub(q{ +{} }));
43              
44             around extra => sub {
45             my ($orig, $self) = (shift, shift);
46              
47             @_ = %{ $_[0] } if ref $_[0] eq "HASH";
48             my $extra = $self->$orig;
49              
50             if (@_ == 1) {
51             return $extra->{ $_[0] };
52             } elsif (@_) {
53             my %args = @_;
54             while (my ($key, $value) = each %args) {
55             $extra->{$key} = $value;
56             }
57             }
58              
59             return wantarray ? %$extra : $extra;
60             };
61              
62             =head2 remove_extra
63              
64             L can only be used to get or set "extra" attributes but not to
65             remove some. Call with no args to remove all extra attributes that
66             have been set before. Call with a list of key names to remove
67             certain extra attributes only.
68              
69             # remove all extra attributes
70             $field->remove_extra();
71              
72             # remove timezone and locale attributes only
73             $field->remove_extra(qw/timezone locale/);
74              
75             =cut
76              
77             sub remove_extra {
78 4     4 1 3637 my ($self, @keys) = @_;
79 4 100       16 unless (@keys) {
80 2         18 $self->_set_extra({});
81             } else {
82 2         6 delete @{ $self->extra }{@keys};
  2         77  
83             }
84             }
85              
86             1;