File Coverage

blib/lib/Geoffrey/Write.pm
Criterion Covered Total %
statement 97 99 97.9
branch 9 12 75.0
condition 5 6 83.3
subroutine 23 23 100.0
pod 18 18 100.0
total 152 158 96.2


line stmt bran cond sub pod time code
1             package Geoffrey::Write;
2              
3 3     3   737 use utf8;
  3         7  
  3         18  
4 3     3   126 use 5.016;
  3         11  
5 3     3   15 use strict;
  3         33  
  3         66  
6 3     3   14 use warnings;
  3         6  
  3         173  
7              
8             $Geoffrey::Write::VERSION = '0.000205';
9              
10 3     3   19 use parent 'Geoffrey::Role::Core';
  3         6  
  3         18  
11              
12             sub new {
13 3     3 1 49 my $class = shift;
14 3         18 my $self = $class->SUPER::new(@_);
15             $self->{changelog_types} = [
16 3         35 qw/sequences tables primaries uniques
17             foreigns indexes views functions triggers/
18             ];
19 3         17 return bless $self, $class;
20             }
21              
22 21   100 21 1 241 sub author { return $_[0]->{author} // 'Mario Zieschang'; }
23 20   50 20 1 147 sub changeset_key { return $_[0]->{changeset_key} // 'maz'; }
24 13     13 1 1817 sub inc_changelog_count { return $_[0]->{changelog_count}++; }
25 34   100 34 1 82 sub changelog_count { $_[0]->{changelog_count} //= 0; return $_[0]->{changelog_count}; }
  34         264  
26              
27             sub changeset_id {
28 20     20 1 36 my ($self, $i_count) = @_;
29 20 100       40 return join q/-/, $self->changelog_count, $i_count ? $i_count : 1, $self->changeset_key;
30             }
31              
32             sub changeset {
33 1     1 1 3 my $self = shift;
34 1 50       5 return $self->{changeset} if ($self->{changeset});
35 1         6 require Geoffrey::Changeset;
36 1         5 $self->{changeset} = Geoffrey::Changeset->new(converter => $self->converter, dbh => $self->dbh,);
37 1         9 return $self->{changeset};
38             }
39              
40             sub run {
41 1     1 1 4 my ($self, $s_dir, $s_schema, $b_dump) = @_;
42 1         5 my $o_changelog_io = $self->changelog_io;
43             # if changelog_io needs a dbh it must store the changelogs into a database
44             # and not in a filepath
45 1 50       4 if ($o_changelog_io->needs_dbh) {
46 0         0 $s_dir = q~changelog-~;
47             }
48             else {
49 1         5 require File::Path;
50 1         79 File::Path::make_path($s_dir);
51 1         5 $s_dir = $s_dir . q~/changelog-~;
52             }
53              
54 1         3 my @a_changelogs = ();
55 1         2 for (@{$self->{changelog_types}}) {
  1         5  
56 9 100       21 my $ar_data = eval { return $self->$_($s_schema, 1); } or do { next; };
  9         105  
  6         8828  
57 3 50       7 next if scalar @{$ar_data} == 0;
  3         9  
58 3         8 my $s_file = $s_dir . $self->inc_changelog_count . q/-/ . $_;
59 3         15 $o_changelog_io->write($s_file, $ar_data, $b_dump);
60 3         9 push @a_changelogs, $self->changelog_count . q/-/ . $_;
61             }
62 1         9 return $o_changelog_io->write($s_dir . q~/changelog~, {changelogs => \@a_changelogs}, $b_dump);
63             }
64              
65             sub sequences {
66 2     2 1 6 my ($self, $s_schema) = @_;
67 2         1098 require Geoffrey::Action::Constraint::Default;
68             return [{
69 2         10 id => $self->changeset_id,
70             author => $self->author,
71             entries =>
72             Geoffrey::Action::Constraint::Default->new(dbh => $self->dbh, converter => $self->converter)
73             ->list_from_schema($s_schema)}];
74             }
75              
76             sub tables {
77 2     2 1 7 my ($self, $s_schema, $include_columns) = @_;
78 2         5 my $count = 1;
79 2         10 require Geoffrey::Action::Table;
80 2         9 my $o_tables = Geoffrey::Action::Table->new(dbh => $self->dbh, converter => $self->converter);
81              
82 9         28 return [map { $self->map_entry([{action => 'table.add', name => $_}], $count++) }
83 2 100       8 @{$o_tables->list_from_schema($s_schema)}]
  1         5  
84             if !$include_columns;
85              
86 1         4 require Geoffrey::Action::Column;
87 1         5 my $o_columns = Geoffrey::Action::Column->new(dbh => $self->dbh, converter => $self->converter);
88             return [
89             map {
90 1         8 $self->map_entry([{
91             action => 'table.add',
92             name => $_,
93             columns => $o_columns->list_from_schema($s_schema, $_)}
94             ],
95             $count++
96             )
97 1         2 } @{$o_tables->list_from_schema($s_schema)}];
  1         6  
98             }
99              
100             sub primaries {
101 2     2 1 6 my ($self, $s_schema) = @_;
102 2         577 require Geoffrey::Action::Constraint::PrimaryKey;
103             return [
104 2         12 $self->map_entry(
105             Geoffrey::Action::Constraint::PrimaryKey->new(dbh => $self->dbh, converter => $self->converter)
106             ->list_from_schema($s_schema))];
107             }
108              
109             sub uniques {
110 2     2 1 6 my ($self, $s_schema) = @_;
111 2         541 require Geoffrey::Action::Constraint::Unique;
112             return [
113 2         15 $self->map_entry(
114             Geoffrey::Action::Constraint::Unique->new(dbh => $self->dbh, converter => $self->converter)
115             ->list_from_schema($s_schema))];
116             }
117              
118             sub foreigns {
119 2     2 1 7 my ($self, $s_schema) = @_;
120 2         5 my $count = 1;
121 2         558 require Geoffrey::Action::Constraint::ForeignKey;
122 2         11 my $o_foreign_keys
123             = Geoffrey::Action::Constraint::ForeignKey->new(dbh => $self->dbh, converter => $self->converter);
124 2         5 return [map { $self->map_entry([$_], $count++) } @{$o_foreign_keys->list_from_schema($s_schema)}];
  0         0  
  2         10  
125             }
126              
127             sub indexes {
128 2     2 1 6 my ($self, $s_schema) = @_;
129 2         525 require Geoffrey::Action::Constraint::Index;
130             return [
131 2         101 $self->map_entry(
132             Geoffrey::Action::Constraint::Index->new(converter => $self->converter, dbh => $self->dbh)
133             ->list_from_schema($s_schema))];
134             }
135              
136             sub views {
137 2     2 1 13 my ($self, $s_schema) = @_;
138 2         972 require Geoffrey::Action::View;
139             return [
140 2         12 $self->map_entry(
141             Geoffrey::Action::View->new(converter => $self->converter, dbh => $self->dbh)
142             ->list_from_schema($s_schema),
143             1
144             )];
145             }
146              
147             sub functions {
148 3     3 1 11 my ($self, $s_schema) = @_;
149 3         5 my $count = 1;
150 3         1487 require Geoffrey::Action::Function;
151 3         19 my $o_functions = Geoffrey::Action::Function->new(dbh => $self->dbh, converter => $self->converter);
152 3         10 return [map { $self->map_entry([$_], $count++) } @{$o_functions->list($s_schema)}];
  2         8  
  3         12  
153             }
154              
155             sub triggers {
156 3     3 1 409 my ($self, $s_schema) = @_;
157 3         5 my $count = 1;
158 3         1492 require Geoffrey::Action::Trigger;
159 3         23 my $o_trigger = Geoffrey::Action::Trigger->new(dbh => $self->dbh, converter => $self->converter);
160 3         8 return [map { $self->map_entry([$_], $count++) } @{$o_trigger->list($s_schema)}];
  2         8  
  3         12  
161             }
162              
163             sub map_entry {
164 18     18 1 37 my ($self, $ar_entries, $i_count) = @_;
165 18         43 return {id => $self->changeset_id($i_count), author => $self->author, entries => $ar_entries,};
166             }
167              
168             1; # End of Geoffrey::Read
169              
170             __END__