primary key fix for YAML
[dbsrgits/SQL-Translator-2.0-ish.git] / lib / SQL / Translator / Parser / DDL / YAML.pm
1 use MooseX::Declare;
2 role SQL::Translator::Parser::DDL::YAML { 
3     use MooseX::Types::Moose qw(Str);
4     use SQL::Translator::Types qw(Schema);
5     use aliased 'SQL::Translator::Object::Column';
6     use aliased 'SQL::Translator::Object::Constraint';
7     use aliased 'SQL::Translator::Object::Index';
8     use aliased 'SQL::Translator::Object::Procedure';
9     use aliased 'SQL::Translator::Object::Table';
10     use aliased 'SQL::Translator::Object::Trigger';
11     use aliased 'SQL::Translator::Object::View';
12     use YAML qw(Load);
13     use MooseX::MultiMethods;
14
15     multi method parse(Schema $data) { $data }
16
17     multi method parse(Str $data) {
18         $data = Load($data);
19         $data = $data->{schema};
20     
21         my $schema = $self->schema;
22         my $translator = $self->translator;
23     
24         #
25         # Tables
26         #
27         my @tables = 
28             map   { $data->{'tables'}{ $_->[1] } }
29             map   { [ $data->{'tables'}{ $_ }{'order'} || 0, $_ ] }
30             keys %{ $data->{'tables'} };
31     
32         for my $tdata ( @tables ) {
33             my $table = Table->new({ name => $tdata->{name}, schema => $schema });
34             $table->extra($tdata->{extra}) if $tdata->{extra};
35             $table->options($tdata->{options}) if $tdata->{options};
36             $schema->add_table($table);
37
38             my @fields = 
39                 map   { $tdata->{'fields'}{ $_->[1] } }
40                 map   { [ $tdata->{'fields'}{ $_ }{'order'} || 0, $_ ] }
41                 keys %{ $tdata->{'fields'} };
42     
43             for my $fdata ( @fields ) {
44                 $fdata->{sql_data_type} = $self->data_type_mapping->{$fdata->{data_type}} || -99999;
45                 $fdata->{table} = $table;
46
47                 my $column = Column->new($fdata);
48                 $table->add_column($column);
49                 $column->is_primary_key(1) if $fdata->{is_primary_key};
50             }
51     
52             for my $idata ( @{ $tdata->{'indices'} || [] } ) { 
53                  $idata->{table} = $table;
54                  my $columns = delete $idata->{fields};
55
56                  my $index = Index->new($idata);
57                  $index->add_column($table->get_column($_)) for @$columns;
58                  $table->add_index($index);
59             }
60     
61             for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
62                  $cdata->{table} = $table;
63                  $cdata->{reference_columns} = delete $cdata->{reference_fields};
64                  my $columns = delete $cdata->{fields} || [];
65                  my $constraint = Constraint->new($cdata);
66                  $constraint->add_column($table->get_column($_)) for @$columns;
67                  $table->add_constraint($constraint);
68             }
69         }
70     
71         #
72         # Views
73         #
74         my @views = 
75             map   { $data->{'views'}{ $_->[1] } }
76             map   { [ $data->{'views'}{ $_ }{'order'}, $_ ] }
77             keys %{ $data->{'views'} };
78     
79         for my $vdata ( @views ) {
80             my $view = View->new($vdata);
81             $schema->add_view($view);
82         }
83     
84         #
85         # Triggers
86         #
87         my @triggers = 
88             map   { $data->{'triggers'}{ $_->[1] } }
89             map   { [ $data->{'triggers'}{ $_ }{'order'}, $_ ] }
90             keys %{ $data->{'triggers'} };
91     
92         for my $tdata ( @triggers ) {
93             my $columns = delete $tdata->{fields} || ();
94             my $trigger = Trigger->new($tdata);
95             $trigger->add_column($schema->get_table($tdata->{on_table})->get_column($_)) for @$columns; 
96             $schema->add_trigger($trigger);
97         }
98     
99         #
100         # Procedures
101         #
102         my @procedures = 
103             map   { $data->{'procedures'}{ $_->[1] } }
104             map   { [ $data->{'procedures'}{ $_ }{'order'}, $_ ] }
105             keys %{ $data->{'procedures'} };
106     
107         for my $tdata ( @procedures ) {
108              my $procedure = Procedure->new($tdata);
109              $schema->add_procedure($procedure);
110         }
111     
112         if ( my $tr_data = $data->{'translator'} ) {
113             $translator->add_drop_table( $tr_data->{'add_drop_table'} );
114             $translator->filename( $tr_data->{'filename'} );
115             $translator->no_comments( $tr_data->{'no_comments'} );
116             $translator->parser_args( $tr_data->{'parser_args'} );
117             $translator->producer_args( $tr_data->{'producer_args'} );
118             $translator->parser_type( $tr_data->{'parser_type'} );
119             $translator->producer_type( $tr_data->{'producer_type'} );
120             $translator->show_warnings( $tr_data->{'show_warnings'} );
121             $translator->trace( $tr_data->{'trace'} );
122         }
123     
124         return 1;
125     }
126 }