File Coverage

lib/DBIx/Schema/Changelog/Action/Column.pm
Criterion Covered Total %
statement 39 44 88.6
branch 4 6 66.6
condition n/a
subroutine 11 11 100.0
pod 3 3 100.0
total 57 64 89.0


line stmt bran cond sub pod time code
1             package DBIx::Schema::Changelog::Action::Column;
2              
3             =head1 NAME
4              
5             DBIx::Schema::Changelog::Action::Column - Action handler for table columns
6              
7             =head1 VERSION
8              
9             Version 0.8.0
10              
11             =cut
12              
13             our $VERSION = '0.8.0';
14              
15 6     6   1735 use utf8;
  6         11  
  6         55  
16 6     6   231 use strict;
  6         12  
  6         268  
17 6     6   31 use warnings;
  6         12  
  6         276  
18 6     6   3581 use Text::Trim;
  6         4315  
  6         498  
19 6     6   47 use Moose;
  6         11  
  6         57  
20 6     6   51724 use DBIx::Schema::Changelog::Action::Constraint;
  6         21  
  6         364  
21 6     6   58 use Data::Dumper;
  6         8  
  6         2921  
22              
23             with 'DBIx::Schema::Changelog::Action';
24              
25             =head1 SUBROUTINES/METHODS
26              
27             =over 4
28              
29             =item add
30              
31             Prepare column string for create table.
32             Or add new column into table
33              
34             =cut
35              
36             sub add {
37 107     107 1 936 my ( $self, $col, $constraint ) = @_;
38 107         4833 my $actions = $self->driver()->actions;
39 107         4425 my $type = $self->driver()->type($col);
40 107 100       807 return qq~$col->{name} $type $constraint~ if ( $col->{create_table} );
41 3 50       15 die "Add column is not supported!" unless ( $actions->{add_column} );
42              
43 3         33 my $ret = _replace_spare( $actions->{add_column},
44             [qq~$col->{name} $type $constraint~] );
45 3         26 return $ret;
46              
47             }
48              
49             =item alter
50              
51             Not yet implemented
52              
53             =cut
54              
55             sub alter {
56 1     1 1 4 my ( $self, $params ) = @_;
57 1         28 print STDERR __PACKAGE__, " (", __LINE__,
58             ") Alter column is not supported!", $/;
59 1         7 return undef;
60             }
61              
62             =item drop
63              
64             If it's supported, it will drop defined column from table.
65              
66             =cut
67              
68             sub drop {
69 2     2 1 6 my ( $self, $params ) = @_;
70 2         116 my $actions = $self->driver()->actions;
71 2 50       33 unless ( $actions->{drop_column} ) {
72 2         306 print STDERR __PACKAGE__, " (", __LINE__,
73             ") Drop column is not supported!", $/;
74 2         14 return;
75             }
76 0           foreach ( @{ $params->{dropcolumn} } ) {
  0            
77 0           my $s = _replace_spare( $actions->{alter_table}, [ $params->{name} ] );
78 0           $s .= ' ' . _replace_spare( $actions->{drop_column}, [ $_->{name} ] );
79 0           $self->_do($s);
80             }
81              
82             }
83              
84 6     6   42 no Moose;
  6         9  
  6         52  
85             __PACKAGE__->meta->make_immutable;
86              
87             1;
88              
89             __END__
90              
91             =back
92              
93             =head1 AUTHOR
94              
95             Mario Zieschang, C<< <mario.zieschang at combase.de> >>
96              
97             =head1 LICENSE AND COPYRIGHT
98              
99             Copyright 2015 Mario Zieschang.
100              
101             This program is free software; you can redistribute it and/or modify it
102             under the terms of the the Artistic License (2.0). You may obtain a
103             copy of the full license at:
104              
105             L<http://www.perlfoundation.org/artistic_license_2_0>
106              
107             Any use, modification, and distribution of the Standard or Modified
108             Versions is governed by this Artistic License. By using, modifying or
109             distributing the Package, you accept this license. Do not use, modify,
110             or distribute the Package, if you do not accept this license.
111              
112             If your Modified Version has been derived from a Modified Version made
113             by someone other than you, you are nevertheless required to ensure that
114             your Modified Version complies with the requirements of this license.
115              
116             This license does not grant you the right to use any trademark, service
117             mark, trade name, or logo of the Copyright Holder.
118              
119             This license includes the non-exclusive, worldwide, free-of-charge
120             patent license to make, have made, use, offer to sell, sell, import and
121             otherwise transfer the Package with respect to any patent claims
122             licensable by the Copyright Holder that are necessarily infringed by the
123             Package. If you institute patent litigation (including a cross-claim or
124             counterclaim) against any party alleging that the Package constitutes
125             direct or contributory patent infringement, then this Artistic License
126             to you shall terminate on the date that such litigation is filed.
127              
128             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
129             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
130             THE IMPLIED WARRANTIES OF MERCHANT ABILITY, FITNESS FOR A PARTICULAR
131             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
132             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
133             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
134             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
135             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
136              
137             =cut