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