Upped version numbers, cleaned up code, fixed my name.

[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / SQLite.pm

diff --git a/lib/SQL/Translator/Producer/SQLite.pm b/lib/SQL/Translator/Producer/SQLite.pm
index ade2ee3..d03112c 100644 (file)
--- a/lib/SQL/Translator/Producer/SQLite.pm
+++ b/lib/SQL/Translator/Producer/SQLite.pm
@@ -1,8 +1,6 @@
 package SQL::Translator::Producer::SQLite;
 
 # -------------------------------------------------------------------
-# $Id: SQLite.pm 1445 2009-02-07 17:50:03Z ashberlin $
-# -------------------------------------------------------------------
 # Copyright (C) 2002-2009 SQLFairy Authors
 #
 # This program is free software; you can redistribute it and/or
@@ -42,17 +40,16 @@ use warnings;
 use Data::Dumper;
 use SQL::Translator::Schema::Constants;
 use SQL::Translator::Utils qw(debug header_comment);
+use Readonly;
 
 use vars qw[ $VERSION $DEBUG $WARN ];
 
-$VERSION = '1.99';
-$DEBUG = 0 unless defined $DEBUG;
-$WARN = 0 unless defined $WARN;
+$VERSION = '1.60';
+$DEBUG   = 0 if !defined $DEBUG;
+$WARN    = 0 if !defined $WARN;
 
-our %used_identifiers = ();
-our $max_id_length    = 30;
-our %global_names;
-our %truncated;
+Readonly my $MAX_ID_LENGTH => 30;
+my %global_names;
 
 sub produce {
     my $translator     = shift;
@@ -67,6 +64,8 @@ sub produce {
 
     debug("PKG: Beginning production\n");
 
+    %global_names = ();   #reset
+
     my @create = ();
     push @create, header_comment unless ($no_comments);
     $create[0] .= "\n\nBEGIN TRANSACTION" unless $no_txn;
@@ -102,31 +101,14 @@ sub produce {
 
 # -------------------------------------------------------------------
 sub mk_name {
-    my ($basename, $type, $scope, $critical) = @_;
-    my $basename_orig = $basename;
-    my $max_name      = !$max_id_length 
-                      ? length($type) + 1
-                      : $type 
-                      ? $max_id_length - (length($type) + 1) 
-                      : $max_id_length;
-    $basename         = substr( $basename, 0, $max_name ) 
-                        if length( $basename ) > $max_name;
-    $basename         =~ s/\./_/g;
-    my $name          = $type ? "${type}_$basename" : $basename;
-
-    if ( $basename ne $basename_orig and $critical ) {
-        my $show_type = $type ? "+'$type'" : "";
-        warn "Truncating '$basename_orig'$show_type to $max_id_length ",
-            "character limit to make '$name'\n" if $WARN;
-        $truncated{ $basename_orig } = $name;
-    }
+    my ($name, $scope, $critical) = @_;
 
     $scope ||= \%global_names;
     if ( my $prev = $scope->{ $name } ) {
         my $name_orig = $name;
         $name        .= sprintf( "%02d", ++$prev );
-        substr($name, $max_id_length - 3) = "00" 
-            if length( $name ) > $max_id_length;
+        substr($name, $MAX_ID_LENGTH - 3) = "00" 
+            if length( $name ) > $MAX_ID_LENGTH;
 
         warn "The name '$name_orig' has been changed to ",
              "'$name' to make it unique.\n" if $WARN;
@@ -331,7 +313,7 @@ sub create_index
     my ($index, $options) = @_;
 
     my $name   = $index->name;
-    $name      = mk_name($index->table->name, $name);
+    $name      = mk_name($name);
 
     my $type   = $index->type eq 'UNIQUE' ? "UNIQUE " : ''; 
 
@@ -351,7 +333,7 @@ sub create_constraint
     my ($c, $options) = @_;
 
     my $name   = $c->name;
-    $name      = mk_name($c->table->name, $name);
+    $name      = mk_name($name);
     my @fields = $c->fields;
     (my $index_table_name = $c->table->name) =~ s/^.+?\.//; # table name may not specify schema
     warn "removing schema name from '" . $c->table->name . "' to make '$index_table_name'\n" if $WARN;
@@ -367,43 +349,53 @@ sub create_trigger {
   my ($trigger, $options) = @_;
   my $add_drop = $options->{add_drop_trigger};
 
-  my $name = $trigger->name;
-  my @create;
-
-  push @create,  "DROP TRIGGER IF EXISTS $name" if $add_drop;
+  my @statements;
 
+  my $trigger_name = $trigger->name;
   my $events = $trigger->database_events;
-  die "Can't handle multiple events in triggers" if @$events > 1;
+  for my $evt ( @$events ) {
 
-  my $action = "";
+    my $trig_name = $trigger_name;
+    if (@$events > 1) {
+      $trig_name .= "_$evt";
 
-  $DB::single = 1;
-  unless (ref $trigger->action) {
-    $action .= "BEGIN " . $trigger->action . " END";
-  } else {
-    $action = $trigger->action->{for_each} . " "
-      if $trigger->action->{for_each};
+      warn "Multiple database events supplied for trigger '$trigger_name', ",
+        "creating trigger '$trig_name' for the '$evt' event.\n" if $WARN;
+    }
 
-    $action = $trigger->action->{when} . " "
-      if $trigger->action->{when};
+    push @statements,  "DROP TRIGGER IF EXISTS $trig_name" if $add_drop;
 
-    my $steps = $trigger->action->{steps} || [];
 
-    $action .= "BEGIN ";
-    for (@$steps) {
-      $action .= $_ . "; "
+    $DB::single = 1;
+    my $action = "";
+    if (not ref $trigger->action) {
+      $action .= "BEGIN " . $trigger->action . " END";
     }
-    $action .= "END";
-  }
+    else {
+      $action = $trigger->action->{for_each} . " "
+        if $trigger->action->{for_each};
 
-  push @create, "CREATE TRIGGER $name " .
-                $trigger->perform_action_when . " " .
-                $events->[0] .
-                " on " . $trigger->on_table . " " .
-                $action;
+      $action = $trigger->action->{when} . " "
+        if $trigger->action->{when};
+
+      my $steps = $trigger->action->{steps} || [];
+
+      $action .= "BEGIN ";
+      $action .= $_ . "; " for (@$steps);
+      $action .= "END";
+    }
+
+    push @statements, sprintf (
+      'CREATE TRIGGER %s %s %s on %s %s',
+      $trig_name,
+      $trigger->perform_action_when,
+      $evt,
+      $trigger->on_table,
+      $action
+    );
+  }
 
-  return @create;
-            
+  return @statements;
 }
 
 sub alter_table { } # Noop
@@ -534,7 +526,7 @@ SQL::Translator, http://www.sqlite.org/.
 
 =head1 AUTHOR
 
-Ken Y. Clark C<< <kclark@cpan.orgE> >>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 
 Diff code added by Ash Berlin C<< <ash@cpan.org> >>.