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 =head1 DESCRIPTION
  12
  13 Dbicdump generates a L<DBIx::Class> schema using
  14 L<DBIx::Class::Schema::Loader/make_schema_at> and dumps it to disk.
  15
  16 You can pass any L<DBIx::Class::Schema::Loader::Base> constructor option using
  17 C<< -o <option>=<value> >>. For convenience, option names will have C<->
  18 replaced with C<_> and values that look like references or quote-like
  19 operators will be C<eval>-ed before being passed to the constructor.
  20
  21 The C<dump_directory> option defaults to the current directory if not
  22 specified.
  23
  24 =head1 SEE ALSO
  25
  26 L<DBIx::Class::Schema::Loader>, L<DBIx::Class>.
  27
  28 =head1 AUTHOR
  29
  30 Dagfinn Ilmari Mannsåker C<< <ilmari@ilmari.org> >>
  31
  32 =head1 LICENSE
  33
  34 This program is free software; you can redistribute it and/or modify it
  35 under the same terms as Perl itself.
  36
  37 =cut
  38
  39 use strict;
  40 use warnings;
  41 use Getopt::Long;
  42
  43 use Pod::Usage;
  44
  45 use DBIx::Class::Schema::Loader qw/ make_schema_at /;
  46 require DBIx::Class::Schema::Loader::Base;
  47
  48 my $loader_options;
  49
  50 GetOptions( 'loader-option|o=s%' => \&handle_option );
  51 $loader_options->{dump_directory} ||= '.';
  52
  53 my ($schema_class, @loader_connect_info) = @ARGV
  54     or pod2usage(1);
  55
  56 sub handle_option {
  57     my ($self, $key, $value) = @_;
  58
  59     $key =~ tr/-/_/;
  60     die "Unknown option: $key\n"
  61         unless DBIx::Class::Schema::Loader::Base->can($key);
  62
  63     $value = eval $value if $value =~ /^\s*(?:sub\s*\{|q\w?\s*[^\w\s]|[[{])/;
  64
  65     $loader_options->{$key} = $value;
  66 }
  67
  68 make_schema_at(
  69     $schema_class,
  70     $loader_options,
  71     \@loader_connect_info,
  72 );