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