view release on metacpan or  search on metacpan

lib/Geoffrey/Converter/Pg.pm  view on Meta::CPAN

}

sub can_create_empty_table { return 1 }

sub colums_information {
    my ( $self, $ar_raw_data ) = @_;
    return [] if scalar @{$ar_raw_data} == 0;
    my $table_row = shift @{$ar_raw_data};
    $table_row->{sql} =~ s/^.*(CREATE|create) .*\(//g;
    my $columns = [];
    for ( split m/,/, $table_row->{sql} ) {
        s/^\s*(.*)\s*$/$1/g;
        my $rx_not_null      = 'NOT NULL';
        my $rx_primary_key   = 'PRIMARY KEY';
        my $rx_default       = 'SERIAL|DEFAULT';
        my $rx_column_values = qr/($rx_not_null)*\s($rx_primary_key)*.*($rx_default \w{1,})*/;
        my @column           = m/^(\w+)\s([[:upper:]]+)(\(\d*\))*\s$rx_column_values$/;
        next                                            if scalar @column == 0;
        $column[$I_CONST_LENGTH_VALUE] =~ s/([\(\)])//g if $column[$I_CONST_LENGTH_VALUE];
        push @{$columns},
            {
            name => $column[0],
            type => $column[1],
            ( $column[$I_CONST_LENGTH_VALUE]      ? ( length      => $column[$I_CONST_LENGTH_VALUE] )      : () ),
            ( $column[$I_CONST_NOT_NULL_VALUE]    ? ( not_null    => $column[$I_CONST_NOT_NULL_VALUE] )    : () ),
            ( $column[$I_CONST_PRIMARY_KEY_VALUE] ? ( primary_key => $column[$I_CONST_PRIMARY_KEY_VALUE] ) : () ),
            ( $column[$I_CONST_DEFAULT_VALUE]     ? ( default     => $column[$I_CONST_DEFAULT_VALUE] )     : () ),
            };
    } ## end for ( split m/,/, $table_row...)
    return $columns;
} ## end sub colums_information

sub index_information {
    my ( $self, $ar_raw_data ) = @_;
    my @mapped = ();
    for ( @{$ar_raw_data} ) {
        next if !$_->{sql};
        my ($s_columns) = $_->{sql} =~ m/\((.*)\)$/;
        my @columns     = split m/,/, $s_columns;
        s/^\s+|\s+$//g for @columns;
        push @mapped, { name => $_->{name}, table => $_->{tbl_name}, columns => \@columns };
    } ## end for ( @{$ar_raw_data} )
    return \@mapped;
} ## end sub index_information

sub view_information {
    my ( $self, $ar_raw_data ) = @_;
    return [] unless $ar_raw_data;
    return [ map { { name => $_->{name}, sql => $_->{sql} } } @{$ar_raw_data} ];