The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Test::Fixture::DBI::Util;

use strict;
use warnings;
use Exporter qw(import);

use Carp;
use DBI;
use YAML::Syck;
use UNIVERSAL::require;

our $VERSION = '0.01';
our @EXPORT  = qw(make_database_yaml make_fixture_yaml);

sub make_database_yaml {
    my ( $dbh, $filename ) = @_;
    my $driver       = $dbh->{Driver}{Name};
    my $driver_class = __PACKAGE__ . '::' . $driver;
    unless ( eval { $driver_class->require; 1 } ) {
        croak( sprintf( 'Driver %s is not supported yet', $driver ) );
    }
    my $data = $driver_class->make_database($dbh);
    if ($filename) {
        YAML::Syck::DumpFile( $filename, $data );
    }
    else {
        return $data;
    }
}

sub make_fixture_yaml {
    my ( $dbh, $schema, $name_column, $sql, $filename ) = @_;
    my $rows = $dbh->selectall_arrayref( $sql, +{ Slice => +{} } );

    my @data;
    for my $row (@$rows) {
        push(
            @data,
            +{
                name => ref $name_column
                ? join( '_', map { $row->{$_} } @$name_column )
                : $row->{$name_column},
                schema => $schema,
                data   => $row,
            }
        );
    }

    if ($filename) {
        YAML::Syck::DumpFile( $filename, \@data );
    }
    else {
        return \@data;
    }
}

1;

__END__

=head1 NAME

Test::Fixuture::DBI::Util - Make schema and fixture from exists database.

=head1 SYNOPSIS

  use Test::Fixuture::DBI::Util;

=head1 DESCRIPTION

This module is used by L<make_database_yaml.pl> and L<make_fixture_yaml.pl>

=head1 FUNCTIONS

=head2 make_database_yaml($dbh, $filename)

=head2 make_fixture_yaml($dbh, $schema, $name_column, $sql, $filename)

=head1 AUTHOR

Toru Yamaguchi E<lt>zigorou@cpan.org<gt>

=head1 LICENSE

This module is licensed under the same terms as Perl itself.

=head1 SEE ALSO

=cut

# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# coding: utf-8-unix
# End:
#
# vim: expandtab shiftwidth=4: