view release on metacpan or  search on metacpan

lib/Bigtop/Backend/Diagram/GraphvizSql.pm  view on Meta::CPAN

    }

    # now make the table node, starting with a label statement if present
    my $label;
    CANDIDATE:
    foreach my $block ( @{ $self->{__BODY__} } ) {
        next CANDIDATE unless $block->{__TYPE__} eq 'label';

        $label = ($block->{__ARGS__}->get_unquoted_args)->[0];
        last CANDIDATE;
    }
    $label = join ' ', map { ucfirst $_ } split /_/, $name unless $label;

    my $output = Bigtop::Backend::Diagram::GraphvizSql::table(
        {
            name    => $name,
            label   => $label,
            columns => \@columns,
        }
    );

    if ( @edges ) {
        return [
            { tables => $output },
            { edges  => join( "\n", @edges ) . "\n" }
        ];
    }
    else {
        return [ { tables => $output } ];
    }
}

package # table_element_block
    table_element_block;
use strict; use warnings;

sub output_diagram_gvsql {
    my $self         = shift;
    my $child_output = shift;

    my $name = $self->get_name();

    return unless defined $name;

    my $skip_this = $self->walk_postorder( 'skip_this_field' );
    return if defined $skip_this;

    my $retval = {};
    foreach my $el ( @{ $child_output } ) {
        my ( $key, $val ) = %{ $el };
        $retval->{ $key } = $val;
    }
    $retval->{ local_col } = $name;

    return [ $retval ];
}

sub skip_this_table {
    my $self         = shift;

    if ( $self->{__TYPE__} eq 'not_for' ) {
        my $skipped_backends = $self->{__ARGS__};
        foreach my $spurned ( @{ $skipped_backends } ) {
            return [ 1 ] if $spurned eq 'Diagram';
        }
    }
    return;
}

package # field_statement
    field_statement;
use strict; use warnings;

sub output_diagram_gvsql {
    my $self         = shift;

    my $keyword = $self->get_name();

    if ( $keyword eq 'is' ) {
        # place holder in case we care about special types
        return;
    }
    elsif ( $keyword eq 'refers_to' or $keyword eq 'quasi_refers_to' ) {
        my $foreign_info = $self->{__DEF__}{__ARGS__}[0];

        return unless ( ref( $foreign_info ) eq 'HASH' );

        my ( $table, $col ) = %{ $foreign_info };

        $table =~ s/.*\.//;

        return [
            { foreign_col  => "$table:$col" },
            { foreign_type => $keyword      },
        ];
    }
    elsif ( $keyword eq 'label' ) {
        return [
            { label => $self->{__DEF__}{__ARGS__}[0] }
        ];
    }
}

sub skip_this_field {
    my $self         = shift;

    if ( $self->get_name() eq 'not_for' ) {
        my $skipped_backends = $self->{__DEF__}{__ARGS__};
        foreach my $spurned ( @{ $skipped_backends } ) {
            return [ 1 ] if $spurned eq 'Diagram';
        }
    }
    return;
}

package # join_table
    join_table;
use strict; use warnings;

sub output_diagram_gvsql {
    my $self         = shift;
    my $child_output = shift;

    # who am I
    my $name = $self->{__NAME__};
    $name =~ s/.*\.//;
    # schema might still be there for old versions

    # deal with child output
    my @edges;
    my @columns;
    my $indent = ' ' x 4;
    my $schema = '';
    foreach my $col ( @{ $child_output } ) {
        my $col_output = Bigtop::Backend::Diagram::GraphvizSql::column(
            {
                port  => $col->{ local_col },
                label => $col->{ label } || $col->{ local_col },
            }
        );
        push @columns, $col_output;

        if ( $schema eq '' ) {
            ( $schema, undef ) = split /\./, $col->{ full_name };
            $name =~ s/^$schema//;
        }

        if ( defined $col->{ foreign_col } ) {
            my $port = $col->{ local_col };
            $col->{ local_col } = "$name:$port";

            push @edges, $indent
                        . $col->{ local_col   } . ' -> '
                        . $col->{ foreign_col }
        }
    }

    # now make the table node
    my $label = join ' ', map { ucfirst $_ } split /_/, $name;

    my $output = Bigtop::Backend::Diagram::GraphvizSql::table(
        {
            name    => $name,
            label   => $label,
            columns => \@columns,
        }
    );