Commit | Line | Data |
f85aea79 |
1 | package SQL::Translator::Parser::DB2; |
2 | use Data::Dumper; |
3 | use SQL::Translator::Parser::DB2::Grammar; |
4 | use Exporter; |
5 | use base qw(Exporter); |
6 | |
7 | @EXPORT_OK = qw(parse); |
8 | |
9 | # Enable warnings within the Parse::RecDescent module. |
10 | $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error |
11 | $::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c. |
12 | $::RD_HINT = 1; # Give out hints to help fix problems. |
13 | |
f85aea79 |
14 | sub parse { |
15 | my ( $translator, $data ) = @_; |
16 | my $parser = SQL::Translator::Parser::DB2::Grammar->new(); |
17 | |
18 | local $::RD_TRACE = $translator->trace ? 1 : undef; |
19 | local $DEBUG = $translator->debug; |
20 | |
21 | unless (defined $parser) { |
22 | return $translator->error("Error instantiating Parse::RecDescent ". |
23 | "instance: Bad grammer"); |
24 | } |
25 | |
26 | my $result = $parser->startrule($data); |
27 | return $translator->error( "Parse failed." ) unless defined $result; |
28 | warn Dumper( $result ) if $DEBUG; |
29 | |
30 | my $schema = $translator->schema; |
ea93df61 |
31 | my @tables = |
f85aea79 |
32 | map { $_->[1] } |
ea93df61 |
33 | sort { $a->[0] <=> $b->[0] } |
f85aea79 |
34 | map { [ $result->{'tables'}{ $_ }->{'order'}, $_ ] } |
35 | keys %{ $result->{'tables'} }; |
36 | |
37 | for my $table_name ( @tables ) { |
38 | my $tdata = $result->{'tables'}{ $table_name }; |
ea93df61 |
39 | my $table = $schema->add_table( |
f85aea79 |
40 | name => $tdata->{'name'}, |
41 | ) or die $schema->error; |
42 | |
43 | $table->comments( $tdata->{'comments'} ); |
44 | |
45 | for my $fdata ( @{ $tdata->{'fields'} } ) { |
46 | my $field = $table->add_field( |
47 | name => $fdata->{'name'}, |
48 | data_type => $fdata->{'data_type'}, |
49 | size => $fdata->{'size'}, |
50 | default_value => $fdata->{'default'}, |
51 | is_auto_increment => $fdata->{'is_auto_inc'}, |
52 | is_nullable => $fdata->{'is_nullable'}, |
53 | comments => $fdata->{'comments'}, |
54 | ) or die $table->error; |
55 | |
56 | $table->primary_key( $field->name ) if $fdata->{'is_primary_key'}; |
57 | |
58 | for my $cdata ( @{ $fdata->{'constraints'} } ) { |
59 | next unless $cdata->{'type'} eq 'foreign_key'; |
60 | $cdata->{'fields'} ||= [ $field->name ]; |
61 | push @{ $tdata->{'constraints'} }, $cdata; |
62 | } |
63 | } |
64 | |
65 | for my $idata ( @{ $tdata->{'indices'} || [] } ) { |
66 | my $index = $table->add_index( |
67 | name => $idata->{'name'}, |
68 | type => uc $idata->{'type'}, |
69 | fields => $idata->{'fields'}, |
70 | ) or die $table->error; |
71 | } |
72 | |
73 | for my $cdata ( @{ $tdata->{'constraints'} || [] } ) { |
74 | my $constraint = $table->add_constraint( |
75 | name => $cdata->{'name'}, |
76 | type => $cdata->{'type'}, |
77 | fields => $cdata->{'fields'}, |
78 | reference_table => $cdata->{'reference_table'}, |
79 | reference_fields => $cdata->{'reference_fields'}, |
80 | match_type => $cdata->{'match_type'} || '', |
100684f3 |
81 | on_delete => $cdata->{'on_delete'} || $cdata->{'on_delete_do'}, |
82 | on_update => $cdata->{'on_update'} || $cdata->{'on_update_do'}, |
f85aea79 |
83 | ) or die $table->error; |
84 | } |
85 | } |
86 | |
87 | for my $def ( @{ $result->{'views'} || [] } ) { |
88 | my $view = $schema->add_view( |
89 | name => $def->{'name'}, |
90 | sql => $def->{'sql'}, |
91 | ); |
92 | } |
93 | |
94 | for my $def ( @{ $result->{'triggers'} || [] } ) { |
95 | my $trig = $schema->add_trigger( |
96 | name => $def->{'name'}, |
97 | perform_action_when => $def->{'when'}, |
98 | database_event => $def->{'db_event'}, |
99 | action => $def->{'action'}, |
100 | fields => $def->{'fields'}, |
101 | on_table => $def->{'table'} |
102 | ); |
103 | $trig->extra( reference => $def->{'reference'}, |
104 | condition => $def->{'condition'}, |
105 | granularity => $def->{'granularity'} ); |
106 | } |
107 | |
108 | return 1; |
109 | } |
110 | |
111 | 1; |