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 [-o <loader_option>=<value> ] <schema_class> <connect_info>
  10
  11 Examples:
  12
  13   $ dbicdump -o dump_directory=./lib \
  14     -o components='["InflateColumn::DateTime"]' \
  15     MyApp::Schema dbi:SQLite:./foo.db '{ quote_char => "\"" }'
  16
  17   $ dbicdump -o dump_directory=./lib \
  18     -o components='["InflateColumn::DateTime"]' \
  19     -o preserve_case=1 \
  20     MyApp::Schema dbi:mysql:database=foo user pass '{ quote_char => "`" }'
  21
  22 On Windows that would be:
  23
  24   $ dbicdump -o dump_directory=.\lib ^
  25     -o components="[q{InflateColumn::DateTime}]" ^
  26     -o preserve_case=1 ^
  27     MyApp::Schema dbi:mysql:database=foo user pass "{ quote_char => q{`} }"
  28
  29 =head1 DESCRIPTION
  30
  31 Dbicdump generates a L<DBIx::Class> schema using
  32 L<DBIx::Class::Schema::Loader/make_schema_at> and dumps it to disk.
  33
  34 You can pass any L<DBIx::Class::Schema::Loader::Base> constructor option using
  35 C<< -o <option>=<value> >>. For convenience, option names will have C<->
  36 replaced with C<_> and values that look like references or quote-like
  37 operators will be C<eval>-ed before being passed to the constructor.
  38
  39 The C<dump_directory> option defaults to the current directory if not
  40 specified.
  41
  42 =head1 SEE ALSO
  43
  44 L<DBIx::Class::Schema::Loader>, L<DBIx::Class>.
  45
  46 =head1 AUTHOR
  47
  48 Dagfinn Ilmari Mannsåker C<< <ilmari@ilmari.org> >>
  49
  50 =head1 CONTRIBUTORS
  51
  52 Caelum: Rafael Kitover <rkitover@cpan.org>
  53
  54 =head1 LICENSE
  55
  56 This program is free software; you can redistribute it and/or modify it
  57 under the same terms as Perl itself.
  58
  59 =cut
  60
  61 use strict;
  62 use warnings;
  63 use Getopt::Long;
  64
  65 use Pod::Usage;
  66
  67 use DBIx::Class::Schema::Loader qw/ make_schema_at /;
  68 require DBIx::Class::Schema::Loader::Base;
  69
  70 my $loader_options;
  71
  72 GetOptions( 'loader-option|o=s%' => \&handle_option );
  73 $loader_options->{dump_directory} ||= '.';
  74
  75 my ($schema_class, @loader_connect_info) = @ARGV
  76     or pod2usage(1);
  77
  78 my $dsn = shift @loader_connect_info;
  79
  80 my ($user, $pass) = $dsn =~ /sqlite/i ? ('', '')
  81     : splice @loader_connect_info, 0, 2;
  82
  83 my @extra_connect_info_opts = map parse_value($_), @loader_connect_info;
  84
  85 make_schema_at(
  86     $schema_class,
  87     $loader_options,
  88     [ $dsn, $user, $pass, @extra_connect_info_opts ],
  89 );
  90
  91 exit 0;
  92
  93 sub parse_value {
  94     my $value = shift;
  95
  96     $value = eval $value if $value =~ /^\s*(?:sub\s*\{|q\w?\s*[^\w\s]|[[{])/;
  97
  98     return $value;
  99 }
 100
 101 sub handle_option {
 102     my ($self, $key, $value) = @_;
 103
 104     $key =~ tr/-/_/;
 105     die "Unknown option: $key\n"
 106         unless DBIx::Class::Schema::Loader::Base->can($key);
 107
 108     $value = parse_value $value;
 109
 110     $loader_options->{$key} = $value;
 111 }
 112
 113 1;
 114
 115 __END__