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