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