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