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