view release on metacpan or  search on metacpan

lib/App/DBBrowser/CreateDropAttach/CreateTable.pm  view on Meta::CPAN

                       #     @duplicates = duplicates @{$sql->{ct_column_definitions}};
                       # }
                       # else {
                       #     @duplicates = duplicates map { lc } @{$sql->{ct_column_definitions}};
                       # }
                        if ( @duplicates ) {
                            # Choose
                            $tc->choose(
                                [ 'Duplicate column name!' ],
                                { prompt => 'Continue with ENTER', keep => 1 }
                            );
                            next EDIT_COLUMN_NAMES;
                        }
                        my @unedited_ct_column_definitions = @{$sql->{ct_column_definitions}};
                        my $data_types = {}; # data_types memory

                        EDIT_COLUMN_TYPES: while( 1 ) {
                            $data_types = $sf->__edit_column_types( $sql, $source, $data_types );
                            if ( ! $data_types ) {
                                $sql->{ct_column_definitions} = [ @unquoted_ct_column_definitions ];
                                $sql->{insert_col_names} = [ @unquoted_insert_col_names ];
                                next EDIT_COLUMN_NAMES;
                            }
                            # CREATE_TABLE
                            my $ok_create_table = $sf->__create( $sql, 'table' );
                            if ( ! defined $ok_create_table ) {
                                $sql->{ct_column_definitions} = [ @unedited_ct_column_definitions ];
                                next EDIT_COLUMN_TYPES;
                            }
                            elsif ( ! $ok_create_table ) {
                                return;
                            }
                            elsif ( @{$sql->{insert_args}} ) {
                                # INSERT_DATA
                                my $ok_insert = $sf->__insert_data( $sql );
                                if ( ! $ok_insert ) {
                                   return;
                                }
                            }
                            return 1;
                        }
                    }
                }
            }
        }
    }
}


sub __set_table_name {
    my ( $sf, $sql, $source, $tablename_default, $count_table_name_loop ) = @_;
    my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
    my $tc = Term::Choose->new( $sf->{i}{tc_default} );
    my $tr = Term::Form::ReadLine->new( $sf->{i}{tr_default} );
    $ax->print_sql_info( $ax->get_sql_info( $sql ) );

    while ( 1 ) {
        my $file_info;
        if ( $source->{source_type} eq 'file' ) {
            my $file_fs = $source->{file_fs};
            my $file_name = basename decode( 'locale_fs', $file_fs );
            $file_info = sprintf "File: '%s'", $file_name;
            if ( ! length $tablename_default ) {
                if ( length $source->{sheet_name} ) {
                    $file_name =~ s/\.[^.]{1,4}\z//;
                    $tablename_default = $file_name . '_' . $source->{sheet_name};
                }
                else {
                    $tablename_default = $file_name =~ s/\.[^.]{1,4}\z//r;
                }
                $tablename_default =~ s/ /_/g;
            }
        }
        if ( $count_table_name_loop > 1 ) { # to avoid infinite loop when going back with `ENTER`
            $tablename_default = '';
        }
        my $info = $ax->get_sql_info( $sql ) . ( $file_info ? "\n" . $file_info : '' );
        # Readline
        my $table_name = $tr->readline(
            'Table name: ',
            { info => $info, default => $tablename_default, history => [] }
        );
        $ax->print_sql_info( $info );
        if ( ! length $table_name ) {
            return;
        }
        $sql->{table} = $ax->qq_table( [ undef, $sf->{d}{schema}, $table_name ] );
        if ( none { $sql->{table} eq $ax->qq_table( $sf->{d}{tables_info}{$_} ) } keys %{$sf->{d}{tables_info}} ) {
            return $table_name;
        }
        my $prompt = "Table $sql->{table} already exists.";
        my $menu = [ undef, '  New name' ];
        $info = $ax->get_sql_info( $sql );
        # Choose
        my $chosen = $tc->choose(
            $menu,
            { %{$sf->{i}{lyt_v}}, info => $info, prompt => $prompt, keep => scalar( @$menu ) }
        );
        $ax->print_sql_info( $info );
        if ( ! defined $chosen ) {
            return;
        }
        $tablename_default = $tablename_default ? $table_name : '';
        $count_table_name_loop++;
    }
}


sub __get_column_names {
    my ( $sf, $sql ) = @_;
    my $tc = Term::Choose->new( $sf->{i}{tc_default} );
    my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
    my ( $first_row, $user_input ) = ( '- YES', '- NO' );
    my $hidden = 'Use the first Data Row as the Table Header:';
    my @pre = ( $hidden, undef );
    my $menu = [ @pre, $first_row, $user_input ];

    while ( 1 ) {
        my $info = $ax->get_sql_info( $sql );
        # Choose
        my $idx = $tc->choose(

lib/App/DBBrowser/CreateDropAttach/CreateTable.pm  view on Meta::CPAN

        }
        elsif ( $firebird_major_version >= 3 ) {
            return "INT GENERATED BY DEFAULT AS IDENTITY PRIMARY KEY";
        }
    }
    if ( $dbms eq 'DB2' ) {
        return "INT NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY";
    }
    if ( $dbms eq 'Oracle' ) {
        my $ora_major_server_version = $ax->major_server_version();
        if ( $ora_major_server_version >= 12 ) {
            return "NUMBER GENERATED ALWAYS AS IDENTITY";   # Oracle 12c or greater
        }
    }
    if ( $dbms eq 'MSSQL' ) {
        return "INT IDENTITY(1,1) PRIMARY KEY";
    }
}


sub __edit_column_names {
    my ( $sf, $sql, $column_names ) = @_;
    my $tf = Term::Form->new( $sf->{i}{tf_default} );
    my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
    my $col_number = 0;
    my $fields = [ map { [ ++$col_number, $_ ] } @$column_names ];
    my $info = $ax->get_sql_info( $sql );
    # Fill_form
    my $form = $tf->fill_form(
        $fields,
        { info => $info, prompt => 'Edit column names:', confirm => $sf->{i}{confirm}, back => $sf->{i}{back} . '   ' }
    );
    $ax->print_sql_info( $info );
    if ( ! defined $form ) {
        return;
    }
    $column_names = [ map { $_->[1] } @$form ];
    $sql->{ct_column_definitions} = $ax->quote_cols( $column_names ); # now quoted
    $sql->{insert_col_names} = [ @{$sql->{ct_column_definitions}} ];  # now quoted
    if ( $sf->{auto_increment} ) {
        shift @{$sql->{insert_col_names}};
    }
    $sql->{ct_table_constraints} = [];
    $sql->{ct_table_options} = [];
    return $column_names;
}


sub __edit_column_types {
    my ( $sf, $sql, $source, $data_types ) = @_;
    my $tf = Term::Form->new( $sf->{i}{tf_default} );
    my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
    my $dbms = $sf->{i}{dbms};
    my $fields;
    if ( ! %$data_types && $sf->{o}{create}{data_type_guessing} ) {
        $ax->print_sql_info( $ax->get_sql_info( $sql ), 'Column data types: guessing ... ' );
        my $header = $sql->{insert_col_names}; #
        my $table  = $sql->{insert_args};
        my $encoding;
        if ( $sf->{o}{create}{encode_for_data_type_guessing} ) { # MSSQL DB2 Oracle
            $encoding = $source->{source_type} eq 'plain' ? 'locale' : $sf->{o}{insert}{file_encoding};
        }
        my @aoh;
        if ( length $encoding ) {
            for my $row ( @$table ) {
                push @aoh, { map { $header->[$_] => Encode::encode( $encoding, $row->[$_] ) } 0 .. $#$header };
            }
        }
        else {
            for my $row ( @$table ) {
                push @aoh, { map { $header->[$_] => $row->[$_] } 0 .. $#$header };
            }
        }
        require SQL::Type::Guess;
        my $g = SQL::Type::Guess->new();
        $g->guess( @aoh );
        my $tmp = $g->column_type;
        $data_types = { map { $_ => uc( $tmp->{$_} ) } keys %$tmp };
    }
    if ( defined $data_types ) {
        $fields = [ map { [ $_, $data_types->{$_} ] } @{$sql->{insert_col_names}} ];
    }
    else {
        $fields = [ map { [ $_, '' ] } @{$sql->{insert_col_names}} ];
    }
    my $read_only = []; ##
    if ( $sf->{auto_increment} ) {
        unshift @$fields, [ $sql->{ct_column_definitions}[0], $sf->__primary_key_autoincrement_constraint() ];
        $read_only = [ 0 ];
    }
    if ( $dbms =~ /^(?:Pg|DuckDB|Firebird|Informix|Oracle)\z/ ) {
        for my $field ( @$fields ) {
            if ( defined $field->[1] && $field->[1] eq 'DATETIME' ) {
                $field->[1] = 'TIMESTAMP'                 if $dbms =~ /^(?:Pg|DuckDB|Firebird)\z/;
                $field->[1] = 'DATE'                      if $dbms eq 'Oracle';
                $field->[1] = 'DATETIME YEAR TO FRACTION' if $dbms eq 'Informix';
                # Informix: DATETIME largest_qualifier TO smallest_qualifier
            }
        }
    }
    my $constraint_rows = $sf->{o}{create}{table_constraint_rows};
    my $tbl_option_rows = $sf->{o}{create}{table_option_rows};
    my $skip = ' ';
    if ( $constraint_rows ) {
        push @$fields, [ $skip ];
        for my $i ( 0 .. $constraint_rows - 1 ) {
            push @$fields, [ 'Constraint', $sql->{ct_table_constraints}[$i] // '' ];
        }
    }
    if ( $tbl_option_rows ) {
        push @$fields, [ $skip ];
        for my $i ( 0 .. $tbl_option_rows - 1 ) {
            push @$fields, [ 'Tbl Option', $sql->{ct_table_options}[$i] // '' ];
        }
    }
    my $info = $ax->get_sql_info( $sql );
    # Fill_form
    my $filled_form = $tf->fill_form(
        $fields,
        { info => $info, prompt => 'Column data types:', read_only => $read_only,
          confirm => $sf->{i}{confirm}, back => $sf->{i}{back} . '   ' }