view release on metacpan or  search on metacpan

lib/MySQL/Workbench/Parser/MySQLParser.pm  view on Meta::CPAN

    $schema->name($result->{'database_name'}) if $result->{'database_name'};

    my @tables = sort {
        $result->{'tables'}{ $a }{'order'}
        <=>
        $result->{'tables'}{ $b }{'order'}
    } keys %{ $result->{'tables'} };

    for my $table_name ( @tables ) {
        my $tdata =  $result->{tables}{ $table_name };
        my $table =  $schema->add_table(
            name  => $tdata->{'table_name'},
        ) or die $schema->error;

        $table->comments( $tdata->{'comments'} );

        my @fields = sort {
            $tdata->{'fields'}->{$a}->{'order'}
            <=>
            $tdata->{'fields'}->{$b}->{'order'}
        } keys %{ $tdata->{'fields'} };

        for my $fname ( @fields ) {
            my $fdata = $tdata->{'fields'}{ $fname };
            my $field = $table->add_field(
                name              => $fdata->{'name'},
                data_type         => $fdata->{'data_type'},
                size              => $fdata->{'size'},
                default_value     => $fdata->{'default'},
                is_auto_increment => $fdata->{'is_auto_inc'},
                is_nullable       => $fdata->{'null'},
                comments          => $fdata->{'comments'},
            ) or die $table->error;

            $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};

            for my $qual ( qw[ binary unsigned zerofill list collate ],
                    'character set', 'on update' ) {
                if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
                    next if ref $val eq 'ARRAY' && !@$val;
                    $field->extra( $qual, $val );
                }
            }

            if ( $fdata->{'has_index'} ) {
                $table->add_index(
                    name   => '',
                    type   => 'NORMAL',
                    fields => $fdata->{'name'},
                ) or die $table->error;
            }

            if ( $fdata->{'is_unique'} ) {
                $table->add_constraint(
                    name   => '',
                    type   => 'UNIQUE',
                    fields => $fdata->{'name'},
                ) or die $table->error;
            }

            for my $cdata ( @{ $fdata->{'constraints'} } ) {
                next unless $cdata->{'type'} eq 'foreign_key';
                $cdata->{'fields'} ||= [ $field->name ];
                push @{ $tdata->{'constraints'} }, $cdata;
            }

        }

        for my $idata ( @{ $tdata->{'indices'} || [] } ) {
            my $index  =  $table->add_index(
                name   => $idata->{'name'},
                type   => uc $idata->{'type'},
                fields => $idata->{'fields'},
            ) or die $table->error;
        }

        if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
            my @cleaned_options;
            my @ignore_opts = $translator->parser_args->{'ignore_opts'}
                ? split( /,/, $translator->parser_args->{'ignore_opts'} )
                : ();
            if (@ignore_opts) {
                my $ignores = { map { $_ => 1 } @ignore_opts };
                foreach my $option (@options) {
                    # make sure the option isn't in ignore list
                    my ($option_key) = keys %$option;
                    if ( !exists $ignores->{$option_key} ) {
                        push @cleaned_options, $option;
                    }
                }
            } else {
                @cleaned_options = @options;
            }
            $table->options( \@cleaned_options ) or die $table->error;
        }

        for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
            my $constraint       =  $table->add_constraint(
                name             => $cdata->{'name'},
                type             => $cdata->{'type'},
                fields           => $cdata->{'fields'},
                expression       => $cdata->{'expression'},
                reference_table  => $cdata->{'reference_table'},
                reference_fields => $cdata->{'reference_fields'},
                match_type       => $cdata->{'match_type'} || '',
                on_delete        => $cdata->{'on_delete'}
                                 || $cdata->{'on_delete_do'},
                on_update        => $cdata->{'on_update'}
                                 || $cdata->{'on_update_do'},
            ) or die $table->error;
        }

        # After the constrains and PK/idxs have been created,
        # we normalize fields
        normalize_field($_) for $table->get_fields;
    }

    my @procedures = sort {
        $result->{procedures}->{ $a }->{'order'}
        <=>
        $result->{procedures}->{ $b }->{'order'}
    } keys %{ $result->{procedures} };

    for my $proc_name ( @procedures ) {
        $schema->add_procedure(
            name  => $proc_name,
            owner => $result->{procedures}->{$proc_name}->{owner},
            sql   => $result->{procedures}->{$proc_name}->{sql},
        );
    }

    my @views = sort {
        $result->{views}->{ $a }->{'order'}
        <=>
        $result->{views}->{ $b }->{'order'}
    } keys %{ $result->{views} };

    for my $view_name ( @views ) {
        my $view = $result->{'views'}{ $view_name };
        my @flds = map { $_->{'alias'} || $_->{'name'} }
                   @{ $view->{'select'}{'columns'} || [] };
        my @from = map { $_->{'alias'} || $_->{'name'} }
                   @{ $view->{'from'}{'tables'} || [] };

        $schema->add_view(
            name    => $view_name,
            sql     => $view->{'sql'},
            order   => $view->{'order'},
            fields  => \@flds,
            tables  => \@from,
            options => $view->{'options'}
        );
    }

    return 1;
}

# Takes a field, and returns
sub normalize_field {
    my ($field) = @_;
    my ($size, $type, $list, $unsigned, $changed);

    $size = $field->size;
    $type = $field->data_type;
    $list = $field->extra->{list} || [];
    $unsigned = defined($field->extra->{unsigned});

    if ( !ref $size && $size eq 0 ) {
        if ( lc $type eq 'tinyint' ) {