1 package DBIx::Class::DeploymentHandler::Filesystem;
4 use Method::Signatures::Simple;
5 use File::Path 'mkpath';
6 use File::Spec::Functions;
9 has script_directory => (
16 has ignore_ddl => ( is => 'ro' );
18 method __ddl_protoschema_consume_with_prefix($versions, $prefix) {
19 my $base_dir = $self->script_directory;
22 if ($prefix eq 'deploy') {
23 $dir = catfile( $base_dir, '_source', $prefix, join q(-), @{$versions});
25 $dir = catfile( $base_dir, '_preprocess_schema', $prefix, join q(-), @{$versions});
28 return [] unless -d $dir;
30 opendir my($dh), $dir;
31 my %files = map { $_ => "$dir/$_" } grep { /\.pl$|\.yml$/ && -f "$dir/$_" } readdir $dh;
34 return [@files{sort keys %files}]
37 method _ddl_protoschema_deploy_consume_filenames($version) {
38 $self->__ddl_protoschema_consume_with_prefix([$version], 'deploy')
41 method _ddl_protoschema_upgrade_consume_filenames($versions) {
42 $self->__ddl_protoschema_consume_with_prefix($versions, 'upgrade')
45 method _ddl_protoschema_downgrade_consume_filenames($versions) {
46 $self->__ddl_protoschema_consume_with_prefix($versions, 'downgrade')
50 method __ddl_consume_with_prefix($type, $versions, $prefix) {
51 my $base_dir = $self->script_directory;
53 my $main = catfile( $base_dir, $type );
55 catfile( $base_dir, '_common', $prefix, join q(-), @{$versions} );
58 catfile( $base_dir, '_common', $prefix, '_any' );
62 $dir = catfile($main, $prefix, join q(-), @{$versions})
64 if ($self->ignore_ddl) {
67 die "$main does not exist; please write/generate some SQL"
70 my $dir_any = catfile($main, $prefix, '_any');
74 opendir my($dh), $dir;
76 map { $_ => "$dir/$_" }
77 grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" }
81 die $_ unless $self->ignore_ddl;
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);
93 return [@files{sort keys %files}]
96 method _ddl_initialize_consume_filenames($type, $version) {
97 $self->__ddl_consume_with_prefix($type, [ $version ], 'initialize')
100 method _ddl_schema_consume_filenames($type, $version) {
101 $self->__ddl_consume_with_prefix($type, [ $version ], 'deploy')
104 method _ddl_schema_upgrade_consume_filenames($type, $versions) {
105 $self->__ddl_consume_with_prefix($type, $versions, 'upgrade')
108 method _ddl_schema_downgrade_consume_filenames($type, $versions) {
109 $self->__ddl_consume_with_prefix($type, $versions, 'downgrade')
113 method __ddl_produce_with_prefix($type, $versions, $suffix, $prefix) {
114 my $dirname = catfile( $self->script_directory, $type, $prefix, join '-', @$versions );
115 mkpath($dirname) unless -d $dirname;
117 return catfile( $dirname, "001-auto.$suffix" );
120 method _ddl_schema_produce_filename($type, $version) {
121 $self->__ddl_produce_with_prefix($type, [$version], 'sql', 'deploy');
124 method _ddl_schema_upgrade_produce_filename($type, $versions) {
125 $self->__ddl_produce_with_prefix($type, $versions, 'sql', 'upgrade');
128 method _ddl_schema_downgrade_produce_filename($type, $versions, $dir) {
129 $self->__ddl_produce_with_prefix($type, $versions, 'sql', 'downgrade');
132 method _ddl_protoschema_produce_filename($version) {
133 $self->__ddl_produce_with_prefix('_source', [$version], 'yml', 'deploy');
137 method _read_sql_file($file) {
140 open my $fh, '<', $file;
141 my @data = split /;\n/, join '', <$fh>;
145 $_ && # remove blank lines
146 !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's
148 s/^\s+//; s/\s+$//; # trim whitespace
149 join '', grep { !/^--/ } split /\n/ # remove comments
155 method _coderefs_per_files($files) {
156 no warnings 'redefine';
157 [map eval do { local( @ARGV, $/ ) = $_; <> }, @$files]
161 method _write_data_string($filename, $data) {
162 open my $file, q(>), $filename;
168 method _write_data_list($filename, $data) {
169 open my $file, q(>), $filename;
170 print {$file} join ";\n", @$data;
174 __PACKAGE__->meta->make_immutable;