1#!/usr/bin/perl 2 3=head1 NAME 4 5dbicdump - Dump a schema using DBIx::Class::Schema::Loader 6 7=head1 SYNOPSIS 8 9 dbicdump <configuration_file> 10 dbicdump [-I <lib-path>] [-o <loader_option>=<value> ] \ 11 <schema_class> <connect_info> 12 13Examples: 14 15 $ dbicdump schema.conf 16 17 $ dbicdump -o dump_directory=./lib \ 18 -o components='["InflateColumn::DateTime"]' \ 19 MyApp::Schema dbi:SQLite:./foo.db 20 21 $ dbicdump -o dump_directory=./lib \ 22 -o components='["InflateColumn::DateTime"]' \ 23 MyApp::Schema dbi:SQLite:./foo.db '{ quote_char => "\"" }' 24 25 $ dbicdump -Ilib -o dump_directory=./lib \ 26 -o components='["InflateColumn::DateTime"]' \ 27 -o preserve_case=1 \ 28 MyApp::Schema dbi:mysql:database=foo user pass '{ quote_char => "`" }' 29 30 $ dbicdump -o dump_directory=./lib \ 31 -o components='["InflateColumn::DateTime"]' \ 32 MyApp::Schema 'dbi:mysql:database=foo;host=domain.tld;port=3306' user pass 33 34On Windows that would be: 35 36 $ dbicdump -o dump_directory=.\lib ^ 37 -o components="[q{InflateColumn::DateTime}]" ^ 38 -o preserve_case=1 ^ 39 MyApp::Schema dbi:mysql:database=foo user pass "{ quote_char => q{`} }" 40 41Configuration files must have schema_class and connect_info sections, 42an example of a general config file is as follows: 43 44 schema_class MyApp::Schema 45 46 lib /extra/perl/libs 47 48 # connection string 49 <connect_info> 50 dsn dbi:mysql:example 51 user root 52 pass secret 53 </connect_info> 54 55 # dbic loader options 56 <loader_options> 57 components InflateColumn::DateTime 58 components TimeStamp 59 </loader_options> 60 61Using a config file requires L<Config::Any> installed. 62 63The optional C<lib> key is equivalent to the C<-I> option. 64 65=head1 DESCRIPTION 66 67Dbicdump generates a L<DBIx::Class> schema using 68L<DBIx::Class::Schema::Loader/make_schema_at> and dumps it to disk. 69 70You can pass any L<DBIx::Class::Schema::Loader::Base> constructor option using 71C<< -o <option>=<value> >>. For convenience, option names will have C<-> 72replaced with C<_> and values that look like references or quote-like 73operators will be C<eval>-ed before being passed to the constructor. 74 75The C<dump_directory> option defaults to the current directory if not 76specified. 77 78=head1 SEE ALSO 79 80L<DBIx::Class::Schema::Loader>, L<DBIx::Class>. 81 82=head1 AUTHOR 83 84Dagfinn Ilmari Manns?ker C<< <ilmari@ilmari.org> >> 85 86=head1 CONTRIBUTORS 87 88Caelum: Rafael Kitover <rkitover@cpan.org> 89 90alnewkirk: Al Newkirk <awncorp@cpan.org> 91 92=head1 LICENSE 93 94This program is free software; you can redistribute it and/or modify it 95under the same terms as Perl itself. 96 97=cut 98 99use strict; 100use warnings; 101use Getopt::Long; 102use Pod::Usage; 103use DBIx::Class::Schema::Loader 'make_schema_at'; 104use namespace::clean; 105use DBIx::Class::Schema::Loader::Base (); 106use DBIx::Class::Schema::Loader::Optional::Dependencies (); 107require lib; 108 109my $loader_options; 110 111Getopt::Long::Configure('gnu_getopt'); 112 113GetOptions( 114 'I=s' => sub { shift; lib->import(shift) }, 115 'loader-option|o=s%' => \&handle_option, 116); 117 118$loader_options->{dump_directory} ||= '.'; 119 120if (@ARGV == 1) { 121 if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('dbicdump_config')) { 122 die sprintf "You must install the following CPAN modules to use a config file with dbicdump: %s.\n", 123 DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('dbicdump_config'); 124 } 125 126 my $configuration_file = shift @ARGV; 127 128 my $configurations = 129 Config::Any->load_files( { 130 use_ext => 1, 131 flatten_to_hash => 1, 132 files => [$configuration_file] } ); 133 134 my $c = (values %$configurations)[0]; 135 136 unless (keys %{$c->{connect_info}} && $c->{schema_class}) { 137 pod2usage(1); 138 } 139 140 my @libs; 141 142 if ($c->{lib}) { 143 if (ref $c->{lib}) { 144 @libs = @{ $c->{lib} }; 145 } 146 147 @libs = ($c->{lib}); 148 } 149 150 lib->import($_) for @libs; 151 152 my ($dsn, $user, $pass, $options) = 153 map { $c->{connect_info}->{$_} } qw/dsn user pass options/; 154 $options ||= {}; 155 $c->{loader_options}->{dump_directory} ||= 156 $loader_options->{dump_directory}; 157 158 make_schema_at( 159 $c->{schema_class}, 160 $c->{loader_options} || {}, 161 [ $dsn, $user, $pass, %{$options} ], 162 ); 163} 164else { 165 my ($schema_class, @loader_connect_info) = @ARGV 166 or pod2usage(1); 167 168 my $dsn = shift @loader_connect_info; 169 170 my ($user, $pass) = $dsn =~ /sqlite/i ? ('', '') 171 : splice @loader_connect_info, 0, 2; 172 173 my @extra_connect_info_opts = map parse_value($_), @loader_connect_info; 174 175 make_schema_at( 176 $schema_class, 177 $loader_options, 178 [ $dsn, $user, $pass, @extra_connect_info_opts ], 179 ); 180} 181 182exit 0; 183 184sub parse_value { 185 my $value = shift; 186 187 $value = eval $value if $value =~ /^\s*(?:sub\s*\{|q\w?\s*[^\w\s]|[[{])/; 188 189 return $value; 190} 191 192sub handle_option { 193 my ($self, $key, $value) = @_; 194 195 $key =~ tr/-/_/; 196 die "Unknown option: $key\n" 197 unless DBIx::Class::Schema::Loader::Base->can($key); 198 199 $value = parse_value $value; 200 201 $loader_options->{$key} = $value; 202} 203 2041; 205 206__END__ 207