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