read_product.pl

package MKDML;

use strict;
use warnings;

use Readonly;
use SQL::Abstract;


use Data::Dumper;
use Nimbus::DB;



my $schema = Nimbus::DB->db;
my $dbh    = $schema->storage->dbh;

my $abstract = SQL::Abstract->new;


my @file = qw(UPGRADE ROLLBACK);
my %fh;
for my $file (@file) {
  $fh{$file} = IO::File->new("> $file.sql");
  $fh{$file}->print("\n-- $file\n\n");
}


my %stmt;

$\ = ";\n" ;

Readonly my %param =>
  ( scalar => 'scalar required', hash => 'hashref required' );

sub SAVE {
  for my $stmt (@{$stmt{UPGRADE}}) {
    $fh{UPGRADE}->print($stmt);
  }

  # must delete children before parents
  # assumes inserts were ordered as parent before child
  for my $stmt (reverse @{$stmt{ROLLBACK}}) {
    $fh{ROLLBACK}->print($stmt);
  }

}

sub query_as_string {
  my ($sql, @bind)=@_;

  # [14:50] <ilmari> metaperl: s/\?/$dbh->quote(shift @bind)/ge

  $_ = $sql;

  s/\?/$dbh->quote(shift @bind)/ge ;

  $_;
}


sub SQL {
    my ( $sql, @bind ) = @_;

    my $concrete = query_as_string( $sql, @bind );

    "$concrete";
}

sub MANUAL {
  my ($upgrade, $rollback) = @_;

  push @{$stmt{UPGRADE}}  => $upgrade;
  push @{$stmt{ROLLBACK}} => $rollback;

}


sub DELETE {
    my ( $table, $key ) = @_;

  push @{$stmt{ROLLBACK}}  => SQL( $abstract->delete( $table => $key ) );
}

sub INSERT {
    my ( $table, $key, $val ) = @_;

    push @{$stmt{UPGRADE}} => SQL( $abstract->insert( $table => { %$key, %$val } ) );
}


sub BOTH {
    my ($table, $key, $val) = @_;

    INSERT( $table => $key, $val );
    DELETE( $table => $key );
}


1;

=head1 NAME 

 MKDML - generate DML for bug fixes.

=head1 SYNOPSIS

If we needed to generate this pair of SQL statements:

 # database update
 insert into segment values ('minamisuna_linux_rsj_starter','Tokyo JP4, RSJ Linux Starter','1','','');

 # database rollback
 delete segment where segment='minamisuna_linux_rsj_starter';

We could do this:

 my $key   = { segment => 'minamisuna_linux_rsj_starter' };
 my %val   = ( description => 'Tokyo JP4, RSJ Linux Starter',
               status => 1, pos => undef, ledger_key => undef );
 BOTH( segment => $key, %val );


If we had some manual DML, such as these ALTER TABLE statements, here:

  my @table = qw(PROMO PROMO_ELEMENT PROMO_INSTANCE PROMO_ELEMENT_SEGMENT);
  
  my @size = qw(64 24);
  
  for my $table (@table) {
    my @stmt = map { "ALTER TABLE $table MODIFY (PROMO_ID VARCHAR($_))" } @size ;
  
    MKDML::MANUAL(@stmt);
  }




=head1 DESCRIPTION

mkdml.pl is a script which makes it simpler to generate DML for database upgrades. For small
upgrades, there is no big win. But when you have a lot of INSERT and DELETE statements to
generate, you will result to writing a program to do so and you will need to cover both
upgrade and rollback.

This script handles that.

The INSERT statements go to one file and the DELETE statements to another.

You will need to edit the subroutine main so that you are generating DML for your
tables, keys, and values.

=head2 API

=head3 INSERT ( $table(string), $key(hashref), %val )

Creates a SQL INSERT statement creating a row containing C<%val> as well as C<$key>. 

=head3 DELETE ( $table(string), $key(hashref) )

Creates a SQL DELETE statement to remove a row containing  C<$key>

=head3 BOTH ( $table(string), $key(hashref), %val )

Calls INSERT() and DELETE()

=head1 DEPENDENCIES

SQL::Abstract (we already have it with L<DBIx::Class> and SQL::DB. SQL::DB is available on CPAN
but requires a force install due to a small bug in the build process.

=head1 ACKNOWLEDGEMENTS 

Credits go to L<this discussion|http://perlmonks.org/?node_id=839885>

=head1 NOTES

=head2 Design Decisions

=head3 Detecting the key

A more convenient API would simply have you supply the INSERT hash and it would build the 
DELETE statement by finding the primary keys of the table. A starter implementation of this exists 
in F<exp.pl>. It requires L<DBIx::Class> and so is a much more heavyweight solution.

Besides it wont work when a table lacks primary keys (such as our EAV tables).

=head3 Implying the key

Another approach to expressing the key is to 'tag' the keys with a hint, so instead of

 my $key   = { segment => 'minamisuna_linux_rsj_starter' };
 my %val   = ( description => 'Tokyo JP4, RSJ Linux Starter',
               status => 1, pos => undef, ledger_key => undef );

we would have:

 my %val   = ( '*segment' =>  'minamisuna_linux_rsj_starter' 
               description => 'Tokyo JP4, RSJ Linux Starter',
               status => 1, pos => undef, ledger_key => undef );

And then the program would detect that C<segment> was part of the key by the leading asterisk.

But that would be a case of making C<%val> L<compound data|http://www.perlmonks.org/?node_id=835894>


=head1 ISSUES

=head2 parent-child key relationships

While it makes sense to insert the parent records then the child records, when deleting the
opposite has to be done: you cant delete the parent unless all the children are dead. 

Since this program just naively generates the INSERT and DELETE statements, it does not 
properly re-order the DELETE statements.

Again, if this module made the leap to using DBIC then that sort of introspective goodness
would be available, but for the current module, you are forced to edit F<DELETE.sql>
so that things delete without violating constraints.