Commit | Line | Data |
8a3edced |
1 | package DBIx::Class::DeploymentHandler::Filesystem; |
2 | |
3 | use Moose; |
4 | use Method::Signatures::Simple; |
5 | use File::Path 'mkpath'; |
6 | use File::Spec::Functions; |
7 | use Try::Tiny; |
8 | |
9 | has script_directory => ( |
10 | isa => 'Str', |
11 | is => 'ro', |
12 | required => 1, |
13 | default => 'sql', |
14 | ); |
15 | |
16 | has ignore_ddl => ( is => 'ro' ); |
17 | |
d9b28130 |
18 | method __ddl_protoschema_consume_with_prefix($versions, $prefix) { |
8a3edced |
19 | my $base_dir = $self->script_directory; |
20 | |
d9b28130 |
21 | my $dir; |
22 | if ($prefix eq 'deploy') { |
23 | $dir = catfile( $base_dir, '_source', $prefix, join q(-), @{$versions}); |
24 | } else { |
25 | $dir = catfile( $base_dir, '_preprocess_schema', $prefix, join q(-), @{$versions}); |
26 | } |
27 | |
8a3edced |
28 | return [] unless -d $dir; |
29 | |
30 | opendir my($dh), $dir; |
d9b28130 |
31 | my %files = map { $_ => "$dir/$_" } grep { /\.pl$|\.yml$/ && -f "$dir/$_" } readdir $dh; |
8a3edced |
32 | closedir $dh; |
33 | |
34 | return [@files{sort keys %files}] |
35 | } |
36 | |
d9b28130 |
37 | method _ddl_protoschema_deploy_consume_filenames($version) { |
38 | $self->__ddl_protoschema_consume_with_prefix([$version], 'deploy') |
39 | } |
8a3edced |
40 | |
d9b28130 |
41 | method _ddl_protoschema_upgrade_consume_filenames($versions) { |
42 | $self->__ddl_protoschema_consume_with_prefix($versions, 'upgrade') |
8a3edced |
43 | } |
44 | |
45 | method _ddl_protoschema_downgrade_consume_filenames($versions) { |
d9b28130 |
46 | $self->__ddl_protoschema_consume_with_prefix($versions, 'downgrade') |
8a3edced |
47 | } |
48 | |
49 | |
8a3edced |
50 | method __ddl_consume_with_prefix($type, $versions, $prefix) { |
51 | my $base_dir = $self->script_directory; |
52 | |
53 | my $main = catfile( $base_dir, $type ); |
54 | my $common = |
55 | catfile( $base_dir, '_common', $prefix, join q(-), @{$versions} ); |
56 | |
57 | my $common_any = |
58 | catfile( $base_dir, '_common', $prefix, '_any' ); |
59 | |
60 | my $dir; |
61 | if (-d $main) { |
62 | $dir = catfile($main, $prefix, join q(-), @{$versions}) |
63 | } else { |
64 | if ($self->ignore_ddl) { |
65 | return [] |
66 | } else { |
67 | die "$main does not exist; please write/generate some SQL" |
68 | } |
69 | } |
70 | my $dir_any = catfile($main, $prefix, '_any'); |
71 | |
72 | my %files; |
73 | try { |
74 | opendir my($dh), $dir; |
75 | %files = |
76 | map { $_ => "$dir/$_" } |
77 | grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" } |
78 | readdir $dh; |
79 | closedir $dh; |
80 | } catch { |
81 | die $_ unless $self->ignore_ddl; |
82 | }; |
83 | for my $dirname (grep { -d $_ } $common, $common_any, $dir_any) { |
84 | opendir my($dh), $dirname; |
85 | for my $filename (grep { /\.(?:sql|pl)$/ && -f catfile($dirname,$_) } readdir $dh) { |
86 | unless ($files{$filename}) { |
87 | $files{$filename} = catfile($dirname,$filename); |
88 | } |
89 | } |
90 | closedir $dh; |
91 | } |
92 | |
93 | return [@files{sort keys %files}] |
94 | } |
95 | |
96 | method _ddl_initialize_consume_filenames($type, $version) { |
97 | $self->__ddl_consume_with_prefix($type, [ $version ], 'initialize') |
98 | } |
99 | |
100 | method _ddl_schema_consume_filenames($type, $version) { |
101 | $self->__ddl_consume_with_prefix($type, [ $version ], 'deploy') |
102 | } |
103 | |
104 | method _ddl_schema_upgrade_consume_filenames($type, $versions) { |
105 | $self->__ddl_consume_with_prefix($type, $versions, 'upgrade') |
106 | } |
107 | |
108 | method _ddl_schema_downgrade_consume_filenames($type, $versions) { |
109 | $self->__ddl_consume_with_prefix($type, $versions, 'downgrade') |
110 | } |
111 | |
112 | |
d9b28130 |
113 | method __ddl_produce_with_prefix($type, $versions, $suffix, $prefix) { |
114 | my $dirname = catfile( $self->script_directory, $type, $prefix, join '-', @$versions ); |
8a3edced |
115 | mkpath($dirname) unless -d $dirname; |
116 | |
d9b28130 |
117 | return catfile( $dirname, "001-auto.$suffix" ); |
8a3edced |
118 | } |
119 | |
d9b28130 |
120 | method _ddl_schema_produce_filename($type, $version) { |
121 | $self->__ddl_produce_with_prefix($type, [$version], 'sql', 'deploy'); |
122 | } |
8a3edced |
123 | |
d9b28130 |
124 | method _ddl_schema_upgrade_produce_filename($type, $versions) { |
125 | $self->__ddl_produce_with_prefix($type, $versions, 'sql', 'upgrade'); |
8a3edced |
126 | } |
127 | |
128 | method _ddl_schema_downgrade_produce_filename($type, $versions, $dir) { |
d9b28130 |
129 | $self->__ddl_produce_with_prefix($type, $versions, 'sql', 'downgrade'); |
130 | } |
8a3edced |
131 | |
d9b28130 |
132 | method _ddl_protoschema_produce_filename($version) { |
133 | $self->__ddl_produce_with_prefix('_source', [$version], 'yml', 'deploy'); |
8a3edced |
134 | } |
135 | |
136 | |
137 | method _read_sql_file($file) { |
138 | return unless $file; |
139 | |
140 | open my $fh, '<', $file; |
141 | my @data = split /;\n/, join '', <$fh>; |
142 | close $fh; |
143 | |
144 | @data = grep { |
145 | $_ && # remove blank lines |
146 | !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's |
147 | } map { |
148 | s/^\s+//; s/\s+$//; # trim whitespace |
149 | join '', grep { !/^--/ } split /\n/ # remove comments |
150 | } @data; |
151 | |
152 | return \@data; |
153 | } |
154 | |
155 | method _coderefs_per_files($files) { |
156 | no warnings 'redefine'; |
157 | [map eval do { local( @ARGV, $/ ) = $_; <> }, @$files] |
158 | } |
159 | |
160 | |
161 | method _write_data_string($filename, $data) { |
162 | open my $file, q(>), $filename; |
163 | print {$file} $data; |
164 | close $file; |
165 | } |
166 | |
167 | |
168 | method _write_data_list($filename, $data) { |
169 | open my $file, q(>), $filename; |
170 | print {$file} join ";\n", @$data; |
171 | close $file; |
172 | } |
173 | |
174 | __PACKAGE__->meta->make_immutable; |
175 | |
176 | 1; |