Merge 'trunk' into 'roundtrip'
Peter Rabbitson [Sun, 3 May 2009 02:25:45 +0000 (02:25 +0000)]
r1520@Thesaurus (orig r1519):  ribasushi | 2009-05-03 03:20:27 +0200
Teah xml parser about database_events
r1521@Thesaurus (orig r1520):  ribasushi | 2009-05-03 03:27:29 +0200
Extra data and first test for xml database_event support
r1522@Thesaurus (orig r1521):  ribasushi | 2009-05-03 03:45:10 +0200
Improve xml database_event deprecation warning
Only issue warning if show_warnings was set on translator
Fix tests to suppress warn noise
r1523@Thesaurus (orig r1522):  ribasushi | 2009-05-03 04:18:28 +0200
Teach sqlite how to deal with multi-event triggers
r1524@Thesaurus (orig r1523):  ribasushi | 2009-05-03 04:19:09 +0200
Adjust xml-db2 tests
r1525@Thesaurus (orig r1524):  ribasushi | 2009-05-03 04:22:55 +0200
Add Carp::Clan to dependencies

Build.PL
lib/SQL/Translator/Parser/XML/SQLFairy.pm
lib/SQL/Translator/Producer/SQLite.pm
t/16xml-parser.t
t/18ttschema-producer.t
t/34tt-base.t
t/43xml-to-db2.t
t/44-xml-to-db2-array.t
t/46xml-to-pg.t
t/48xml-to-sqlite.t
t/data/xml/schema.xml

index 9eee0c0..15e7ebb 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -22,6 +22,7 @@ my $builder = Module::Build->new(
     'Class::Data::Inheritable' => 0.02,
     'Class::MakeMethods'       => 0,
     'Digest::SHA1'             => 2.00,
+    'Carp::Clan',              => 0,
     'IO::Dir'                  => 0,
     'Parse::RecDescent'        => 1.95,
     'Pod::Usage'               => 0,
index 78d7f15..3e2d68a 100644 (file)
@@ -102,6 +102,7 @@ $VERSION = '1.59';
 $DEBUG   = 0 unless defined $DEBUG;
 
 use Data::Dumper;
+use Carp::Clan qw/^SQL::Translator/;
 use Exporter;
 use base qw(Exporter);
 @EXPORT_OK = qw(parse);
@@ -232,9 +233,24 @@ sub parse {
     );
     foreach (@nodes) {
         my %data = get_tagfields($xp, $_, "sqlf:", qw/
-            name perform_action_when database_event fields on_table action order
+            name perform_action_when database_event database_events fields on_table action order
             extra
         /);
+
+        # back compat
+        if (my $evt = $data{database_event} and $translator->{show_warnings}) {
+          carp 'The database_event tag is deprecated - please use database_events (which can take one or more comma separated event names)';
+          $data{database_events} = join (', ',
+            $data{database_events} || (),
+            $evt,
+          );
+        }
+
+        # split into arrayref
+        if (my $evts = $data{database_events}) {
+          $data{database_events} = [split (/\s*,\s*/, $evts) ];
+        }
+
         $schema->add_trigger( %data ) or die $schema->error;
     }
 
index 567db85..64f0bfb 100644 (file)
@@ -365,43 +365,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};
+
+      $action = $trigger->action->{when} . " "
+        if $trigger->action->{when};
 
-  push @create, "CREATE TRIGGER $name " .
-                $trigger->perform_action_when . " " .
-                $events->[0] .
-                " on " . $trigger->on_table . " " .
-                $action;
+      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
index 275ed7f..c962846 100644 (file)
@@ -27,7 +27,7 @@ use constant DEBUG => (exists $opt{d} ? 1 : 0);
 #=============================================================================
 
 BEGIN {
-    maybe_plan(204, 'SQL::Translator::Parser::XML::SQLFairy');
+    maybe_plan(212, 'SQL::Translator::Parser::XML::SQLFairy');
 }
 
 my $testschema = "$Bin/data/xml/schema.xml";
@@ -39,12 +39,21 @@ $sqlt = SQL::Translator->new(
     add_drop_table => 1,
 );
 die "Can't find test schema $testschema" unless -e $testschema;
-my $sql = $sqlt->translate(
+
+my $sql;
+{
+  my @w;
+  local $SIG{__WARN__} = sub { push @w, $_[0] if $_[0] =~ /The database_event tag is deprecated - please use database_events/ };
+
+  $sql = $sqlt->translate(
     from     => 'XML-SQLFairy',
     to       => 'MySQL',
     filename => $testschema,
-) or die $sqlt->error;
-print $sql if DEBUG;
+  ) or die $sqlt->error;
+  print $sql if DEBUG;
+
+  ok (@w, 'database_event deprecation warning issued');
+}
 
 # Test the schema objs generted from the XML
 #
@@ -220,6 +229,16 @@ schema_ok( $scma, {
                 bar => "baz",
             },
         },
+        {
+            name                => 'bar_trigger',
+            perform_action_when => 'before',
+            database_events     => 'insert,update',
+            on_table            => 'Basic',
+            action              => 'update modified2=timestamp();',
+            extra => {
+                hello => "aliens",
+            },
+        },
     ],
 
     procedures => [
index c6efae0..7b5d5b9 100644 (file)
@@ -38,7 +38,7 @@ use SQL::Translator::Producer::TTSchema;
 {
     my $obj;
     $obj = SQL::Translator->new(
-        show_warnings  => 1,
+        show_warnings  => 0,
         from           => "XML-SQLFairy",
         filename       => "$Bin/data/xml/schema.xml",
         to             => "TTSchema",
@@ -65,7 +65,7 @@ use SQL::Translator::Producer::TTSchema;
     [%- END %]};
     my $obj;
     $obj = SQL::Translator->new(
-        show_warnings  => 1,
+        show_warnings  => 0,
         from           => "XML-SQLFairy",
         filename       => "$Bin/data/xml/schema.xml",
         to             => "TTSchema",
index 02fdca8..30d62b2 100644 (file)
@@ -26,7 +26,7 @@ use lib ("$Bin/lib");
 my $obj;
 $obj = SQL::Translator->new(
     debug          => 0,
-    show_warnings  => 1,
+    show_warnings  => 0,
     add_drop_table => 1,
     from           => "XML-SQLFairy",
     filename       => "$Bin/data/xml/schema.xml",
index 223daf3..b7771b1 100644 (file)
@@ -20,7 +20,7 @@ my $xmlfile = "$Bin/data/xml/schema.xml";
 my $sqlt;
 $sqlt = SQL::Translator->new(
     no_comments => 1,
-    show_warnings  => 1,
+    show_warnings  => 0,
     add_drop_table => 1,
 );
 
@@ -64,4 +64,6 @@ CREATE VIEW email_list AS
 SELECT email FROM Basic WHERE email IS NOT NULL;
 
 CREATE TRIGGER foo_trigger after insert ON Basic REFERENCING OLD AS oldrow NEW AS newrow FOR EACH ROW MODE DB2SQL update modified=timestamp();
+
+CREATE TRIGGER bar_trigger before insert, update ON Basic REFERENCING OLD AS oldrow NEW AS newrow FOR EACH ROW MODE DB2SQL update modified2=timestamp();
 SQL
index 37c69cc..065fc35 100644 (file)
@@ -20,7 +20,7 @@ my $xmlfile = "$Bin/data/xml/schema.xml";
 my $sqlt;
 $sqlt = SQL::Translator->new(
     no_comments => 1,
-    show_warnings  => 1,
+    show_warnings  => 0,
     add_drop_table => 1,
 );
 
@@ -61,7 +61,9 @@ q|CREATE TABLE Another (
 'CREATE VIEW email_list AS
 SELECT email FROM Basic WHERE email IS NOT NULL;',
 
-'CREATE TRIGGER foo_trigger after insert ON Basic REFERENCING OLD AS oldrow NEW AS newrow FOR EACH ROW MODE DB2SQL update modified=timestamp();'
+'CREATE TRIGGER foo_trigger after insert ON Basic REFERENCING OLD AS oldrow NEW AS newrow FOR EACH ROW MODE DB2SQL update modified=timestamp();',
+
+'CREATE TRIGGER bar_trigger before insert, update ON Basic REFERENCING OLD AS oldrow NEW AS newrow FOR EACH ROW MODE DB2SQL update modified2=timestamp();',
 ];
 
 is_deeply(\@sql, $want, 'Got correct DB2 statements in list context');
index 9525160..87469dc 100644 (file)
@@ -21,7 +21,7 @@ my $xmlfile = "$Bin/data/xml/schema.xml";
 my $sqlt;
 $sqlt = SQL::Translator->new(
     no_comments => 1,
-    show_warnings  => 1,
+    show_warnings  => 0,
     add_drop_table => 1,
 );
 
index 4dd1da7..427f0d2 100644 (file)
@@ -71,6 +71,14 @@ DROP TRIGGER IF EXISTS foo_trigger;
 
 CREATE TRIGGER foo_trigger after insert on Basic BEGIN update modified=timestamp(); END;
 
+DROP TRIGGER IF EXISTS bar_trigger_insert;
+
+CREATE TRIGGER bar_trigger_insert before insert on Basic BEGIN update modified2=timestamp(); END;
+
+DROP TRIGGER IF EXISTS bar_trigger_update;
+
+CREATE TRIGGER bar_trigger_update before update on Basic BEGIN update modified2=timestamp(); END;
+
 COMMIT;
 SQL
 
@@ -108,7 +116,12 @@ CREATE VIEW email_list AS
     SELECT email FROM Basic WHERE email IS NOT NULL',
           'DROP TRIGGER IF EXISTS foo_trigger',
           'CREATE TRIGGER foo_trigger after insert on Basic BEGIN update modified=timestamp(); END',
-          'COMMIT'
+          'DROP TRIGGER IF EXISTS bar_trigger_insert',
+          'CREATE TRIGGER bar_trigger_insert before insert on Basic BEGIN update modified2=timestamp(); END',
+          'DROP TRIGGER IF EXISTS bar_trigger_update',
+          'CREATE TRIGGER bar_trigger_update before update on Basic BEGIN update modified2=timestamp(); END',
+          'COMMIT',
+
           ], 'SQLite translate in list context matches');
 
 
index a8b7948..8601891 100644 (file)
@@ -92,11 +92,16 @@ Created on Fri Aug 15 15:08:18 2003
   </views>
 
   <triggers>
-      <trigger name="foo_trigger" database_events="insert" on_table="Basic"
+      <trigger name="foo_trigger" database_event="insert" on_table="Basic"
           perform_action_when="after" order="1">
           <action>update modified=timestamp();</action>
           <extra foo="bar" hello="world" bar="baz" />
       </trigger>
+      <trigger name="bar_trigger" database_events="insert , update" on_table="Basic"
+          perform_action_when="before" order="1">
+          <action>update modified2=timestamp();</action>
+          <extra hello="aliens" />
+      </trigger>
   </triggers>
 
   <procedures>