#!/usr/bin/perl 
#===============================================================================
#
#         FILE:  yaml_to_sql.pl
#
#        USAGE:  ./yaml_to_sql.pl 
#
#  DESCRIPTION:  Converts two-section YAML file into SQL.
#
#      OPTIONS:  
#       --add-drop-table: 
#           add DROP TABLE into start of file (on by default),
#           use --noadd-drop-table to invert.
#                    
#       --insert-fldnames: 
#           use all field names in insert query.
#
#	--[no-]quote-metanames
#           use "`" to quote field and table names.
#
#	--set-names=<charset>
#	    put 'SET NAMES <charset>' in the beginning of the file.
#
# REQUIREMENTS:  Getopt::Long, YAML, Tie::IxHash
#         BUGS:  ---
#        NOTES:  ---
#      AUTHORS:  Pavel Boldin (davinchi), <boldin.pavel@gmail.com>
#                Walery Studennikov (despair), <despair@cpan.org>
#      COMPANY:  
#      VERSION:  1.0
#      CREATED:  26.11.2007 18:10:14 SAMT
#     REVISION:  ---
#===============================================================================

use strict;
use warnings;

use Data::Dumper;
use Getopt::Long;
use YAML;
use Tie::IxHash;

our ($drop_if_exists, $insert_fldnames, $quote_metanames, $set_names) = (1, 0, 1);

GetOptions(
    'add-drop-table!'	=> \$drop_if_exists,
    'insert-fldnames|i'=> \$insert_fldnames,
    'quote-metanames!'	=> \$quote_metanames,
    'set-names=s'	=> \$set_names,
) or die "Can't parse args";

my $NS = $quote_metanames ? '`' : '';

our $fname = shift @ARGV or die_help('Cant find filename');
our $outfile = shift @ARGV;

die "Output file $outfile already exists" if (defined $outfile && -f $outfile);

if (defined $outfile) {
    open my $output, '>', $outfile 
        or die "Cannot open $outfile for writing: $!";
    select($output);
}

our ($meta, $data) = YAML::LoadFile($fname) or die "Cant parse YAML file: $fname";

if ($set_names) {
    print "SET NAMES $set_names;\n\n";
}

print_create_table($meta);

print "\n";

print_table_data($meta, $data);

if (defined $outfile) {
    close(select(STDOUT));
}

###########################################################################
#  Functions section
###########################################################################

sub die_help {
    print shift, "\n";
    
    print <<EOF;
Usage: $0 filename.yaml

Converts YAML into SQL.

YAML file should consist of two parts:
1st with Table meta data
2nd with array of table rows
Each row can be either an array (then order of fields matches table columns)
or an hash (then hash key is an field name)
EOF

    exit(shift || 0);
}

sub print_create_table {
    my $meta = shift;

    my $tname = $meta->{tablename} or die "No table name in $fname YAML";

    ref ($meta->{fields}) eq 'ARRAY' or die "No fields in $fname YAML";

    unless (
	$meta->{meta} &&
	ref $meta->{meta} &&
	ref $meta->{meta} eq 'ARRAY' &&
	scalar(@{$meta->{meta}})
    ) {
	delete $meta->{meta};
    }

    print 'DROP TABLE IF EXISTS '.$NS.$tname.$NS.";\n" if $drop_if_exists;
    print 'CREATE TABLE '.$NS.$tname.$NS.' ('."\n";

    if(ref $meta->{primary_key_fields} eq 'ARRAY') {
        my $primary_keys = join ', ', @{$meta->{primary_key_fields}};
        print "\tPRIMARY KEY($primary_keys), \n";
    }
    my @fields;

    foreach my $field (@{$meta->{fields}}) {
        die "Field entry is not an hash!" unless ref $field eq 'HASH';

        my ($field_name, $junk) = keys %$field;
        my ($field_value) = values %$field;
        die "Field entry has junk keys!" if $junk;

        push @fields, "\t$NS$field_name$NS $field_value";
    }

    my $fields_descr = join '', map { "$_,\n" } @fields;

    unless ($meta->{meta}) {
	$fields_descr =~ s/,\n$/\n/s;
    }

    $fields_descr =~ s/(\s+(?:\#|--).+?),\n/,$1\n/gs;

    print $fields_descr;

    if ($meta->{meta}) {
        my $m = do {
            ref ($meta->{meta}) ?
            $meta->{meta} :
            [ $meta->{meta} ];
        };

        print "\t", join (",\n\t", @{$m}), "\n";
    }

    print ")";

    print " " . $meta->{extra} if $meta->{extra};

    print ";\n";
}

sub _make_insert_line {
    my ($tname, $data) = @_;

    my $output = 'INSERT INTO '.$NS.$tname.$NS.' ';

    $output .= '( '. join (', ', map { "$NS$_$NS" } keys %$data). ' ) '
	if $insert_fldnames && ref $data eq 'HASH';

    $output .= 'VALUES (';

    my $tmp;
    $output .= join (', ',
        map {
    	    return 'NULL' unless defined $_;
    	    ($tmp = $_) =~ s/'/\\'/g;
    	    $tmp =~ /^[\d\.]+$/ ? $tmp : "'$tmp'";
        } (ref($data) eq 'ARRAY' ? @$data : values %$data)
    );

    $output .= ');'."\n";

    return $output;
}

sub print_table_data {
    my ($meta, $data) = @_;

    die "Data is not array ref!" unless ref $data eq 'ARRAY';

    my $tname = $meta->{tablename};
    my $fields = scalar @{$meta->{fields}};

    my @fnames = map { keys %$_ } @{$meta->{fields}};

    foreach my $row (@$data) {
        if (ref($row) eq 'ARRAY') {
            print _make_insert_line($tname, $row);
        } elsif (ref($row) eq 'HASH') {

            my %fields = map { $_ => 1 } @fnames;

            $fields{$_}-- foreach keys %$row;

            if (index( join (',', values %fields),  '-1' ) >= 0) {
                die <<EOF;
Error in fields: no such field in table 
@{[ grep { $fields{$_} == '-1' } keys %$row ]}
EOF
            }

            tie my %sorted_row, 'Tie::IxHash';

            # sort keys within that row...
            %sorted_row = ( 
                map { exists $row->{$_} ? ($_ => $row->{$_}) : () } @fnames 
            );

            print _make_insert_line( $tname, \%sorted_row);
        } else {
            die "Error: $row is not array or hash";
        }
    }
}

=head1 NAME

YAML to SQL

=head1 DESCRIPT

Converts .yml files containing two entries: hash with table info and 
array with table data into appropriate .sql file.

=head1 README

If you want to convert your converted to .yaml files after editing by hand -- use this scripts! (with pair in sql_to_yaml.pl)

=head1 PREREQUISITES

This script requires the C<strict>, C<Tie::IxHash>, C<YAML> and C<Getopt::Long> modules.

=pod OSNAMES 

any

=pod SCRIPT CATEGORIES

DB

=cut