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::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 use DBIx::Class::Schema::Loader qw/ make_schema_at /;
  43 require DBIx::Class::Schema::Loader::Base;
  44
  45 my $loader_options;
  46
  47 GetOptions( 'loader-option|o=s%' => \&handle_option );
  48 $loader_options->{dump_directory} ||= '.';
  49
  50 my ($schema_class, @loader_connect_info) = @ARGV;
  51
  52 sub handle_option {
  53     my ($self, $key, $value) = @_;
  54
  55     $key =~ tr/-/_/;
  56     die "Unknown option: $key\n"
  57         unless DBIx::Class::Schema::Loader::Base->can($key);
  58
  59     $value = eval $value if $value =~ /^\s*(?:sub\s*\{|q\w?\s*[^\w\s]|[[{])/;
  60
  61     $loader_options->{$key} = $value;
  62 }
  63
  64 make_schema_at(
  65     $schema_class,
  66     $loader_options,
  67     \@loader_connect_info,
  68 );