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         dump_directory ./lib
  58         components     InflateColumn::DateTime
  59         components     TimeStamp
  60     </loader_options>
  61
  62 Using a config file requires L<Config::Any> installed.
  63
  64 The optional C<lib> key is equivalent to the C<-I> option.
  65
  66 =head1 DESCRIPTION
  67
  68 Dbicdump generates a L<DBIx::Class> schema using
  69 L<DBIx::Class::Schema::Loader/make_schema_at> and dumps it to disk.
  70
  71 You can pass any L<DBIx::Class::Schema::Loader::Base> constructor option using
  72 C<< -o <option>=<value> >>. For convenience, option names will have C<->
  73 replaced with C<_> and values that look like references or quote-like
  74 operators will be C<eval>-ed before being passed to the constructor.
  75
  76 The C<dump_directory> option defaults to the current directory if not
  77 specified.
  78
  79 =head1 SEE ALSO
  80
  81 L<DBIx::Class::Schema::Loader>, L<DBIx::Class>.
  82
  83 =head1 AUTHOR
  84
  85 Dagfinn Ilmari Manns?ker C<< <ilmari@ilmari.org> >>
  86
  87 =head1 CONTRIBUTORS
  88
  89 Caelum: Rafael Kitover <rkitover@cpan.org>
  90
  91 alnewkirk: Al Newkirk <awncorp@cpan.org>
  92
  93 =head1 LICENSE
  94
  95 This program is free software; you can redistribute it and/or modify it
  96 under the same terms as Perl itself.
  97
  98 =cut
  99
 100 use strict;
 101 use warnings;
 102 use Getopt::Long;
 103 use Pod::Usage;
 104 use DBIx::Class::Schema::Loader 'make_schema_at';
 105 use namespace::clean;
 106 use DBIx::Class::Schema::Loader::Base ();
 107 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
 108 require lib;
 109
 110 my $loader_options;
 111
 112 Getopt::Long::Configure('gnu_getopt');
 113
 114 GetOptions(
 115     'I=s'                => sub { shift; lib->import(shift) },
 116     'loader-option|o=s%' => \&handle_option,
 117 );
 118
 119 $loader_options->{dump_directory} ||= '.';
 120
 121 if (@ARGV == 1) {
 122     if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('dbicdump_config')) {
 123         die sprintf "You must install the following CPAN modules to use a config file with dbicdump: %s.\n",
 124             DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('dbicdump_config');
 125     }
 126
 127     my $configuration_file = shift @ARGV;
 128
 129     my $configurations =
 130       Config::Any->load_files( {
 131             use_ext => 1,
 132             flatten_to_hash => 1,
 133             files => [$configuration_file] } );
 134
 135     my $c = (values %$configurations)[0];
 136
 137     unless (keys %{$c->{connect_info}} && $c->{schema_class}) {
 138         pod2usage(1);
 139     }
 140
 141     my @libs;
 142
 143     if ($c->{lib}) {
 144         if (ref $c->{lib}) {
 145             @libs = @{ $c->{lib} };
 146         }
 147
 148         @libs = ($c->{lib});
 149     }
 150
 151     lib->import($_) for @libs;
 152
 153     my ($dsn, $user, $pass, $options) =
 154         map { $c->{connect_info}->{$_} } qw/dsn user pass options/;
 155         $options ||= {};
 156         $c->{loader_options}->{dump_directory} ||=
 157             $loader_options->{dump_directory};
 158
 159     make_schema_at(
 160         $c->{schema_class},
 161         $c->{loader_options} || {},
 162         [ $dsn, $user, $pass, %{$options} ],
 163     );
 164 }
 165 else {
 166     my ($schema_class, @loader_connect_info) = @ARGV
 167         or pod2usage(1);
 168
 169     my $dsn = shift @loader_connect_info;
 170
 171     my ($user, $pass) = $dsn =~ /sqlite/i ? ('', '')
 172         : splice @loader_connect_info, 0, 2;
 173
 174     my @extra_connect_info_opts = map parse_value($_), @loader_connect_info;
 175
 176     make_schema_at(
 177         $schema_class,
 178         $loader_options,
 179         [ $dsn, $user, $pass, @extra_connect_info_opts ],
 180     );
 181 }
 182
 183 exit 0;
 184
 185 sub parse_value {
 186     my $value = shift;
 187
 188     $value = eval $value if $value =~ /^\s*(?:sub\s*\{|q\w?\s*[^\w\s]|[[{])/;
 189
 190     return $value;
 191 }
 192
 193 sub handle_option {
 194     my ($self, $key, $value) = @_;
 195
 196     $key =~ tr/-/_/;
 197     die "Unknown option: $key\n"
 198         unless DBIx::Class::Schema::Loader::Base->can($key);
 199
 200     $value = parse_value $value;
 201
 202     $loader_options->{$key} = $value;
 203 }
 204
 205 1;
 206
 207 __END__