Parse::Dia::SQL::Output::SQLite3 - Create SQL for SQLite version 3.

Parse-Dia-SQL documentation Contained in the Parse-Dia-SQL distribution.

Index

Code Index:

NAME

Top

Parse::Dia::SQL::Output::SQLite3 - Create SQL for SQLite version 3.

SYNOPSIS

Top

    use Parse::Dia::SQL;
    my $dia = Parse::Dia::SQL->new(file => 'foo.dia', db => 'sqlite3');
    print $dia->get_sql();

DESCRIPTION

Top

This sub-class creates SQL for the SQLite database version 3.

new

The constructor.

Object names in SQLite have no inherent limit. 60 has been arbitrarily chosen.

_get_create_table_sql

Generate create table statement for a single table using SQLite syntax:

Includes class comments before the table definition.

Includes autoupdate triggers based on the class comment.

autoupdate triggers

If the class comment includes a line like:

<autoupdate:foo/>

Then an 'after update' trigger is generated for this table which executes the statement foo for the updated row.

Examples of use include tracking record modification dates (<autoupdate:dtModified=datetime('now')/>) or deriving a value from another field (<autoupdate:sSoundex=soundex(sName)/>)

get_schema_drop

Generate drop table statments for all tables using SQLite syntax:

  drop table {foo} if exists

get_view_drop

Generate drop view statments for all tables using SQLite syntax:

  drop view {foo} if exists

_get_fk_drop

Drop foreign key enforcement triggers using SQLite syntax:

  drop trigger {foo} if exists

The automatically generated foreign key enforcement triggers are:

See "_get_create_association_sql" for more details.

constraint_name_bi_tr
constraint_name_bu_tr
constraint_name_buparent_tr
constraint_name_bdparent_tr

_get_drop_index_sql

drop index statement using SQLite syntax:

  drop index {foo} if exists

get_permissions_create

SQLite doesn't support permissions, so supress this output.

get_permissions_drop

SQLite doesn't support permissions, so supress this output.

_get_create_association_sql

Create the foreign key enforcement triggers using SQLite syntax:

  create trigger {fkname}[_bi_tr|_bu_tr|_bdparent_tr|_buparent_tr]

Because SQLite doesn't natively enforce foreign key constraints (see http://www.sqlite.org/omitted.html), we use triggers to emulate this behaviour.

The trigger names are the default contraint name (something like child_table_fk_child_fkcolumn) with suffixes described below.

{constraint_name} is the name of the association, either specified or generated.
{child_table} is the name of the dependent or child table.
{child_fkcolumn} is the field in the dependent table that hold the foreign key.
{parent_table} is the name of the parent table.
{parent_key} is the key field of the parent table.

Before insert - Dependent Table

constraint_name_bi_tr

Before insert on the child table require that the parent key exists.

  create trigger {constraint_name}_bi_tr before insert on {child_table}
    for each row 
      begin 
        select 
          raise(abort, 'insert on table {child_table} violates foreign key constraint {constraint_name}')
          where new.{child_fkcolumn} is not null and (select {parent_key} from {parent_table} where {parent_key}=new.{child_fkcolumn}) is null;
      end;

Before update - Dependent Table

constraint_name_bu_tr

Before update on the child table require that the parent key exists.

  create trigger {constraint_name}_bu_tr before update on {table_name} 
    for each row 
      begin 
        select raise(abort, 'update on table {child_table} violates foreign key constraint {constraint_name}') 
        where new.{child_fkcolumn} is not null and (select {parent_key} from {parent_table} where {parent_key}=new.{child_fkcolumn}) is null;
      end;

Before update - Parent Table

constraint_name_buparent_tr

Before update on the primary key of the parent table ensure that there are no dependent child records. Note that cascading updates don't work.

  create trigger {constraint_name}_buparent_tr before update on {parent_table}
    for each row when new.{parent_key} <> old.{parent_key}
      begin 
        select raise(abort, 'update on table {parent_table} violates foreign key constraint {constraint_name} on {child_table}') 
        where (select {child_fkcolumn} from {child_table} where {child_fkcolumn}=old.{parent_key}) is not null;
      end;

Before delete - Parent Table

constraint_name_bdparent_tr

The default behaviour can be modified through the contraint (in the multiplicity field) of the association.

Default (On Delete Restrict)

Before delete on the parent table ensure that there are no dependent child records.

  create trigger {constraint_name}_bdparent_tr before delete on {parent_table}
    for each row 
      begin 
        select raise(abort, 'delete on table {parent_table} violates foreign key constraint {constraint_name} on {child_table}') 
        where (select {child_fkcolumn} from {child_table} where {child_fkcolumn}=old.{parent_key}) is not null;
      end;

On Delete Cascade

Before delete on the parent table delete all dependent child records.

  create trigger {constraint_name}_bdparent_tr before delete on {parent_table} 
    for each row 
      begin 
        delete from {child_table} where {child_table}.{child_fkcolumn}=old.{parent_key};
      end;

On Delete Set Null

Before delete on the parent table set the foreign key field(s) in all dependent child records to NULL.

  create trigger {constraint_name}_bdparent_tr before delete on {parent_table} 
    for each row 
      begin 
        update {child_table} set {child_table}.{child_fkcolumn}=null where {child_table}.{child_fkcolumn}=old.{parent_key};
      end;

TODO

Top

Things that might get added in future versions:

Mandatory constraints

The current foreign key triggers allow NULL in the child table. This might use a keyword in the multiplicity field (perhaps 'required') or could check the 'not null' state of the child fkcolumn.

Views

Views haven't been tested. They might already work, but who knows...

Other stuff

Bugs etc

Parse-Dia-SQL documentation Contained in the Parse-Dia-SQL distribution. 
package Parse::Dia::SQL::Output::SQLite3;

# $Id: SQLite3.pm,v 1.5 2009/05/14 09:42:47 aff Exp $


use warnings;
use strict;

use Data::Dumper;
use File::Spec::Functions qw(catfile);

use lib q{lib};
use base q{Parse::Dia::SQL::Output};    # extends

require Parse::Dia::SQL::Logger;
require Parse::Dia::SQL::Const;


sub new {
  my ( $class, %param ) = @_;
  my $self = {};

  # Set defaults for sqlite
  $param{db} = q{sqlite3};
  $param{object_name_max_length} = $param{object_name_max_length} || 60;

  $self = $class->SUPER::new( %param );
  bless( $self, $class );

  return $self;
}


sub _get_create_table_sql {

  my ( $self, $table ) = @_;
  my $sqlstr = '';
  my $temp;
  my $comment;
  my $tablename;
  my $trigger = '';
  my $update;
  my $primary_keys = '';

  # include the comments before the table creation
  $comment = $table->{comment};
  if ( !defined( $comment ) ) { $comment = ''; }
  $tablename = $table->{name};
  $sqlstr .= $self->{newline};
  if ( $comment ne "" ) {
    $temp = "-- $comment";
    $temp =~ s/\n/\n-- /g;
    $temp =~ s/^-- <autoupdate(\s*)(.*):(.*)\/>$//mgi;
    if ( $temp ne "" ) {
      if ( $temp !~ /\n$/m ) { $temp .= $self->{newline}; }
      $sqlstr .= $temp;
    }
  }

  # Call the base class to generate the main create table statements
  $sqlstr .= $self->SUPER::_get_create_table_sql( $table );

  # Generate update triggers if required
  if ( $comment =~ /<autoupdate(\s*)(.*):(.*)\/>/mi ) {
    $update  = $3;    # what we will set it to
    $trigger = $2;    # the trigger suffix to use (optional)
    $trigger = $tablename . "_autoupdate" . $trigger;

    # Check that the column exists
    foreach $temp ( @{ $table->{attList} } ) {

      # build the two primary key elements
      if ( $$temp[3] == 2 ) {
        if ( $primary_keys ) { $primary_keys .= " and "; }
        $primary_keys .= $$temp[0] . "=OLD." . $$temp[0];
      }
    }

    $sqlstr .=
        "drop trigger if exists $trigger"
      . $self->{end_of_statement}
      . $self->{newline};

    $sqlstr .=
"create trigger $trigger after update on $tablename begin update $tablename set $update where $primary_keys;end"
      . $self->{end_of_statement}
      . $self->{newline};

    $sqlstr .= $self->{newline};
  }

  return $sqlstr;
}


sub get_schema_drop {
  my $self   = shift;
  my $sqlstr = '';

  return unless $self->_check_classes();

CLASS:
  foreach my $object ( @{ $self->{classes} } ) {
    next CLASS if ( $object->{type} ne q{table} );

    # Sanity checks on internal state
    if (!defined( $object )
      || ref( $object ) ne q{HASH}
      || !exists( $object->{name} ) )
    {
      $self->{log}
        ->error( q{Error in table input - cannot create drop table sql!} );
      next;
    }

    $sqlstr .=
        qq{drop table if exists }
      . $object->{name}
      . $self->{end_of_statement}
      . $self->{newline};
  }

  return $sqlstr;
}


# Create drop view for all views
sub get_view_drop {
  my $self   = shift;
  my $sqlstr = '';

  return unless $self->_check_classes();

CLASS:
  foreach my $object ( @{ $self->{classes} } ) {
    next CLASS if ( $object->{type} ne q{view} );

    # Sanity checks on internal state
    if (!defined( $object )
      || ref( $object ) ne q{HASH}
      || !exists( $object->{name} ) )
    {
      $self->{log}
        ->error( q{Error in table input - cannot create drop table sql!} );
      next;
    }

    $sqlstr .=
        qq{drop view if exists }
      . $object->{name}
      . $self->{end_of_statement}
      . $self->{newline};
  }

  return $sqlstr;

}


# Drop all foreign keys
sub _get_fk_drop {
  my $self   = shift;
  my $sqlstr = '';
  my $temp;

  return unless $self->_check_associations();

  # drop fk
  foreach my $association ( @{ $self->{associations} } ) {
    my ( $table_name, $constraint_name, undef, undef, undef, undef ) =
      @{$association};

    $temp = $constraint_name . "_bi_tr";
    $sqlstr .=
        qq{drop trigger if exists $temp}
      . $self->{end_of_statement}
      . $self->{newline};

    $temp = $constraint_name . "_bu_tr";
    $sqlstr .=
        qq{drop trigger if exists $temp}
      . $self->{end_of_statement}
      . $self->{newline};

    $temp = $constraint_name . "_buparent_tr";
    $sqlstr .=
        qq{drop trigger if exists $temp}
      . $self->{end_of_statement}
      . $self->{newline};

    $temp = $constraint_name . "_bdparent_tr";
    $sqlstr .=
        qq{drop trigger if exists $temp}
      . $self->{end_of_statement}
      . $self->{newline};

    $sqlstr .= $self->{newline};

  }
  return $sqlstr;
}


sub _get_drop_index_sql {
  my ( $self, $tablename, $indexname ) = @_;
  return
      qq{drop index if exists $indexname}
    . $self->{end_of_statement}
    . $self->{newline};
}


sub get_permissions_create {
  return '';
}


sub get_permissions_drop {
  return '';
}


# Create sql for given association.
sub _get_create_association_sql {
  my ( $self, $association ) = @_;
  my $sqlstr = '';
  my $temp;

  # Sanity checks on input
  if ( ref( $association ) ne 'ARRAY' ) {
    $self->{log}
      ->error( q{Error in association input - cannot create association sql!} );
    return;
  }

  # FK constraints are implemented as triggers in SQLite

  my (
    $table_name, $constraint_name, $key_column,
    $ref_table,  $ref_column,      $constraint_action
  ) = @{$association};

  # Shorten constraint name, if necessary (DB2 only)
  $constraint_name = $self->_create_constraint_name( $constraint_name );

  $temp = $constraint_name . "_bi_tr";
  $sqlstr .=
qq{create trigger $temp before insert on $table_name for each row begin select raise(abort, 'insert on table $table_name violates foreign key constraint $constraint_name') where new.$key_column is not null and (select $ref_column from $ref_table where $ref_column=new.$key_column) is null;end}
    . $self->{end_of_statement}
    . $self->{newline};

  $temp = $constraint_name . "_bu_tr";
  $sqlstr .=
qq{create trigger $temp before update on $table_name for each row begin select raise(abort, 'update on table $table_name violates foreign key constraint $constraint_name') where new.$key_column is not null and (select $ref_column from $ref_table where $ref_column=new.$key_column) is null;end}
    . $self->{end_of_statement}
    . $self->{newline};

  # note that the before delete triggers are on the parent ($ref_table)
  $temp = $constraint_name . "_bdparent_tr";
  if ( $constraint_action =~ /on delete cascade/i ) {
    $sqlstr .=
qq{create trigger $temp before delete on $ref_table for each row begin delete from $table_name where $table_name.$key_column=old.$ref_column;end}
      . $self->{end_of_statement}
      . $self->{newline};
  } elsif ( $constraint_action =~ /on delete set null/i ) {
    $sqlstr .=
qq{create trigger $temp before delete on $ref_table for each row begin update $table_name set $key_column=null where $table_name.$key_column=old.$ref_column;end}
      . $self->{end_of_statement}
      . $self->{newline};
  } else    # default on delete restrict
  {
    $sqlstr .=
qq{create trigger $temp before delete on $ref_table for each row begin select raise(abort, 'delete on table $ref_table violates foreign key constraint $constraint_name on $table_name') where (select $key_column from $table_name where $key_column=old.$ref_column) is not null;end}
      . $self->{end_of_statement}
      . $self->{newline};
  }

  # Cascade updates doesn't work, so we always restrict
  $temp = $constraint_name . "_buparent_tr";
  $sqlstr .=
qq{create trigger $temp before update on $ref_table for each row when new.$ref_column <> old.$ref_column begin select raise(abort, 'update on table $ref_table violates foreign key constraint $constraint_name on $table_name') where (select $key_column from $table_name where $key_column=old.$ref_column) is not null;end}
    . $self->{end_of_statement}
    . $self->{newline};

  $sqlstr .= $self->{newline};

  return $sqlstr;
}

1;


__END__