add -I option to dbicdump
[dbsrgits/DBIx-Class-Schema-Loader.git] / script / dbicdump
1 #!/usr/bin/perl
2
3 =head1 NAME
4
5 dbicdump - 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
13 Examples:
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
34 On 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     
41 Configuration files must have schema_class and connect_info sections,
42 an 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
61 Using a config file requires L<Config::Any> installed.
62
63 The optional C<lib> key is equivalent to the C<-I> option.
64
65 =head1 DESCRIPTION
66
67 Dbicdump generates a L<DBIx::Class> schema using
68 L<DBIx::Class::Schema::Loader/make_schema_at> and dumps it to disk.
69
70 You can pass any L<DBIx::Class::Schema::Loader::Base> constructor option using
71 C<< -o <option>=<value> >>. For convenience, option names will have C<->
72 replaced with C<_> and values that look like references or quote-like
73 operators will be C<eval>-ed before being passed to the constructor.
74
75 The C<dump_directory> option defaults to the current directory if not
76 specified.
77
78 =head1 SEE ALSO
79
80 L<DBIx::Class::Schema::Loader>, L<DBIx::Class>.
81
82 =head1 AUTHOR
83
84 Dagfinn Ilmari Manns?ker C<< <ilmari@ilmari.org> >>
85
86 =head1 CONTRIBUTORS
87
88 Caelum: Rafael Kitover <rkitover@cpan.org>
89
90 alnewkirk: Al Newkirk <awncorp@cpan.org>
91
92 =head1 LICENSE
93
94 This program is free software; you can redistribute it and/or modify it
95 under the same terms as Perl itself.
96
97 =cut
98
99 use strict;
100 use warnings;
101 use Getopt::Long;
102 use Pod::Usage;
103 use DBIx::Class::Schema::Loader 'make_schema_at';
104 use namespace::clean;
105 use DBIx::Class::Schema::Loader::Base ();
106 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
107 require lib;
108
109 my $loader_options;
110
111 Getopt::Long::Configure('gnu_getopt');
112
113 GetOptions(
114     'I=s'                => sub { shift; lib->import(shift) },
115     'loader-option|o=s%' => \&handle_option,
116 );
117
118 $loader_options->{dump_directory} ||= '.';
119
120 if (@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 }
164 else {
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
182 exit 0;
183
184 sub 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
192 sub 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
204 1;
205
206 __END__