Commit | Line | Data |
5f7fd749 |
1 | package SQL::Translator::Schema::Role::Extra; |
4e43db0d |
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 | |
5f7fd749 |
20 | use Moo::Role; |
68d75205 |
21 | use Sub::Quote qw(quote_sub); |
5f7fd749 |
22 | |
23 | |
4e43db0d |
24 | =head1 METHODS |
5f7fd749 |
25 | |
26 | =head2 extra |
27 | |
e757697c |
28 | Get or set the objects "extra" attributes (e.g., "ZEROFILL" for MySQL fields). |
5f7fd749 |
29 | Call with no args to get all the extra data. |
30 | Call with a single name arg to get the value of the named extra attribute, |
31 | returned as a scalar. Call with a hash or hashref to set extra attributes. |
32 | Returns a hash or a hashref. |
33 | |
34 | $field->extra( qualifier => 'ZEROFILL' ); |
35 | |
36 | $qualifier = $field->extra('qualifier'); |
37 | |
38 | %extra = $field->extra; |
39 | $extra = $field->extra; |
40 | |
41 | =cut |
42 | |
68d75205 |
43 | has extra => ( is => 'rwp', default => quote_sub(q{ +{} }) ); |
5f7fd749 |
44 | |
45 | around extra => sub { |
46 | my ($orig, $self) = (shift, shift); |
47 | |
48 | @_ = %{$_[0]} if ref $_[0] eq "HASH"; |
49 | my $extra = $self->$orig; |
50 | |
51 | if (@_==1) { |
c5409185 |
52 | return $extra->{$_[0]}; |
5f7fd749 |
53 | } |
54 | elsif (@_) { |
55 | my %args = @_; |
56 | while ( my ( $key, $value ) = each %args ) { |
57 | $extra->{$key} = $value; |
58 | } |
59 | } |
60 | |
61 | return wantarray ? %$extra : $extra; |
62 | }; |
63 | |
64 | =head2 remove_extra |
65 | |
66 | L</extra> can only be used to get or set "extra" attributes but not to |
67 | remove some. Call with no args to remove all extra attributes that |
68 | have been set before. Call with a list of key names to remove |
69 | certain extra attributes only. |
70 | |
71 | # remove all extra attributes |
72 | $field->remove_extra(); |
73 | |
74 | # remove timezone and locale attributes only |
75 | $field->remove_extra(qw/timezone locale/); |
76 | |
77 | =cut |
78 | |
79 | sub remove_extra { |
80 | my ( $self, @keys ) = @_; |
81 | unless (@keys) { |
82 | $self->_set_extra({}); |
83 | } |
84 | else { |
85 | delete @{$self->extra}{@keys}; |
86 | } |
87 | } |
88 | |
89 | 1; |