App-DBBrowser
view release on metacpan or search on metacpan
- Term::Choose minimum version is '1.739'.
- Code refactoring.
2.281 2021-08-29
- Adapt the code to the updated Term::Choose.
2.280 2021-08-24
- DBD::SQLite 1.68 or greater is required.
- print_table: table_name -> footer.
- Renamed the option 'f3' to 'search'.
- 'Ctrl-F' instead of 'F3' to open the search prompt.
- PageUP/PageDown: 'Ctrl-P'/'Ctrl-N' instead of 'Ctrl-B'/'Ctrl-F'.
2.279 2021-07-29
- Bugfix in functions Epoch_to_Date/Epoch_to_DateTime: use driver specific regex statement.
2.278 2021-07-29
- Removed the source type 'Copy&Paste'.
- Removed option 'Truncated rows'.
2.277 2021-07-28
bin/db-browser view on Meta::CPAN
squashed to a single white space.
Tab characters (C<\t>) are replaced with a space.
Vertical spaces (C<\v>) are squashed to two spaces.
Control characters, code points of the surrogate ranges and non-characters are removed.
See also the option group L</Output>.
C<Ctrl-F> opens a prompt. A regular expression is expected as input. This enables one to display only rows where at
least one column matches the entered pattern. See option L</Search>.
=head1 MENUS
=head2 Plugins Menu
Choosing a plugin leads to the I<Databases Menu>.
(If there is only one plugin, the plugins menu is not shown, but the plugin is chosen automatically.)
bin/db-browser view on Meta::CPAN
Choosing a schema leads to the I<Tables Menu>.
(If there is not more than one schema, the schemas menu is not shown, but the schema is chosen automatically.)
=head2 Tables Menu
The menu entries of the tables menu:
=head3 Prompt Line
Selecting the prompt line (the database name) opens a menu with these entries:
=over
=item
Create Table
=item
Drop Table
bin/db-browser view on Meta::CPAN
Enter a subquery and use it as a table.
The query can be created in different ways:
=over
=item SQL Menu
Build the query with the SQL Menu.
Before returning the subquery, the result of the subquery can be displayed by selecting the prompt line of the menu.
This does not work if the subquery is a correlated subquery.
=item Readline
Write the query in the prompt.
=item Stored Queries
If stored queries are available, it is possible to select one of those queries.
There are three different types of stored queries:
- permanently saved queries
- previously entered queries
- queries printed with I<Print TABLE>
Queries can be saved permanently by selecting the prompt line (I<Choose:>) in the I<Subquery> menu.
=back
=head3 CTE
Common table expression, available if enabled in L</Extensions>.
=over
=item New CTE
bin/db-browser view on Meta::CPAN
This entry is available if enabled in L</Extensions>.
=head2 SQL Menu
SQL statements are created in this menu.
The SQL Menu has the following menu entries:
=head3 Prompt Line
Selecting this prompt line (I<Customize:>) opens a menu with these entries:
=over
=item
Insert
=item
Update
bin/db-browser view on Meta::CPAN
=head4 OFFSET
=head3 Export
Export the result of the chosen SQL statement to a C<CSV>-file. See options L</Export Data>.
=head1 WRITE ACCESS
=head2 Create/Drop Table/View
I<Create/Drop Table/View> can be accessed by selecting the prompt-line in the L</Tables Menu> if the respective option
is activated.
Selecting the prompt line of the I<Create/Drop Table/View> submenu allows you to set the parse settings described in
L</Import Data>.
=head3 Create Table
If the option I<Source Type> is set to I<menu>, selecting I<Create Table> opens a submenu where you can choose the type
of the data source. If I<Source Type> is set to I<plain> or I<file>, the set data source type is automatically used
without displaying a menu. For more information, see L</Data Input>.
You will be asked:
=over
=item
for the table name
=item
if the first data row should be used as a header (Selecting the prompt line of this menu allows you to set the
L</Create-Table> options)
=item
if an auto increment column should be added (if the option is enabled in L</Create-Table>)
=item
to edit the column names
bin/db-browser view on Meta::CPAN
=head3 Create View
Before creating a view, print the required select statement to make it available in the subquery menu.
=head3 Drop View
Drop a view. The entire view is shown before the user confirms dropping it.
=head2 Insert/Update/Delete
I<Insert>, I<Update> and I<Delete> can be accessed by selecting the prompt-line in the L</SQL Menu> if the respective
option is activated.
I<Delete>, I<Update>, or I<Insert> may not be available with C<Join> and C<Union>/C<Intersect>/C<Except> statements.
=head3 Insert
If the option I<Source Type> is set to I<menu>, selecting I<Insert> opens a submenu where one can choose the type of
the data source. If I<Source Type> is set to I<plain> or I<file>, the set data source type is used without showing a
menu. For more information, see L</Data Input>.
bin/db-browser view on Meta::CPAN
installed automatically. It is up to the user to install the required parser modules.
Selecting I<file> opens the I<Source directory> submenu where one can choose the directory which should be
searched for files.
If the L</Directory History> is set to C<1>, the I<Source directory> submenu is skipped and the directory is chosen
automatically.
After a directory has been chosen, a submenu is opened where one can choose the source file.
Selecting the prompt line of the I<Files> submenu (I<Choose a File:>) allows one to set the parse settings described in
L</Import Data>.
After the data has been read, the user can apply different input filters (See L</Input Filters>).
=back
=head3 Input Filters
=over
bin/db-browser view on Meta::CPAN
1 | 78,975.17 1 | 78975.17
---|------------- ---|-----------
2 | 1,040,745.87 2 | 1040745.87
---|------------- ---|-----------
3 | 3,129,818.21 3 | 3129818.21
Supported L<modifiers|https://perldoc.perl.org/perlre#Modifiers>: C<imnsxage>.
In the replacement, the variable C<$c> can be used as a counter. C<$c> is set to C<0> before each C<s///>.
By selecting the prompt line (I<Your choice:>), one can save I<search & replace> instructions for later use.
If a I<search & replace> has altered the first row of the input data, a menu entry named C<RESTORE header row> is
offered.
=item Convert DateTime
Convert a I<DateTime> to another format or to seconds since the Unix epoch.
id | date_time id | date_time
bin/db-browser view on Meta::CPAN
the right side of operators. Places where extended values are available: C<WHERE>, C<HAVING>, C<SET> in update, and
C<WHEN>, C<THEN> and C<ELSE> in case expressions.
=item
Extended Arguments
If enabled, subqueries, functions and more (see the following list) are available for entering arguments in addition to
constants in the scalar and window functions.
This option can also be enabled later in the functions menu by selecting the prompt line.
=back
=head4 Column/Value/Argument Extensions
Not all of these extensions are available everywhere.
=over
=item Value
bin/db-browser view on Meta::CPAN
Selecting C<SQL> opens the subqueries menu.
See L<Subquery> for the different possibilities to enter a subquery or any other SQL text.
Entries beginning with SELECT or WITH followed by a space are automatically enclosed in parentheses.
=item Scalar Functions
Selecting C<scalar()> opens the menu, where the user can choose from a list of scalar functions.
Extended arguments for scalar functions can be temporarily enabled by selecting the prompt line (I<Scalar functions:>)
of the scalar function menu.
C<DATEADD>, C<EXTRACT> and some other functions: use the keys C<Up-Arrow> and C<Down-Arrow> to choose one of the
predefined fields (in C<Value> if the extended arguments are enabled).
C<TO_EPOCH> and C<Oracle>: The argument I<Column type> can be any of the following: I<DATE>, I<TIMESTAMP> or
I<TIMESTAMP_TZ>. If the column type is I<DATE> or I<TIMESTAMP> the session timezone is used as timezone.
Scalar functions may not work with the C<ODBC> plugin.
bin/db-browser view on Meta::CPAN
Auto Increment
Enabling I<Auto Increment> makes the 'auto-increment primary key' option available when creating a table.
=item
Data Type Guessing
When this option is enabled and a table is created, C<SQL::Type::Guess> is used to guess the data types. These data types
are then used as defaults when the user is prompted for data types.
=item
Encode data for type guessing
If enabled, the data passed to C<SQL::Type::Guess> is encoded.
The setting of this option can affect the size of C<max> in C<varchar(max)> if strings contain multibyte characters.
=back
lib/App/DBBrowser.pm view on Meta::CPAN
_quit => ' Quit',
_back => ' Back',
_continue => ' Continue',
_confirm => ' Confirm',
_reset => ' Reset',
s_back => '<<',
ok => '-OK-',
menu_addition => '%%',
info_thsd_sep => ',',
};
$info->{tc_default} = { hide_cursor => 0, clear_screen => 1, page => 2, keep => 8, undef => $info->{s_back}, prompt => 'Your choice:' }; ##
$info->{tcu_default} = { hide_cursor => 0, clear_screen => 1, page => 2, keep => 8, confirm => $info->{ok}, back => $info->{s_back} };
$info->{tf_default} = { hide_cursor => 2, clear_screen => 1, page => 2, keep => 8, auto_up => 1, skip_items => qr/^\s*\z/ };
$info->{tr_default} = { hide_cursor => 2, clear_screen => 1, page => 2, history => [ 0 .. 1000 ] };
$info->{lyt_h} = { order => 0, alignment => 2 };
$info->{lyt_v} = { undef => $info->{_back}, layout => 2 };
return bless { i => $info }, $class;
}
sub __init {
lib/App/DBBrowser.pm view on Meta::CPAN
if ( @$available_plugins == 1 ) {
$skipped_menus++;
$plugin = $available_plugins->[0];
print clear_screen();
}
else {
my $menu_plugins = [ undef, map( "- $_", @$available_plugins ) ];
# Choose
my $idx_plugin = $tc->choose(
$menu_plugins,
{ %{$sf->{i}{lyt_v}}, prompt => 'DB Plugin: ', index => 1, default => $old_idx_plugin,
undef => $sf->{i}{_quit} }
);
if ( defined $idx_plugin ) {
$plugin = $menu_plugins->[$idx_plugin];
}
if ( ! defined $plugin ) {
last PLUGIN;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx_plugin == $idx_plugin && ! $ENV{TC_RESET_AUTO_UP} ) {
lib/App/DBBrowser.pm view on Meta::CPAN
$skipped_menus++ if $skipped_menus == 1;
}
else {
my $back;
if ( $prefix ) {
$back = $skipped_menus ? $sf->{i}{_quit} : $sf->{i}{_back};
}
else {
$back = $skipped_menus ? $sf->{i}{quit} : $sf->{i}{back};
}
my $prompt = 'Choose Database:';
my $menu_db = [ undef, @databases ];
# Choose
my $idx_db = $tc->choose(
$menu_db,
{ %{$sf->{i}{lyt_v}}, prompt => $prompt, index => 1, default => $old_idx_db, undef => $back }
);
if ( defined $idx_db ) {
$db = $menu_db->[$idx_db];
}
if ( ! defined $db ) {
next PLUGIN if @$available_plugins > 1;
last PLUGIN;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx_db == $idx_db && ! $ENV{TC_RESET_AUTO_UP} ) {
lib/App/DBBrowser.pm view on Meta::CPAN
}
elsif ( ! @schemas ) {
# `$schema` remains undefined
}
elsif ( @schemas == 1 ) {
$schema = ( @$user_schemas, @$sys_schemas )[0]; # to preserve unstringified `undef`
$skipped_menus++ if $skipped_menus == 2;
}
else {
my $back = $skipped_menus == 2 ? $sf->{i}{_quit} : $sf->{i}{_back};
my $prompt = $db_string . ':';
my $menu_schema = [ undef, @schemas ];
# Choose
my $idx_sch = $tc->choose(
$menu_schema,
{ %{$sf->{i}{lyt_v}}, prompt => $prompt, index => 1, default => $old_idx_sch, undef => $back }
);
if ( defined $idx_sch ) {
$schema = $menu_schema->[$idx_sch];
}
if ( ! defined $schema ) {
$dbh->disconnect();
next DATABASE if @databases > 1;
next PLUGIN if @$available_plugins > 1;
last PLUGIN;
}
lib/App/DBBrowser.pm view on Meta::CPAN
$menu_table = [ @pre, map( "- $_", @$user_table_keys ) ];
}
push @$menu_table, $from_subquery if $sf->{o}{enable}{m_derived};
push @$menu_table, $from_cte if $sf->{o}{enable}{m_cte};
push @$menu_table, $from_join if $sf->{o}{enable}{join};
push @$menu_table, $from_union if $sf->{o}{enable}{union};
my $back = $skipped_menus == 3 ? $sf->{i}{_quit} : $sf->{i}{_back};
# Choose
my $idx_tbl = $tc->choose(
$menu_table,
{ %{$sf->{i}{lyt_v}}, prompt => '', index => 1, default => $old_idx_tbl, undef => $back }
);
if ( defined $idx_tbl ) {
$table_key = $menu_table->[$idx_tbl];
}
if ( ! defined $table_key ) {
$sf->{d}{cte_history} = [];
next SCHEMA if @schemas > 1;
$dbh->disconnect();
next DATABASE if @databases > 1;
next PLUGIN if @$available_plugins > 1;
lib/App/DBBrowser/Auxil.pm view on Meta::CPAN
}
sub print_error_message {
my ( $sf, $message, $info ) = @_;
utf8::decode( $message );
chomp( $message );
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
$tc->choose(
[ 'Press ENTER to continue' ],
{ prompt => $message, info => $info }
);
}
sub write_json {
my ( $sf, $file_fs, $ref ) = @_;
if ( ! defined $ref ) { ##
#open my $fh, '>', $file_fs or die "$file_fs: $!";
#print $fh;
#close $fh;
lib/App/DBBrowser/CreateDropAttach.pm view on Meta::CPAN
push @entries, $drop_table if $sf->{o}{enable}{drop_table};
push @entries, $create_view if $sf->{o}{enable}{create_view};
push @entries, $drop_view if $sf->{o}{enable}{drop_view};
if ( $sf->{i}{dbms} =~ /^(?:SQLite|DuckDB)\z/ ) {
push @entries, $attach_databases;
push @entries, $detach_databases;
}
if ( ! @entries ) {
return;
}
my $prompt = $sf->{d}{db_string};
my @pre = ( undef );
my $menu = [ @pre, @entries ];
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, prompt => $prompt, index => 1, default => $old_idx_cda, undef => ' <=' }
);
if ( ! defined $idx || ! defined $menu->[$idx] ) {
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx_cda == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
$old_idx_cda = 0;
next CREATE_DROP_ATTACH;
}
$old_idx_cda = $idx;
lib/App/DBBrowser/CreateDropAttach/AttachDB.pm view on Meta::CPAN
push @tmp_info, $sf->attach_stmt( $dbh, $attached_db->{$key}, $key );
}
push @tmp_info, '';
my @pre = ( undef );
my @choices = ( @{$sf->{d}{user_dbs}}, @{$sf->{d}{sys_dbs}} );
my $menu = [ @pre, @choices ];
my $info = join( "\n", @tmp_info );
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, prompt => "Add database:", info => $info,
undef => '<=', index => 1, default => $old_idx }
);
$ax->print_sql_info( $info );
if ( ! defined $idx || ! defined $menu->[$idx] ) {
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
$old_idx = 0;
next ATTACH;
lib/App/DBBrowser/CreateDropAttach/AttachDB.pm view on Meta::CPAN
my $plugin = $sf->{i}{plugin};
my $db = $sf->{d}{db};
my $attached_db;
if ( -f $file_fs ) {
my $h_ref = $ax->read_json( $file_fs ) // {};
$attached_db = $h_ref->{$plugin}{$db} // {};
}
if ( ! %$attached_db ) {
my $info = $sf->{d}{db_string};
my $prompt = 'No attached databases.';
$tc->choose(
[ undef ],
{ info => $info, prompt => $prompt, undef => '<<' }
);
return;
}
my $old_idx = 0;
DETACH: while ( 1 ) {
my $info = $sf->{d}{db_string};
my @choices;
my @aliases = ( sort keys %$attached_db );
for my $key ( @aliases ) {
push @choices, sprintf "%s (%s)", $key, $attached_db->{$key};
}
my $prompt = 'Detach database:';
my @pre = ( undef );
# Choose
my $idx = $tc->choose(
[ @pre, @choices ],
{ %{$sf->{i}{lyt_v}}, prompt => $prompt, info => $info, index => 1, undef => '<=', default => $old_idx }
);
$ax->print_sql_info( $info );
if ( ! $idx ) {
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
$old_idx = 0;
next DETACH;
}
$old_idx = $idx;
}
my $detached_alias = $aliases[$idx - @pre];
my $detached_db = delete $attached_db->{$detached_alias};
my $dbh = $sf->{d}{dbh};
$prompt = sprintf "DETACH DATABASE %s (%s)", $ax->quote_alias( $detached_alias ), $dbh->quote( $detached_db );
# Choose
my $confirm = $tc->choose(
[ undef, 'YES' ],
{ info => $info, prompt => $prompt, clear_screen => 1, undef => 'NO' }
);
$ax->print_sql_info( $info );
if ( ! defined $confirm ) {
$attached_db->{$detached_alias} = $detached_db;
next DETACH;
}
my $h_ref = $ax->read_json( $file_fs ) // {};
if ( %$attached_db ) {
$h_ref->{$plugin}{$db} = $attached_db;
}
lib/App/DBBrowser/CreateDropAttach/CreateTable.pm view on Meta::CPAN
if ( none { $sql->{table} eq $ax->qq_table( $sf->{d}{tables_info}{$_} ) } keys %{$sf->{d}{tables_info}} ) {
my $ok_create_view = $sf->__create( $sql, 'view' );
if ( ! defined $ok_create_view ) {
next SELECT_STMT;
}
elsif( ! $ok_create_view ) {
return;
}
return 1;
}
my $prompt = "$sql->{table} already exists.";
$info = $ax->get_sql_info( $sql );
my $chosen = $tc->choose(
[ undef, ' New name' ],
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => $prompt }
);
$ax->print_sql_info( $info );
if ( ! defined $chosen ) {
return;
}
next VIEW_NAME;
}
}
}
lib/App/DBBrowser/CreateDropAttach/CreateTable.pm view on Meta::CPAN
$sf->{d}{stmt_types} = [ 'Create_Table', 'Insert' ];
# first use of {stmt_types} in get_content/from_col_by_col
my $ok = $gc->get_content( $sql, $source, $goto_filter );
if ( ! $ok ) {
return;
}
if ( ! @{$sql->{insert_args}[0]} ) {
# Choose
$tc->choose(
[ 'No columns!' ],
{ prompt => 'Continue with ENTER', keep => 1 }
);
return;
}
my $tablename_default = '';
GET_TABLE_NAME: while ( 1 ) {
$tablename_default = $sf->__set_table_name( $sql, $source, $tablename_default, $count_table_name_loop ); # first time print_sql_info
if ( ! $tablename_default ) {
$count_table_name_loop = 0;
$goto_filter = 1;
lib/App/DBBrowser/CreateDropAttach/CreateTable.pm view on Meta::CPAN
EDIT_COLUMN_NAMES: while( 1 ) {
$column_names = $sf->__edit_column_names( $sql, $column_names ); # now quoted
if ( ! defined $column_names ) {
next AUTO_INCREMENT if $sf->{auto_increment};
next GET_COLUMN_NAMES;
}
if ( any { ! length } @{$sql->{ct_column_definitions}} ) {
# Choose
$tc->choose(
[ 'Column with no name!' ],
{ prompt => 'Continue with ENTER', keep => 1 }
);
next EDIT_COLUMN_NAMES;
}
my @duplicates = duplicates map { lc } @{$sql->{ct_column_definitions}};
# my @duplicates; ##
# if ( $sf->{o}{G}{quote_columns} ) {
# @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 ];
lib/App/DBBrowser/CreateDropAttach/CreateTable.pm view on Meta::CPAN
{ 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++;
}
}
lib/App/DBBrowser/CreateDropAttach/CreateTable.pm view on Meta::CPAN
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(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => '', index => 1, default => 1, undef => ' <=',
keep => scalar( @$menu ) }
);
$ax->print_sql_info( $info );
if ( ! defined $idx || ! defined $menu->[$idx] ) {
return;
}
my $header_row;
if ( $menu->[$idx] eq $hidden ) {
my $op = App::DBBrowser::Options->new( $sf->{i}, $sf->{o} );
my $op_rw = App::DBBrowser::Options::ReadWrite->new( $sf->{i}, $sf->{o} );
lib/App/DBBrowser/CreateDropAttach/CreateTable.pm view on Meta::CPAN
sub __autoincrement_column {
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 ( $no, $yes ) = ( '- NO ', '- YES' );
my $menu = [ undef, $yes, $no ];
my $info = $ax->get_sql_info( $sql );
# Choose
my $chosen = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => 'Add an AUTO INCREMENT column:', undef => ' <=',
keep => scalar( @$menu ) }
);
$ax->print_sql_info( $info );
if ( ! defined $chosen ) {
return;
}
elsif ( $chosen eq $no ) {
$sf->{auto_increment} = 0;
}
else {
lib/App/DBBrowser/CreateDropAttach/CreateTable.pm view on Meta::CPAN
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}};
lib/App/DBBrowser/CreateDropAttach/CreateTable.pm view on Meta::CPAN
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} . ' ' }
);
$ax->print_sql_info( $info );
if ( ! $filled_form ) {
return;
}
if ( $tbl_option_rows ) {
$sql->{ct_table_options} = [
grep { length } map { $_->[1] } splice @$filled_form, -$tbl_option_rows, $tbl_option_rows
];
lib/App/DBBrowser/CreateDropAttach/CreateTable.pm view on Meta::CPAN
return $data_types;
}
sub __create {
my ( $sf, $sql, $type ) = @_;
my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my ( $no, $yes ) = ( '- NO', '- YES' );
my $menu = [ undef, $yes, $no ]; ##
my $prompt = "Create $type $sql->{table}";
if ( @{$sql->{insert_args}} ) {
my $row_count = @{$sql->{insert_args}};
$prompt .= "\nInsert " . insert_sep( $row_count, $sf->{i}{info_thsd_sep} ) . " row";
if ( @{$sql->{insert_args}} > 1 ) {
$prompt .= "s";
}
}
my $info = $ax->get_sql_info( $sql );
# Choose
my $create_table_ok = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => $prompt, undef => ' <=', keep => scalar( @$menu ) }
);
$ax->print_sql_info( $info );
if ( ! defined $create_table_ok ) {
return;
}
if ( $create_table_ok eq $no ) {
return 0;
}
my $stmt = $ax->get_stmt( $sql, 'Create_' . ucfirst( $type ), 'prepare' );
# don't reset `$sql->{ct_column_definitions}` and `$sf->{d}{stmt_types}`:
# to get a consistent print_sql_info output in CommitSQL
# to avoid another confirmation prompt in CommitSQL
if ( ! eval { $sf->{d}{dbh}->do( $stmt ); 1 } ) {
$ax->print_error_message( $@ );
return;
};
return 1;
}
sub __insert_data {
my ( $sf, $sql ) = @_;
lib/App/DBBrowser/CreateDropAttach/DropTable.pm view on Meta::CPAN
}
sub __choose_drop_item {
my ( $sf, $type ) = @_;
my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my $tables = [ grep { $sf->{d}{tables_info}{$_}[3] eq uc $type } @{$sf->{d}{user_table_keys}} ];
if ( ! @$tables ) {
my $info = $sf->{d}{db_string};
my $prompt = sprintf 'No user %ss.', $type;
#my $prompt = sprintf 'No %ss.', $type;
$tc->choose(
[ undef ],
{ info => $info, prompt => $prompt, undef => '<<' }
);
return;
}
my $sql = {};
$ax->reset_sql( $sql );
my $prompt = $sf->{d}{db_string} . "\n" . 'Drop ' . $type;
# Choose
my $table = $tc->choose(
[ undef, map { "- $_" } sort @$tables ],
{ %{$sf->{i}{lyt_v}}, prompt => $prompt, undef => ' <=' }
);
if ( ! defined $table || ! length $table ) {
return;
}
$table =~ s/\-\s//;
my $drop_ok = $sf->__drop( $sql, $type, $table );
return $drop_ok;
}
lib/App/DBBrowser/CreateDropAttach/DropTable.pm view on Meta::CPAN
);
$ax->print_sql_info( $info );
if ( ! $ok ) {
return;
}
my $row_count;
if ( ! eval {
my $tbl = App::DBBrowser::Table->new( $sf->{i}, $sf->{o}, $sf->{d} );
my $all_arrayref = $tbl->select_statement_results( $sql );
$row_count = @$all_arrayref - 1;
my $prompt_pt = sprintf "The %s to be deleted:", $type;
my $tp = Term::TablePrint->new( $sf->{o}{table} );
if ( ! $sf->{o}{G}{warnings_table_print} ) {
local $SIG{__WARN__} = sub {};
$tp->print_table( $all_arrayref, { prompt => $prompt_pt, footer => " '" . $table . "' " } );
}
else {
$tp->print_table( $all_arrayref, { prompt => $prompt_pt, footer => " '" . $table . "' " } );
}
1; }
) {
$ax->print_error_message( $@ );
}
if ( $row_count ) {
chomp $info;
$info .= sprintf " (%s %s)\n", insert_sep( $row_count, $sf->{i}{info_thsd_sep} ), $row_count == 1 ? 'row' : 'rows';
}
my $prompt = $sf->{i}{confirm} . ':';
my ( $no, $yes ) = ( '- NO', '- YES' );
# Choose
my $choice = $tc->choose(
[ undef, $no, $yes ],
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => $prompt, undef => ' <=' }
);
$ax->print_sql_info( $info );
if ( ! defined $choice || $choice eq $no ) {
return;
}
my $stmt = $ax->get_stmt( $sql, $stmt_type, 'prepare' );
$sf->{d}{dbh}->do( $stmt ) or die "$stmt failed!";
return 1;
}
lib/App/DBBrowser/Credentials.pm view on Meta::CPAN
}
my $env_var = 'DBI_' . uc $key;
if ( length $sf->{o}{connect_data}{$key} ) {
return $sf->{o}{connect_data}{$key};
}
elsif ( $sf->{o}{connect_data}{"use_dbi_$key"} && exists $ENV{$env_var} ) {
return $ENV{$env_var}; #
}
else {
my $no_echo = $key =~ /^(?:host|port|user)\z/ ? 0 : 1;
my $prompt = ucfirst( $key ) . ': ';
my $tr = Term::Form::ReadLine->new( $sf->{i}{tr_default} );
# Readline
my $new = $tr->readline(
$prompt,
{ info => $show_sofar, no_echo => $no_echo, history => [] }
);
return $new;
}
}
1;
lib/App/DBBrowser/DB/Firebird.pm view on Meta::CPAN
elsif ( $choice eq $confirm ) {
if ( $changed ) {
$ax->write_json( $file_firebird_dbs, $databases );
}
return $databases;
}
elsif ( $choice eq $add ) {
my $tu = Term::Choose::Util->new( $sf->{i}{tcu_default} );
my $new = $tu->choose_a_file( {
info => $info,
prompt => 'Choose the database location:',
cs_label => 'Database: ',
prompt2 => 'Your choice:'
} );
if ( length $new ) {
$databases = [ uniq sort( @$databases, $new ) ];
$changed++;
}
}
elsif ( $choice eq $remove ) {
my $info = 'Remove database';
my @pre = ( undef );
my $idx = $tc->choose( [ @pre, @$databases ], { info => $info, index => 1, layout => 2 } );
lib/App/DBBrowser/DB/Oracle.pm view on Meta::CPAN
}
my $attr = $ax->clone_data( $sf->{o}{connect_attr} );
my $ask_if_sid = delete $attr->{AskIfSID};
my $dsn = "dbi:Oracle:";
if ( $host ) {
my $db_type;
my $sid = 'SID';
if ( $ask_if_sid ) {
$db_type = choose(
[ undef, 'Service_Name', $sid ],
{ info => $show_sofar . "\n", prompt => "DB Identifier Type:", undef => '<' }
);
if ( defined $db_type ) {
$show_sofar .= "\n" . 'Type: ' . $db_type;
}
}
if ( defined $db_type && $db_type eq $sid ) {
if ( $port ) {
$dsn .= "host=$host;port=$port;sid=$db";
}
else {
lib/App/DBBrowser/DB/SQLite.pm view on Meta::CPAN
my $dirs = $db_cache->{directories} // [ $sf->{i}{home_dir} ];
my $databases = $db_cache->{databases} // [];
if ( ! $sf->{i}{search} && @$databases ) {
return $databases;
}
while ( 1 ) {
my ( $ok, $change ) = ( '- Confirm', '- Change' );
# Choose
my $choice = $tc->choose(
[ undef, $ok, $change ],
{ %{$sf->{i}{lyt_v}}, prompt => 'Search databases in: ' . join( ', ', @$dirs ), info => 'SQLite' }
);
if ( ! defined $choice ) {
return $databases;
}
elsif ( $choice eq $change ) {
my $tu = Term::Choose::Util->new( $sf->{i}{tcu_default} );
#my $info = 'Curr: ' . join( ', ', @$dirs ); #
my $new_dirs = $tu->choose_directories( { confirm => $sf->{i}{_confirm}, back => $sf->{i}{_back} } );
if ( ! @{$new_dirs//[]} ) {
next;
lib/App/DBBrowser/DB/SQLite.pm view on Meta::CPAN
utf8::decode( $@ );
print $@;
}
},
no_chdir => 1,
},
$encoding->encode( $dir ) );
}
$tc->choose(
[ 'Press ENTER to continue' ],
{ prompt => 'Search finished.' }
);
}
else {
no warnings qw( File::Find );
my $file;
for my $dir ( @$dirs ) {
File::Find::find( {
wanted => sub {
#my $file_fs = $_;
return if ! -f $_;
lib/App/DBBrowser/From/Cte.pm view on Meta::CPAN
my $cte = {
full_name => $full_cte_name,
query => $query,
name => $cte_name,
};
$default_name = length $default_name ? '' : $full_cte_name;
my @table_keys = keys %{$sf->{d}{tables_info}};
my @cte_names = map { $_->{name} } @$ctes;
if ( any { $_ eq $cte_name } @table_keys, @cte_names ) {
my $type = ( grep { $_ eq $cte_name } @table_keys ) ? 'table' : 'CTE';
my $prompt = "A $type '$cte_name' already exists.";
# Choose
$tc->choose(
[ 'Press ENTER' ],
{ %{$sf->{i}{lyt_h}}, info => $info, prompt => $prompt }
);
$ax->print_sql_info( $info );
next NAME;
}
else {
if ( $cte->{full_name} =~ s/^\s*RECURSIVE\s+//i ) {
$cte->{is_recursive} = 1;
}
push @$ctes, $cte;
$sf->{d}{cte_history} = [ @$ctes ];
lib/App/DBBrowser/From/Cte.pm view on Meta::CPAN
REMOVE_CTE: while ( 1 ) {
$sf->{d}{cte_history} = [ @$ctes ];
my @pre = ( undef, $confirm );
my $menu = [ @pre, map( '- ' . $_->{name}, @$ctes ) ];
push @$menu, $all;
my $info = $ax->get_sql_info( $sql );
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => 'Remove CTE:', index => 1, undef => $sf->{i}{_back} }
);
$ax->print_sql_info( $info );
if ( ! defined $idx || $idx == 0 ) {
if ( @bu ) {
$ctes = pop @bu;
next REMOVE_CTE;
}
return;
}
push @bu, [ @$ctes ];
lib/App/DBBrowser/From/Join.pm view on Meta::CPAN
};
my @choices = map { "- $_" } @$table_keys;
push @choices, $from_subquery if $sf->{o}{enable}{j_derived};
push @choices, $from_cte if $sf->{o}{enable}{j_cte};
push @choices, $join_info;
my @pre = ( undef );
my $menu = [ @pre, @choices ];
my $info = $ax->get_sql_info( $sql );
my $idx_master = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => 'The Main Table:', index => 1, default => $old_idx_master }
);
$ax->print_sql_info( $info );
if ( ! defined $idx_master || ! defined $menu->[$idx_master] ) {
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx_master == $idx_master && ! $ENV{TC_RESET_AUTO_UP} ) {
$old_idx_master = 0;
next MASTER;
}
lib/App/DBBrowser/From/Join.pm view on Meta::CPAN
JOIN_TYPE: while ( 1 ) {
my $enough_tables = $sf->{i}{_confirm};
my @pre = ( undef, $enough_tables );
my $avail_joins = $sf->__available_joins();
my $menu = [ @pre, map { "- $_" } map { s/\b(.)/uc $1/ger } map { lc } @$avail_joins ];
my $info = $ax->get_sql_info( $sql );
# Choose
my $idx_type = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => 'Choose Join Type:', index => 1, default => $old_idx_type }
);
$ax->print_sql_info( $info );
if ( ! defined $idx_type || ! defined $menu->[$idx_type] ) {
if ( @bu ) {
pop @{$sql->{join_data}};
$data = pop @bu;
next JOIN_TYPE;
}
next MASTER;
}
lib/App/DBBrowser/From/Join.pm view on Meta::CPAN
push @choices, $join_info;
my $old_idx_slave = 0;
SLAVE: while ( 1 ) {
my @pre = ( undef );
my $menu = [ @pre, @choices ];
my $info = $ax->get_sql_info( $sql );
# Choose
my $idx_slave = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => 'Add table:', index => 1,
default => $old_idx_slave, undef => $sf->{i}{_reset} }
);
$ax->print_sql_info( $info );
if ( ! defined $idx_slave || ! defined $menu->[$idx_slave] ) {
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx_slave == $idx_slave && ! $ENV{TC_RESET_AUTO_UP} ) {
$old_idx_slave = 0;
next SLAVE;
lib/App/DBBrowser/From/Subquery.pm view on Meta::CPAN
CHOOSE_QUERY: while ( 1 ) {
$sf->{from_build_SQ} = 0;
my $selected_stmt = $sf->__choose_query( $sql, 'subquery', $ext_info );
if ( ! defined $selected_stmt ) {
return;
}
if ( $sf->{from_build_SQ} && ! $sf->{o}{G}{edit_sql_menu_sq} ) {
$sf->{from_build_SQ} = 0;
return "($selected_stmt)";
}
my $prompt = 'Query: ';
my $info = $ext_info || $ax->get_sql_info( $sql );
# Readline
my $stmt = $tr->readline(
#'Query: ',
$prompt,
{ default => $selected_stmt, show_context => 1, info => $info }
);
$ax->print_sql_info( $info );
if ( ! length $stmt ) {
next CHOOSE_QUERY;
}
unshift @{$sf->{d}{subquery_history}}, $stmt;
if ( $stmt =~ /^\s*(?:SELECT|WITH)\s/i ) {
# A statement entered with readline could have a WITH clause.
return "($stmt)";
lib/App/DBBrowser/From/Subquery.pm view on Meta::CPAN
my @pre = ( $edit_sq_history_file, undef, $build_SQ, $readline );
my $old_idx = 1;
SUBQUERY: while ( 1 ) {
my @queries = $sf->__get_queries( $saved_subqueries, $subquery_history, $print_history );
my $menu = [ @pre, @queries ];
my $info = $ext_info || $ax->get_sql_info( $sql );
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => '', index => 1, default => $old_idx, undef => '<=' }
);
$ax->print_sql_info( $info );
if ( ! defined $idx || ! defined $menu->[$idx] ) {
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
$old_idx = 1;
next SUBQUERY;
}
lib/App/DBBrowser/From/Subquery.pm view on Meta::CPAN
), @$added_sq ); #
}
push @tmp_info, ' ';
my $menu = [ @pre ];
push @$menu, map { $pf_subquery_history . $_ } @$subquery_history;
push @$menu, map { $pf_print_history . $_ } @$print_history;
my $info = join( "\n", @tmp_info );
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, prompt => 'Add:', info => $info, index => 1 }
);
$ax->print_sql_info( $info );
if ( ! $idx ) {
if ( @bu ) {
$added_sq = pop @bu;
next;
}
return;
}
elsif ( $menu->[$idx] eq $confirm ) {
lib/App/DBBrowser/From/Subquery.pm view on Meta::CPAN
sub __edit_subqueries {
my ( $sf, $saved_subqueries ) = @_;
if ( ! @$saved_subqueries ) {
return;
}
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my @pre = ( undef );
my $info = $sf->{d}{db_string};
my $prompt = 'Edit Subquery:';
my $menu = [ @pre, map { $pf_saved_subqueries . $_->{name} } @$saved_subqueries ];
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => $prompt, index => 1, undef => ' <=' }
);
if ( ! $idx ) {
return;
}
$idx -= @pre;
my @tmp_info = ( $info, $prompt, '' );
$info = join( "\n", @tmp_info );
my $tr = Term::Form::ReadLine->new( $sf->{i}{tr_default} );
# Readline
my $stmt = $tr->readline(
'Stmt: ',
{ info => $info, default => $saved_subqueries->[$idx]{stmt}, show_context => 1, clear_screen => 1,
history => [] }
);
if ( ! length $stmt ) {
return;
lib/App/DBBrowser/From/Subquery.pm view on Meta::CPAN
sub __remove_subqueries {
my ( $sf, $saved_subqueries ) = @_;
if ( ! @$saved_subqueries ) {
return;
}
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my $old_idx = 0;
REMOVE: while ( 1 ) {
my $info = $sf->{d}{db_string};
my $prompt = 'Remove subquery:';
my @pre = ( undef );
my $menu = [ @pre, map { $pf_saved_subqueries . $_->{name} } @$saved_subqueries ];
my $idx = $tc->choose(
$menu,
{ info => $info, prompt => $prompt, undef => ' <=', layout => 2, index => 1, default => $old_idx }
);
if ( ! $idx ) {
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
$old_idx = 0;
next REMOVE;
}
$old_idx = $idx;
}
$idx -= @pre;
my @tmp_prompt = ( '' );
push @tmp_prompt, line_fold(
'Name: ' . $saved_subqueries->[$idx]{name}, { init_tab => '', subseq_tab => ' ' x length( 'Name: ' ) }
);
push @tmp_prompt, line_fold(
'Stmt: ' . $saved_subqueries->[$idx]{stmt}, { init_tab => '', subseq_tab => ' ' x length( 'Stmt: ' ) }
);
push @tmp_prompt, '', $prompt;
my $ok = $tc->choose(
[ undef, 'YES' ],
{ info => $info, prompt => join( "\n", @tmp_prompt ), undef => 'NO' }
);
if ( ! defined $ok ) {
next REMOVE;
}
else {
splice @$saved_subqueries, $idx, 1;
return 1;
}
}
}
lib/App/DBBrowser/From/Subquery.pm view on Meta::CPAN
$menu_table = [ @pre, map( $pf . $_, @$user_table_keys ), map( $sys_prefix . $_, @$sys_table_keys ) ];
}
else {
$menu_table = [ @pre, map( $pf . $_, @$user_table_keys ) ];
}
push @$menu_table, $from_subquery if $sf->{o}{enable}{m_derived};
push @$menu_table, $from_cte if $sf->{o}{enable}{m_cte};
push @$menu_table, $from_join if $sf->{o}{enable}{join};
push @$menu_table, $from_union if $sf->{o}{enable}{union};
my $info = $sf->{d}{main_info};
my $prompt = ( $caller eq 'cte' ? 'CTE statement table:' : 'Subquery table:' );
# Choose
my $idx_tbl = $tc->choose(
$menu_table,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => $prompt, index => 1, default => $old_idx_tbl, undef => '<=' }
);
if ( defined $idx_tbl ) {
$table_key = $menu_table->[$idx_tbl];
}
if ( ! defined $table_key ) {
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx_tbl == $idx_tbl && ! $ENV{TC_RESET_AUTO_UP} ) {
$old_idx_tbl = 0;
lib/App/DBBrowser/From/Subquery.pm view on Meta::CPAN
}
require App::DBBrowser::From; ##
my $fr = App::DBBrowser::From->new( $sf->{i}, $sf->{o}, $sf->{d} );
my $sql = $fr->from_sql( $table_key =~ s/[-\ ]\ //r );
if ( ! defined $sql ) {
next TABLE;
}
$ax->print_sql_info( $ax->get_sql_info( $sql ) ); ##
require App::DBBrowser::Table; ##
my $tbl = App::DBBrowser::Table->new( $sf->{i}, $sf->{o}, $sf->{d} );
$prompt = ( $caller eq 'cte' ? 'CTE statement:' : 'Subquery:' );
my $statement = $tbl->browse_the_table( $sql, $prompt );
if ( ! defined $statement ) {
next TABLE;
}
return $statement;
}
}
1;
lib/App/DBBrowser/From/Union.pm view on Meta::CPAN
}
}
my $old_idx = 0;
OPERATOR: while ( 1 ) {
$sql->{subselect_stmts} = $sf->__get_sub_select_stmts( $data );
my $info = $ax->get_sql_info( $sql );
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, prompt => 'Your choice:', info => $info, index => 1, default => $old_idx }
);
$ax->print_sql_info( $info );
if ( ! defined $idx || ! defined $menu->[$idx] ) {
if ( @$data ) {
$old_idx = 0;
pop @$data;
if ( @$data ) { #
delete $data->[-1]{operator}; #
next OPERATOR; #
} #
lib/App/DBBrowser/From/Union.pm view on Meta::CPAN
push @post, $from_subquery if $sf->{o}{enable}{u_derived};
push @post, $from_cte if $sf->{o}{enable}{u_cte};
my $table_keys;
if ( $sf->{o}{G}{metadata} ) {
$table_keys = [ @{$sf->{d}{user_table_keys}}, @{$sf->{d}{sys_table_keys}} ];
}
else {
$table_keys = [ @{$sf->{d}{user_table_keys}} ];
}
my $menu = [ @pre, map( '- ' . $_, @$table_keys ), @post ];
my $prompt = @$data ? 'Add a table:' : 'Choose the first table:';
my $old_idx_tbl = 0;
TABLE: while ( 1 ) {
$sql->{subselect_stmts} = $sf->__get_sub_select_stmts( $data );
my $info = $ax->get_sql_info( $sql );
# Choose
my $idx_tbl = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => $prompt, index => 1, default => $old_idx_tbl }
);
$ax->print_sql_info( $info );
if ( ! defined $idx_tbl || ! defined $menu->[$idx_tbl] ) {
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx_tbl == $idx_tbl && ! $ENV{TC_RESET_AUTO_UP} ) {
$old_idx_tbl = 0;
next TABLE;
}
lib/App/DBBrowser/From/Union.pm view on Meta::CPAN
my ( $sf, $sql, $data ) = @_;
my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my $old_idx_tbl = 0;
my @bu;
TABLE: while ( 1 ) {
my $confirm = $sf->{i}{_confirm};
my @pre = ( undef, $confirm );
my $menu = [ @pre, map { '- ' . $_->{table_key} } @$data ];
my $prompt = 'Table:';
$sql->{subselect_stmts} = $sf->__get_sub_select_stmts( $data );
my $info = $ax->get_sql_info( $sql );
# Choose
my $idx_tbl = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => $prompt, index => 1, default => $old_idx_tbl,
undef => $sf->{i}{_back} }
);
$ax->print_sql_info( $info );
if ( ! defined $idx_tbl || ! defined $menu->[$idx_tbl] ) {
if ( @bu ) {
my $bu_data = pop @bu;
for my $i ( 0 .. $#$bu_data ) {
$data->[$i] = { %{$bu_data->[$i]} };
}
$old_idx_tbl = 0;
lib/App/DBBrowser/From/Union.pm view on Meta::CPAN
my ( $sf, $sql, $data ) = @_;
my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my @idx_changed_tables;
my $old_idx_tbl = 0;
TABLE: while ( 1 ) {
my @pre = ( undef, $sf->{i}{confirm} );
my $reset_all = ' Reset all';
my $menu = [ @pre, map('- ' . $_->{table_key}, @$data ) , $reset_all ];
my $prompt = 'Parentheses:';
$sql->{subselect_stmts} = $sf->__get_sub_select_stmts( $data );
my $info = $ax->get_sql_info( $sql );
# Choose
my $idx_tbl = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => $prompt, index => 1, default => $old_idx_tbl,
undef => $sf->{i}{back} }
);
$ax->print_sql_info( $info );
if ( ! defined $idx_tbl || ! defined $menu->[$idx_tbl] ) {
if ( @idx_changed_tables ) {
my $idx = pop @idx_changed_tables;
delete $data->[$idx]{parentheses_open};
delete $data->[$idx]{parentheses_close};
$old_idx_tbl = 0;
next TABLE;
lib/App/DBBrowser/From/Union.pm view on Meta::CPAN
}
elsif ( $menu->[$idx_tbl] eq $reset_all ) {
for my $d ( @$data ) {
delete $d->{parentheses_open};
delete $d->{parentheses_close};
}
$old_idx_tbl = 0;
next TABLE;
}
$idx_tbl -= @pre;
$prompt = 'Parentheses' . "\n" . ( '(' x ( $data->[$idx_tbl]{parentheses_open} // 0 ) );
$prompt .= $data->[$idx_tbl]{table_key} . ( ')' x ( $data->[$idx_tbl]{parentheses_close} // 0 ) ) . ':';
my $open = ' + (';
my $close = ' + )';
my $reset = ' Reset';
# Choose
my $p_type = $tc->choose(
[ undef, $open, $close, $reset ],
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => $prompt,
undef => ' <=' }
);
if ( ! defined $p_type ) {
next TABLE;
}
my $max_depth = 3;
if ( $p_type eq $open && ( $data->[$idx_tbl]{parentheses_open} // 0 ) < $max_depth ) {
$data->[$idx_tbl]{parentheses_open} += 1;
}
elsif ( $p_type eq $close && ( $data->[$idx_tbl]{parentheses_close} // 0 ) < $max_depth ) {
lib/App/DBBrowser/GetContent.pm view on Meta::CPAN
$source->{old_idx_menu} //= 0;
MENU: while ( 1 ) {
if ( $goto_filter ) {
# keep current source type
}
elsif ( $data_source_choice_idx =~ /^(?:0|1)\z/ ) {
$source->{source_type} = $choices[$data_source_choice_idx][0];
}
else {
my $prompt = 'Source type:';
my @pre = ( undef );
my $menu = [ @pre, map( $_->[1], @choices ) ];
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, prompt => $prompt, index => 1, default => $source->{old_idx_menu},
undef => ' <=' }
);
if ( ! defined $idx || ! defined $menu->[$idx] ) {
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $source->{old_idx_menu} == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
$source->{old_idx_menu} = 0;
next MENU;
}
lib/App/DBBrowser/GetContent.pm view on Meta::CPAN
return if $data_source_choice_idx =~ /^(?:0|1)\z/;
next MENU;
}
}
else{
$source->{dir} = $dirs->[0];
}
}
else {
my $dirs = $cs->__avail_directories();
my $prompt = 'Choose a Dir:';
my $new_search = ' NEW search';
my @pre = ( undef, $new_search );
my $menu = [ @pre, map( '- ' . $_, @$dirs ) ];
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, prompt => $prompt, index => 1, default => $source->{old_idx_dir}, undef => ' <=' }
);
if ( ! defined $idx || ! defined $menu->[$idx] ) {
return if $data_source_choice_idx =~ /^(?:0|1)\z/;
next MENU;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $source->{old_idx_dir} == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
$source->{old_idx_dir} = 0;
next DIR;
}
lib/App/DBBrowser/GetContent.pm view on Meta::CPAN
my $hidden = 'Choose a File:';
my @pre = ( $hidden, undef );
my $change_dir = ' Change dir';
if ( $sf->{o}{insert}{history_dirs} == 1 ) {
push @pre, $change_dir;
}
my $menu = [ @pre, map { ' ' . basename $_ } @$files_in_chosen_dir ]; #
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, prompt => '', index => 1, default => $source->{old_idx_file},
undef => ' <=' }
);
if ( ! defined $idx || ! defined $menu->[$idx] ) {
if ( $sf->{o}{insert}{history_dirs} == 1 ) {
return if $data_source_choice_idx =~ /^(?:0|1)\z/;
next MENU;
}
next DIR;
}
if ( $sf->{o}{G}{menu_memory} ) {
lib/App/DBBrowser/GetContent.pm view on Meta::CPAN
if ( $parse_ok && $parse_ok == -1 ) { # reparse
next PARSE;
}
}
if ( ! $parse_ok ) {
next FILE;
}
if ( ! @{$sql->{insert_args}} ) {
$tc->choose(
[ 'Press ENTER' ],
{ prompt => 'Empty File!' }
);
close $fh;
next FILE;
}
}
else {
SHEET: while ( 1 ) {
my $ok = $cp->parse_with_Spreadsheet_Read( $sql, $source, $source->{file_fs} );
if ( ! $ok ) {
next FILE;
}
if ( ! @{$sql->{insert_args}} || ! @{$sql->{insert_args}[0]} ) {
$tc->choose(
[ 'Press ENTER' ],
{ prompt => 'Empty Sheet!' }
);
next SHEET if $source->{saved_book};
next FILE;
}
last SHEET;
}
}
}
if ( ! $sf->{o}{insert}{enable_input_filter} ) {
return 1;
lib/App/DBBrowser/GetContent/Filter.pm view on Meta::CPAN
$reset, $s_and_replace, $convert_date, $skip,
$reparse, $remove_cell, $insert_cell, $skip,
$empty_to_null, $join_columns, $split_column, $append_col,
$cols_to_rows, $split_table, $merge_rows, $fill_up_rows,
];
my $max_cols = 4;
my $info = $sf->__get_filter_info( $sql );
# Choose
my $idx = $tc->choose(
$menu,
{ info => $info, prompt => 'Filter:', layout => 0, order => 0, max_cols => $max_cols, index => 1,
default => $old_idx, undef => $back, busy_string => $working }
);
$sf->__print_busy_string( $working );
if ( ! $idx ) {
$sql->{insert_args} = [];
delete $sf->{d}{fi};
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
lib/App/DBBrowser/GetContent/Filter.pm view on Meta::CPAN
my $aoa = $sql->{insert_args};
my @pre = ( undef, $sf->{i}{ok} );
my $stringified_rows = [];
$sf->__print_busy_string( $working );
{
no warnings 'uninitialized';
for my $i ( 0 .. $#$aoa ) {
push @$stringified_rows, join ',', @{$aoa->[$i]};
}
}
my $prompt = 'Choose rows:';
$sql->{insert_args} = []; # $sql->{insert_args} refers to a new empty array - this doesn't delete $aoa
while ( 1 ) {
my $info = $sf->__get_filter_info( $sql, $filter_str );
# Choose
my @idx = $tc->choose(
[ @pre, @$stringified_rows ],
{ %{$sf->{i}{lyt_v}}, prompt => $prompt, info => $info, meta_items => [ 0 .. $#pre ],
include_highlighted => 2, index => 1, undef => $sf->{i}{s_back}, busy_string => $working }
);
$sf->__print_busy_string( $working );
if ( ! $idx[0] ) {
$sql->{insert_args} = $aoa;
return;
}
if ( $idx[0] == $#pre ) {
shift @idx;
for my $i ( @idx ) {
lib/App/DBBrowser/GetContent/Filter.pm view on Meta::CPAN
next;
}
$sql->{insert_args} = $aoa;
return;
}
if ( $choice eq $confirm ) {
return 1;
}
}
my $info = $sf->__get_filter_info( $sql, $filter_str );
my $prompt = "Begin range:";
# Stop
my $idx_first_row = $sf->__choose_a_row_idx( $aoa, $info, $prompt, $working );
if ( ! defined $idx_first_row ) {
if ( @{$sql->{insert_args}} ) {
next;
}
$sql->{insert_args} = $aoa;
return;
}
push @{$sql->{insert_args}}, $aoa->[$idx_first_row]; # temporarily for the info output
$info = $sf->__get_filter_info( $sql, $filter_str );
pop @{$sql->{insert_args}};
$prompt = "End range:";
# Stop
my $idx_last_row = $sf->__choose_a_row_idx( [ @{$aoa}[$idx_first_row .. $#$aoa] ], $info, $prompt, $working );
if ( defined $idx_last_row ) {
push @last_indexes, $#{$sql->{insert_args}};
$idx_last_row += $idx_first_row;
push @{$sql->{insert_args}}, @{$aoa}[$idx_first_row .. $idx_last_row];
}
}
}
sub __row_groups {
lib/App/DBBrowser/GetContent/Filter.pm view on Meta::CPAN
my @choices_groups;
my $len = length insert_sep( scalar @{$group{$keys_sorted[0]}}, $sf->{i}{info_thsd_sep} );
for my $col_count ( @keys_sorted ) {
my $row_count = scalar @{$group{$col_count}};
my $row_str = $row_count == 1 ? 'row has ' : 'rows have';
my $col_str = $col_count == 1 ? 'column ' : 'columns';
push @choices_groups, sprintf ' %*s %s %2d %s',
$len, insert_sep( $row_count, $sf->{i}{info_thsd_sep} ), $row_str,
$col_count, $col_str;
}
my $prompt = 'Choose group:';
my $info = $sf->__get_filter_info( $sql, $filter_str );
# Choose
my $idxs = $tu->choose_a_subset(
\@choices_groups,
{ info => $info, prompt => $prompt, layout => 2, index => 1, all_by_default => 1,
cs_label => "Chosen groups:\n", cs_separator => "\n", cs_end => "\n", busy_string => $working }
);
$sf->__print_busy_string( $working );
if ( ! defined $idxs ) {
return;
}
else {
my $row_idxs = [];
for my $idx ( @$idxs ) {
push @$row_idxs, @{$group{ $keys_sorted[$idx] }};
lib/App/DBBrowser/GetContent/Filter.pm view on Meta::CPAN
return;
}
}
sub __remove_cell {
my ( $sf, $sql, $filter_str, $working ) = @_;
my $aoa = $sql->{insert_args};
while ( 1 ) {
my $prompt = "Choose row:";
my $info = $filter_str;
# Stop
my $row_idx = $sf->__choose_a_row_idx( $aoa, $info, $prompt, $working );
if ( ! defined $row_idx ) {
return;
}
$prompt = "Choose cell:";
$info = $sf->__get_filter_info( $sql, $filter_str );
# Stop
my $col_idx = $sf->__choose_a_column_idx( $aoa->[$row_idx], $info, $prompt );
if ( ! defined $col_idx ) {
next;
}
splice( @{$aoa->[$row_idx]}, $col_idx, 1 );
$sql->{insert_args} = $aoa;
return;
}
}
sub _stringify_row { # used only once
lib/App/DBBrowser/GetContent/Filter.pm view on Meta::CPAN
return $stringified_row;
}
sub __insert_cell {
my ( $sf, $sql, $filter_str, $working ) = @_;
my $tr = Term::Form::ReadLine->new( $sf->{i}{tr_default} );
my $aoa = $sql->{insert_args};
while ( 1 ) {
my $prompt = "Choose row:";
my $info = $filter_str;
# Stop
my $row_idx = $sf->__choose_a_row_idx( $aoa, $info, $prompt, $working );
if ( ! defined $row_idx ) {
return;
}
my $cols = [ @{$aoa->[$row_idx]}, 'END_of_Row' ];
$prompt = "Insert cell before:";
$info = $sf->__get_filter_info( $sql, $filter_str );
# Stop
my $col_idx = $sf->__choose_a_column_idx( $cols, $info, $prompt );
if ( ! defined $col_idx ) {
next;
}
my @row = @{$aoa->[$row_idx]};
splice( @row, $col_idx, 0, '<*>' );
my $str_row_with_placeholder = _stringify_row( \@row );
$str_row_with_placeholder =~ s/"<\*>"/<*>/;
my $label = 'Row: ';
my @tmp_info = ( $filter_str );
push @tmp_info, line_fold(
$label . $str_row_with_placeholder, { subseq_tab => ' ' x length $label, join => 0 }
);
$prompt = "<*>: ";
$info = $sf->__get_filter_info( $sql, join( "\n", @tmp_info ) );
# Readline
my $cell = $tr->readline(
$prompt,
{ info => $info, history => [] }
);
$sf->__print_busy_string( $working );
splice( @{$aoa->[$row_idx]}, $col_idx, 0, $cell );
$sql->{insert_args} = $aoa;
return;
}
}
sub __fill_up_rows {
my ( $sf, $sql, $filter_str, $working ) = @_;
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my $aoa = $sql->{insert_args};
my $menu = [ undef, '- YES' ];
my $prompt = 'Fill up shorter rows?';
my $info = $sf->__get_filter_info( $sql, $filter_str );
# Choose
my $ok = $tc->choose(
$menu,
{ info => $info, prompt => $prompt, index => 1, undef => '- NO', layout => 2 }
);
$sf->__print_busy_string( $working );
if ( ! $ok ) {
return;
}
my $longest_row = 0;
for my $row ( @$aoa ) {
my $col_count = scalar @$row;
if ( $col_count > $longest_row ) {
$longest_row = $col_count;
lib/App/DBBrowser/GetContent/Filter.pm view on Meta::CPAN
$sql->{insert_args} = $aoa;
return;
}
sub __append_col {
my ( $sf, $sql, $filter_str, $working ) = @_;
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my $aoa = $sql->{insert_args};
my $menu = [ undef, '- YES' ];
my $prompt = 'Append an empty column?';
my $info = $sf->__get_filter_info( $sql, $filter_str );
# Choose
my $ok = $tc->choose(
$menu,
{ info => $info, prompt => $prompt, index => 1, undef => '- NO', layout => 2 }
);
$sf->__print_busy_string( $working );
if ( $ok ) {
my $new_last_idx = $#{$aoa->[0]} + 1;
for my $row ( @$aoa ) {
$#$row = $new_last_idx;
}
$sql->{insert_args} = $aoa;
}
return;
}
sub __split_column {
my ( $sf, $sql, $filter_str, $working ) = @_;
my $tf = Term::Form->new( $sf->{i}{tf_default} );
my $aoa = $sql->{insert_args};
my $is_empty = $sf->__search_empty_cols( $aoa );
my $header = $sf->__prepare_header( $aoa, $is_empty );
my $prompt = 'Choose column:';
my $info = $sf->__get_filter_info( $sql, $filter_str );
# Stop
my $idx = $sf->__choose_a_column_idx( $header, $info, $prompt );
if ( ! defined $idx ) {
return;
}
my $fields = [
[ 'Pattern', ],
[ 'Limit', ],
[ 'Left trim', '\s+' ],
[ 'Right trim', '\s+' ]
];
my $back = $sf->{i}{back} . ' ' x 3;
$prompt = "Split column \"$header->[$idx]\"";
$info = $sf->__get_filter_info( $sql, $filter_str );
# Fill_form
my $form = $tf->fill_form(
$fields,
{ info => $info, prompt => $prompt, confirm => $sf->{i}{confirm}, back => $back }
);
$sf->__print_busy_string( $working );
if ( ! $form ) {
return;
}
my ( $pattern, $limit, $left_trim, $right_trim ) = map { $_->[1] } @$form;
$pattern //= '';
for my $row ( @$aoa ) { # modifies $aoa
my $col = splice @$row, $idx, 1;
lib/App/DBBrowser/GetContent/Filter.pm view on Meta::CPAN
$col_count = $tu->choose_a_number(
$digits,
{ info => $info, cs_label => 'Number columns new table: ', small_first => 1,
confirm => $sf->{i}{confirm}, back => $sf->{i}{back} }
);
$sf->__print_busy_string( $working );
if ( ! $col_count ) {
return;
}
if ( @{$aoa->[0]} < $col_count ) {
my $prompt = sprintf 'Chosen number(%d) bigger than the available columns(%d)!', $col_count, scalar( @{$aoa->[0]} );
my $info = $sf->__get_filter_info( $sql, $filter_str );
$tc->choose(
[ 'Continue with ENTER' ],
{ info => $info, prompt => $prompt }
);
$sf->__print_busy_string( $working );
next CHOOSE_A_NUMBER;
}
if ( @{$aoa->[0]} % $col_count ) {
my $prompt = sprintf 'The number of available columns(%d) cannot be divided by the selected number(%d) without remainder!', scalar( @{$aoa->[0]} ), $col_count;
my $info = $sf->__get_filter_info( $sql, $filter_str );
$tc->choose(
[ 'Continue with ENTER' ],
{ info => $info, prompt => $prompt }
);
$sf->__print_busy_string( $working );
next CHOOSE_A_NUMBER;
}
last CHOOSE_A_NUMBER;
}
my $begin = 0;
my $end = $col_count - 1;
my $tmp = [];
lib/App/DBBrowser/GetContent/Filter.pm view on Meta::CPAN
@$stringified_rows = map {
my $str_row = join( ',', @$_ );
if ( print_columns( $str_row ) > $term_w ) {
$str_row = unicode_sprintf( $str_row, $term_w, { suffix_on_truncate => $sf->{i}{dots} } );
}
else {
$str_row;
}
} @$aoa;
}
my $prompt = 'Choose rows:';
my $info = $filter_str;
# Choose
my $chosen_idxs = $tu->choose_a_subset(
$stringified_rows,
{ cs_separator => "\n", cs_end => "\n", layout => 2, order => 0, all_by_default => 0, prompt => $prompt,
index => 1, info => $info, busy_string => $working }
);
$sf->__print_busy_string( $working );
if ( ! defined $chosen_idxs || ! @$chosen_idxs ) {
return;
}
my $merged = [];
for my $col ( 0 .. $#{$aoa->[$chosen_idxs->[0]]} ) {
my @tmp;
for my $row ( @$chosen_idxs ) {
next if ! defined $aoa->[$row][$col];
next if $aoa->[$row][$col] =~ /^\s*\z/;
$aoa->[$row][$col] =~ s/^\s+|\s+\z//g;
push @tmp, $aoa->[$row][$col];
}
$merged->[$col] = join ' ', @tmp;
}
$prompt = @$chosen_idxs == 1 ? 'Edit row cells:' : 'Edit cells of merged rows:';
my $col_number = 0;
my $fields = [ map { [ ++$col_number, defined $_ ? "$_" : '' ] } @$merged ];
$info = $sf->__get_filter_info( $sql, $filter_str );
# Fill_form
my $form = $tf->fill_form(
$fields,
{ info => $info, prompt => $prompt, confirm => $sf->{i}{confirm},
back => $sf->{i}{back} . ' ' }
);
$sf->__print_busy_string( $working );
if ( ! $form ) {
return;
}
$merged = [ map { $_->[1] } @$form ];
my $first_idx = shift @$chosen_idxs;
$aoa->[$first_idx] = $merged; # modifies $aoa
for my $idx ( sort { $b <=> $a } @$chosen_idxs ) {
lib/App/DBBrowser/GetContent/Filter.pm view on Meta::CPAN
# Choose
my $chosen_idxs = $tu->choose_a_subset(
$header,
{ cs_label => 'Cols: ', layout => 0, order => 0, index => 1, info => $info, busy_string => $working }
);
$sf->__print_busy_string( $working );
if ( ! defined $chosen_idxs || ! @$chosen_idxs ) {
return;
}
my $join_char = '';
my $prompt;
if ( @$chosen_idxs == 1 ) {
$prompt = 'Edit cells of ' . ( $aoa->[0][$chosen_idxs->[0]] // '--' ) . ':';
}
else {
$prompt = 'Edit cells of joined columns:';
my @tmp_info = ( $filter_str );
my $label = 'Cols: ';
push @tmp_info, line_fold(
$label . '"' . join( '", "', @{$header}[@$chosen_idxs] ) . '"',
{ subseq_tab => ' ' x length $label, join => 0 }
);
$info = $sf->__get_filter_info( $sql, join( "\n", @tmp_info ) );
# Readline
$join_char = $tr->readline(
'Join-string: ',
lib/App/DBBrowser/GetContent/Filter.pm view on Meta::CPAN
push @tmp, $aoa->[$row][$col];
}
$merged->[$row] = join $join_char, @tmp;
}
my $col_number = 0;
my $fields = [ map { [ ++$col_number, defined $_ ? "$_" : '' ] } @$merged ];
$info = $filter_str;
# Fill_form
my $form = $tf->fill_form(
$fields,
{ info => $info, prompt => $prompt, confirm => $sf->{i}{confirm},
back => $sf->{i}{back} . ' ' }
);
$sf->__print_busy_string( $working );
if ( ! $form ) {
$sql->{insert_args} = $aoa;
return;
}
$merged = [ map { $_->[1] } @$form ];
my $first_idx = shift @$chosen_idxs;
for my $row ( 0 .. $#{$aoa} ) { # modifies $aoa
lib/App/DBBrowser/GetContent/Filter.pm view on Meta::CPAN
$sql->{insert_args} = $aoa;
return;
}
sub __transpose_rows_to_cols {
my ( $sf, $sql, $filter_str, $working ) = @_;
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my $aoa = $sql->{insert_args};
my $menu = [ undef, '- YES' ];
my $prompt = 'Transpose columns to rows?';
my $info = $sf->__get_filter_info( $sql, $filter_str );
my $ok = $tc->choose(
$menu,
{ info => $info, prompt => $prompt, index => 1, undef => '- NO', layout => 2, busy_string => $working }
);
$sf->__print_busy_string( $working );
if ( $ok ) {
my $tmp_aoa = [];
for my $row ( 0 .. $#$aoa ) {
for my $col ( 0 .. $#{$aoa->[$row]} ) {
$tmp_aoa->[$col][$row] = $aoa->[$row][$col];
}
}
$sql->{insert_args} = $tmp_aoa;
lib/App/DBBrowser/GetContent/Filter.pm view on Meta::CPAN
else {
$header->[$col_idx] = 'tmp_' . ( $col_idx + 1 );
}
}
}
return $header;
}
sub __choose_a_column_idx {
my ( $sf, $columns, $info, $prompt ) = @_;
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my @pre = ( undef );
# Choose
my $col_idx = $tc->choose(
[ @pre, map( defined $_ ? $_ : '', @$columns ) ],
{ layout => 0, order => 0, index => 1, info => $info, prompt => $prompt, empty => '--' }
);
if ( ! $col_idx ) {
return;
}
return $col_idx - @pre;
}
sub __choose_a_row_idx {
my ( $sf, $aoa, $info, $prompt, $working ) = @_;
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my @stringified_rows;
{
no warnings 'uninitialized';
@stringified_rows = map { join ',', @$_ } @$aoa;
}
my @pre = ( undef );
# Choose
my $row_idx = $tc->choose(
[ @pre, @stringified_rows ],
{ layout => 2, index => 1, info => $info, prompt => $prompt, busy_string => $working }
);
$sf->__print_busy_string( $working );
if ( ! $row_idx ) {
return;
}
return $row_idx - @pre;
}
lib/App/DBBrowser/GetContent/Filter/ConvertDate.pm view on Meta::CPAN
$step = 1_000;
my $total = int $row_count / $step;
$fmt = $busy_text . $total . '/%' . length( $total ) . 'd';
}
}
my $is_empty = $cf->__search_empty_cols( $aoa );
my $header = $cf->__prepare_header( $aoa, $is_empty );
COL: while ( 1 ) {
my $info = $cf->__get_filter_info( $sql, $filter_str);
my $prompt = "Choose column:";
# Stop
my $col_idx = $cf->__choose_a_column_idx( $header, $info, $prompt );
if ( ! defined $col_idx ) {
return;
}
my $col = $header->[$col_idx];
my @col_info = ( $filter_str, 'Column: ' . $col );
$info = $cf->__get_filter_info( $sql, join( "\n", @col_info ) );
SKIP_HEADER: while ( 1 ) {
my @pre = ( undef );
my ( $no, $yes ) = ( 'NO', 'YES' );
my $row_idx_begin = 0;
if ( $sf->{d}{stmt_types}[0] eq 'Create_Table' ) {
# Choose
my $choice = $tc->choose(
[ @pre, $yes, $no ],
{ prompt => 'Skip the first row?', undef => $sf->{i}{s_back}, info => $info }
);
if ( ! defined $choice ) {
next COL;
}
$row_idx_begin = 1 if $choice eq $yes;
}
my $count_error_in = 0;
my $default_pattern_in;
IN: while ( 1 ) {
my @in_info = @col_info;
$info = $cf->__get_filter_info( $sql, join( "\n", @in_info ) );
my $prompt_patter_in = 'Pattern in: ';
# Readline
my $pattern_in = $tr->readline(
$prompt_patter_in,
{ info => $info, default => $default_pattern_in, history => $sf->__pattern_history( 'in' ) }
);
if ( ! length $pattern_in ) {
next SKIP_HEADER if $sf->{d}{stmt_types}[0] eq 'Create_Table';
next COL;
}
$default_pattern_in = $count_error_in > 1 ? '' : $pattern_in;
push @in_info, $prompt_patter_in . $pattern_in;
my $formatter_args = { pattern => $pattern_in };
if ( $pattern_in =~ /$rx_locale_dependent/ ) {
$info = $cf->__get_filter_info( $sql, join( "\n", @in_info ) );
my $prompt_locale_in = 'Locale in: ';
# Readline
my $locale_in = $tr->readline(
$prompt_locale_in,
{ info => $info, history => [] }
);
if ( length $locale_in ) {
$formatter_args->{locale} = $locale_in;
push @in_info, $prompt_locale_in . $locale_in;
}
}
my $formatter = DateTime::Format::Strptime->new( %$formatter_args, on_error => 'undef' );
TYPE: while ( 1 ) {
$info = $cf->__get_filter_info( $sql, join( "\n", @in_info ) );
my ( $format, $epoch ) = ( '- DateTime', '- Epoch' );
# Choose
my $choice = $tc->choose(
[ @pre, $format, $epoch ],
{ %{$sf->{i}{lyt_v}}, prompt => 'To: ', undef => $sf->{i}{s_back}, info => $info }
);
if ( ! defined $choice ) {
++$count_error_in;
next IN;
}
my $count_error_out = 0;
my $default_pattern_out;
OUT: while ( 1 ) {
my @tmp_info = @in_info;
lib/App/DBBrowser/GetContent/Filter/ConvertDate.pm view on Meta::CPAN
}
1 }
) {
$ax->print_error_message( $@ );
++$count_error_in;
next IN;
}
}
else {
$info = $cf->__get_filter_info( $sql, join( "\n", @tmp_info ) );
my $prompt_pattern_out = 'Pattern out: ';
# Readline
my $pattern_out = $tr->readline(
$prompt_pattern_out,
{ info => $info, default => $default_pattern_out, history => $sf->__pattern_history( 'out' ) }
);
if ( ! length $pattern_out ) {
next TYPE;
}
$default_pattern_out = $count_error_out > 1 ? '' : $pattern_out;
my $locale_out;
if ( $pattern_out =~ /$rx_locale_dependent/ ) {
push @tmp_info, $prompt_pattern_out . $pattern_out;
$info = $cf->__get_filter_info( $sql, join( "\n", @tmp_info ) );
my $prompt_locale_out = 'Locale out: ';
# ReadLine
$locale_out = $tr->readline(
$prompt_locale_out,
{ info => $info, history => [] }
);
if ( length $locale_out ) {
push @tmp_info, $prompt_locale_out . $locale_out;
}
}
$cf->__print_busy_string( $working );
if ( ! eval {
for my $row ( $row_idx_begin .. $#$aoa ) {
next if ! length $aoa->[$row][$col_idx];
my $dt = $formatter->parse_datetime( $aoa->[$row][$col_idx] );
if ( ! defined $dt ) {
for my $row ( 1 .. $row ) {
$aoa->[$row][$col_idx] = $bu_insert_args->[$row][$col_idx];
lib/App/DBBrowser/GetContent/Filter/SearchAndReplace.pm view on Meta::CPAN
}
else {
push @$prefixed_available, '- ' . $name;
}
}
my $menu = [ @pre, @$prefixed_available ];
my $info = $cf->__get_filter_info( $sql, join( "\n", @tmp_info ) );
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => '', default => $old_idx, index => 1, undef => $sf->{i}{_back} }
);
if ( ! defined $idx || ! defined $menu->[$idx] ) {
if ( @bu ) {
( $used_names, $all_sr_groups ) = @{pop @bu};
next ADD_SEARCH_AND_REPLACE;
}
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
lib/App/DBBrowser/GetContent/Filter/SearchAndReplace.pm view on Meta::CPAN
}
}
if ( $header_changed ) {
my ( $yes, $no ) = ( '- YES', '- NO' );
my $menu = [ undef, $yes, $no ];
my @tmp_info_addition = ( 'Header: ' . join( ', ', map { $_ // '' } @{$sql->{insert_args}[0]} ), ' ' );
$info = $cf->__get_filter_info( $sql, join( "\n", @tmp_info, @tmp_info_addition ) );
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => 'Restore header?', index => 1, undef => $sf->{i}{s_back} }
);
if ( ! defined $idx || ! defined $menu->[$idx] ) {
if ( @$aoa * @$col_idxs > 500_000 ) {
$cf->__print_busy_string( 'Working ...' );
}
$sql->{insert_args} = [ map { [ @$_ ] } @{$bu_insert_args} ];
return;
}
my $choice = $menu->[$idx];
if ( $choice eq $yes ) {
$sql->{insert_args}[0] = $header;
}
}
return 1;
}
elsif ( $choice eq $add ) {
my $prompt = 'Build s///;';
my $skip = ' ';
my $fields = [];
for my $nr ( 1 .. 5 ) {
push @$fields,
[ $skip ],
[ $nr . ' Pattern', ],
[ $nr . ' Replacement', ],
[ $nr . ' Modifiers', ];
}
my $back = $sf->{i}{back} . ' ';
SUBSTITUTION: while ( 1 ) {
$info = $cf->__get_filter_info( $sql, join( "\n", @tmp_info ) );
# Fill_form
my $form = $tf->fill_form(
$fields,
{ info => $info, prompt => $prompt, confirm => $sf->{i}{confirm}, back => $back }
);
if ( ! defined $form ) {
next ADD_SEARCH_AND_REPLACE;
}
my $sr_group = [ $sf->__from_form_to_sr_group_data( $form ) ];
if ( ! @$sr_group ) {
next ADD_SEARCH_AND_REPLACE;
}
if ( ! eval {
$sf->__execute_substitutions( [ [ 'test_string' ] ], [ 0 ], [ $sr_group ] );
lib/App/DBBrowser/GetContent/Filter/SearchAndReplace.pm view on Meta::CPAN
my ( $section_separator, $pattern, $replacement, $modifiers ) = map { $_->[1] // '' } splice @copy, 0, 4;
if ( length $pattern ) {
push @sr_group_data, { pattern => $pattern, replacement => $replacement, modifiers => $modifiers };
}
}
return @sr_group_data;
}
sub __choose_column_indexes {
my ( $sf, $columns, $info, $prompt ) = @_;
my $tu = Term::Choose::Util->new( $sf->{i}{tcu_default} );
# Choose
my $col_idxs = $tu->choose_a_subset(
$columns,
{ cs_label => $prompt, info => $info, layout => 0, all_by_default => 1, index => 1, keep_chosen => 0 }
);
if ( ! defined $col_idxs ) {
return;
}
return $col_idxs;
}
sub __execute_substitutions {
my ( $sf, $aoa, $col_idxs, $all_sr_groups ) = @_;
lib/App/DBBrowser/GetContent/Filter/SearchAndReplace.pm view on Meta::CPAN
my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
my $skip = ' ';
my $fields = [];
for my $nr ( 1 .. 9 ) {
push @$fields,
[ $skip ],
[ $nr . ' Pattern', ],
[ $nr . ' Replacement', ],
[ $nr . ' Modifiers', ];
}
my $prompt = 'Add "search & replace":';
ADD_CODE: while ( 1 ) {
# Fill_form
my $form = $tf->fill_form(
$fields,
{ prompt => $prompt, confirm => $sf->{i}{_confirm}, back => $sf->{i}{_back} . ' ' }
);
if ( ! defined $form ) {
return;
}
my $sr_group = [ $sf->__from_form_to_sr_group_data( $form ) ];
if ( ! @$sr_group ) {
return;
}
if ( ! eval {
$sf->__execute_substitutions( [ [ 'test_string' ] ], [ 0 ], [ $sr_group ] );
1 }
) {
$ax->print_error_message( $@ );
$fields = $form;
next ADD_CODE;
}
my @code = _stringified_sr_group( $sr_group );
my $info = join "\n", map { ( ' ' x 6 ) . $_ } @code;
$info =~ s/^\s{5}/Code:/;
$info = $prompt . "\n\n" . $info;
my $name = $sf->__get_new_name( $info, 'Name: ', $saved, $sr_group );
if ( ! length $name ) {
$fields = $form;
next ADD_CODE;
}
$saved->{$name} = [ @$sr_group ];
return 1;
}
}
sub __get_new_name {
my ( $sf, $info, $prompt, $saved, $sr_group ) = @_;
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my $tr = Term::Form::ReadLine->new( $sf->{i}{tr_default} );
my $name_default = '';
if ( @$sr_group == 1 ) {
$name_default = ( _stringified_sr_group( $sr_group ) )[0];
}
my $count = 1;
NAME: while ( 1 ) {
# Readline
my $new_name = $tr->readline(
$prompt,
{ info => $info, default => $name_default, history => [] }
);
if ( ! length $new_name ) {
return;
}
if ( any { $new_name eq $_ } keys %$saved ) {
my $prompt = "\"$new_name\" already exists.";
my $choice = $tc->choose(
[ undef, ' New name' ],
{ %{$sf->{i}{lyt_v}}, prompt => $prompt, info => $info }
);
if ( ! defined $choice ) {
return;
}
if ( $count > 1 ) {
$new_name = undef;
}
$name_default = $new_name;
$count++;
next NAME;
lib/App/DBBrowser/GetContent/Filter/SearchAndReplace.pm view on Meta::CPAN
}
sub __edit_saved {
my ( $sf, $saved ) = @_;
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my $tf = Term::Form->new( $sf->{i}{tf_default} );
my $tr = Term::Form::ReadLine->new( $sf->{i}{tr_default} );
my @pre = ( undef );
my $menu = [ @pre, map( '- ' . $_, sort { $a cmp $b } keys %$saved ) ];
my $prompt = 'Edit "search & replace":';
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, prompt => $prompt, index => 1, undef => ' <=' }
);
if ( ! defined $idx || ! defined $menu->[$idx] ) {
return;
}
my $name = $menu->[$idx] =~ s/^- //r;
my $skip = ' ';
my $sr_group = $saved->{$name};
my $fields = [
[ $skip ],
[ ' Pattern', ],
lib/App/DBBrowser/GetContent/Filter/SearchAndReplace.pm view on Meta::CPAN
push @$fields,
[ $skip ],
[ $c . ' Pattern', $sr_single->{pattern} ],
[ $c . ' Replacement', $sr_single->{replacement} ],
[ $c . ' Modifiers', $sr_single->{modifiers} ],
[ $skip ],
[ ' Pattern', ],
[ ' Replacement', ],
[ ' Modifiers', ];
}
my $info_fmt = "$prompt\n\nName: \"%s\"\nCode: %s\n";
my $code_str = join "\n" . ( ' ' x 6 ), _stringified_sr_group( $sr_group );
my $info = sprintf $info_fmt, $name, $code_str;
# Readline
my $new_name = $tr->readline(
'Confirm name: ',
{ info => $info, default => $name, history => [] }
);
if ( ! length $new_name ) {
return;
}
my $old_code_str = join "\n" . ( ' ' x 6 ), _stringified_sr_group( $sr_group );
$info = sprintf $info_fmt, $new_name, $old_code_str;
# Fill_form
my $form = $tf->fill_form(
$fields,
{ prompt => "Edit \"$new_name\":", info => $info, confirm => $sf->{i}{_confirm},
back => $sf->{i}{_back} . ' ' }
);
if ( ! defined $form ) {
return;
}
my $new_sr_group = [ $sf->__from_form_to_sr_group_data( $form ) ];
if ( ! @$new_sr_group ) {
return;
}
if ( $new_name ne $name ) {
lib/App/DBBrowser/GetContent/Filter/SearchAndReplace.pm view on Meta::CPAN
}
$saved->{$new_name} = [ @$new_sr_group ];
return 1;
}
sub __remove_saved {
my ( $sf, $saved ) = @_;
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my @pre = ( undef );
my $prompt = 'Remove "search & replace":';
my $menu = [ @pre, map { '- ' . $_ } sort { $a cmp $b } keys %$saved ];
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, index => 1, undef => ' <=', prompt => $prompt }
);
if ( ! defined $idx || ! defined $menu->[$idx] ) {
return;
}
my $name = $menu->[$idx] =~ s/^- //r;
my $sr_group = $saved->{$name};
my $code_str = join "\n" . ( ' ' x 6 ), _stringified_sr_group( $sr_group );
my $info_fmt = "$prompt\n\nName: \"%s\"\nCode: %s\n";
my $info = sprintf $info_fmt, $name, $code_str;
my ( $no, $yes ) = ( '- NO', '- YES' );
$menu = [ undef, $no, $yes ];
# Choose
$idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, prompt => "Remove \"$name\"?", index => 1, undef => ' <=', info => $info }
);
if ( ! defined $idx || ! defined $menu->[$idx] ) {
return;
}
elsif ( $menu->[$idx] eq $yes ) {
delete $saved->{$name};
return 1;
}
else {
return;
lib/App/DBBrowser/GetContent/Parse.pm view on Meta::CPAN
require Text::CSV_XS;
my $csv = Text::CSV_XS->new( $options ) or die Text::CSV_XS->error_diag();
$csv->callbacks( error => sub {
my ( $code, $str, $pos, $rec, $fld ) = @_;
if ( $code == 2012 ) {
# no warnings for end of data.
# 2012 "EOF - End of data in parsing input stream"
}
else {
my $error_input = $csv->error_input() // 'No Error Input defined.';
my $prompt = "Error Input:";
$error_input =~ s/\R/ /g;
my $info = "Close with ENTER\nText::CSV_XS\n$code $str\nrecord:$rec field:$fld position:$pos\n";
$tc->choose(
[ line_fold( $error_input, { join => 0 } ) ],
{ info => $info, prompt => $prompt }
);
$ax->print_sql_info( $info );
return;
}
} );
my $rows_of_cols = $csv->getline_all( $fh );
$sql->{insert_args} = $rows_of_cols;
return 1;
}
lib/App/DBBrowser/GetContent/Parse.pm view on Meta::CPAN
sub parse_with_template {
my ( $sf, $sql, $fh ) = @_;
my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
my $tf = Term::Form->new( $sf->{i}{tf_default} );
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my $old_idx = 0;
IRS: while ( 1 ) {
my $prompt = 'Choose the input record separator:';
my @irs = ( "\\n", "\\r", "\\r\\n" );
my $reparse = ' Reparse';
my @pre = ( undef );
my $menu = [ @pre, map( ' "' . $_ . '"', @irs ), $reparse ];
my $info = "Parse mode: Template\n";
# Choose
my $idx = $tc->choose(
$menu,
{ prompt => $prompt, index => 1, default => $old_idx, layout => 2, undef => ' <=', clear_screen => 1, info => $info }
);
$ax->print_sql_info( $info );
if ( ! $idx ) {
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
$old_idx = 0;
next IRS;
}
lib/App/DBBrowser/GetContent/Parse.pm view on Meta::CPAN
seek $fh, 0, 0;
my @rows = grep { ! /^\s+\z/ } <$fh>;
chomp @rows;
my $fields_set = [ [ 'Col count', ], [ 'Sep width', ], ];
SETTINGS: while ( 1 ) {
my $info = $sf->__print_template_info( \@rows, 7 + @$fields_set );
# Fill_form
my $form_set = $tf->fill_form(
$fields_set,
{ info => $info, prompt => 'Settings:', confirm => $sf->{i}{confirm}, back => $sf->{i}{back} . ' ' }
);
$ax->print_sql_info( $info );
if ( ! $form_set ) {
next IRS;
}
my $number_of_columns = $form_set->[0];
my $separator_width = $form_set->[1];
my $prompt;
if ( ! defined $number_of_columns->[1] || $number_of_columns->[1] !~ /^[1-9][0-9]*\z/ ) { ## defined
$prompt = "'$number_of_columns->[0]' requires a value of 1 or greater!";
}
if ( ! length $separator_width->[1] ) {
$separator_width->[1] = 0;
}
if ( $separator_width->[1] !~ /^(?:0|[1-9][0-9]*)\z/ ) {
$prompt = "'$separator_width->[0]' requires a value of 0 or greater!";
}
if ( $prompt ) {
my $info = $sf->__print_template_info( \@rows, 6 );
$tc->choose(
[ 'Press ENTER' ],
{ info => $info, prompt => $prompt }
);
$ax->print_sql_info( $info );
@$fields_set = @$form_set;
next SETTINGS;
}
my $col_count = $number_of_columns->[1];
my $col_sep_w = $separator_width->[1];
my $col_names = [ map { 'c' . $_ } 1 .. $col_count ];
my $fields = [ map { [ $_, ] } @$col_names ];
$fields->[-1][1] = '*';
COL_WIDTHS: while ( 1 ) {
my $info = $sf->__print_template_info( \@rows, 7 + $col_count );
my $prompt = 'Separator width: ' . $col_sep_w;
$prompt .= "\n". 'Column widths:';
# Fill_form
my $form = $tf->fill_form(
$fields,
{ info => $info, prompt => $prompt, confirm => $sf->{i}{_confirm}, back => $sf->{i}{_back} . ' ' }
);
$ax->print_sql_info( $info );
if ( ! $form ) {
@$fields_set = @$form_set;
next SETTINGS;
}
my @values;
for my $field ( @$form ) {
my ( $field_name, $field_value ) = @$field;
my ( $valid_regex, $error_message );
if ( $field_name eq $form->[-1][0] ) {
$valid_regex = qr/^(?:\*|[1-9][0-9]*)\z/;
$error_message = " requires * or a value of 1 or greater!";
}
else {
$valid_regex = qr/^[1-9][0-9]*\z/;
$error_message = " requires a value of 1 or greater!";
}
if ( ! defined $field_value || $field_value !~ $valid_regex ) { ## defined
$prompt = "'$field_name' " . $error_message;
my $info = $sf->__print_template_info( \@rows, 6 );
$tc->choose(
[ 'Press ENTER' ],
{ info => $info, prompt => $prompt, info => $info }
);
$ax->print_sql_info( $info );
@$fields = @$form;
next COL_WIDTHS;
}
push @values, $field_value;
}
$prompt = 'Remove leading spaces?';
my ( $no, $yes ) = ( '- NO', '- YES' );
$info = $sf->__print_template_info( \@rows, 8 );
# Choose
my $remove_leading_spaces = $tc->choose(
[ undef, $no, $yes ],
{ info => $info, prompt => $prompt, undef => $sf->{i}{_back}, layout => 2 }
);
$ax->print_sql_info( $info );
if ( ! defined $remove_leading_spaces ) {
next COL_WIDTHS;
}
my $template = join( 'x' x $col_sep_w, map { 'A' . $_ } @values );
my $rows_of_cols = [];
if ( ! eval {
seek $fh, 0, 0;
if ( $remove_leading_spaces eq $yes ) {
lib/App/DBBrowser/GetContent/Parse.pm view on Meta::CPAN
if ( ! defined $book ) {
if ( ! eval {
$book = Spreadsheet::Read::ReadData( $file_fs, cells => 0, attr => 0, rc => 1, strip => 0 );
1 }
) {
die "Spreadsheet::Read: $@";
}
if ( ! defined $book ) {
$tc->choose(
[ 'Press ENTER' ],
{ prompt => 'No Book in ' . decode( 'locale_fs', $file_fs ) . '!' }
);
return;
}
}
my $sheet_count = @$book - 1; # first sheet in $book contains meta info
if ( $sheet_count == 0 ) {
$tc->choose(
[ 'Press ENTER' ],
{ prompt => 'No Sheets in ' . decode( 'locale_fs', $file_fs ) . '!' }
);
return;
}
my $sheet_idx;
if ( $sheet_count == 1 ) {
$sheet_idx = 1;
}
else {
$source->{saved_book} = $book; # save book if more than one sheet
my @sheets = map { '- ' . ( length $book->[$_]{label} ? $book->[$_]{label} : 'sheet_' . $_ ) } 1 .. $#$book;
my @pre = ( undef );
my $menu = [ @pre, @sheets ];
SHEET: while ( 1 ) {
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, prompt => 'Choose a sheet', index => 1, default => $source->{old_idx_sheet},
undef => ' <=' }
);
if ( ! defined $idx || ! defined $menu->[$idx] ) {
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $source->{old_idx_sheet} == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
$source->{old_idx_sheet} = 0;
next SHEET;
}
$source->{old_idx_sheet} = $idx;
}
$sheet_idx = $idx - @pre + 1;
last SHEET;
}
}
# if ( $book->[$sheet_idx]{maxrow} == 0 ) { # works for some file formats; catch empty sheets later ##
# my $sheet = length $book->[$sheet_idx]{label} ? $book->[$sheet_idx]{label} : 'sheet_' . $_;
# $tc->choose(
# [ 'Press ENTER' ],
# { prompt => $sheet . ': Empty Sheet!' }
# );
# return 1;
# }
$sql->{insert_args} = [ Spreadsheet::Read::rows( $book->[$sheet_idx] ) ];
if ( ! -T $file_fs && length $book->[$sheet_idx]{label} ) {
$source->{sheet_name} = $book->[$sheet_idx]{label};
}
return 1;
}
lib/App/DBBrowser/GetContent/Source.pm view on Meta::CPAN
my $aoa = [];
my $col_names;
if ( $stmt_type eq 'Create_Table' ) {
my $col_count = $sf->{o}{insert}{max_cols_plain} || 25; ##
my $width = length $col_count;
my $info = 'CREATE TABLE';
my $fields = [ map { [ sprintf( "%*d", $width, $_ ), '' ] } 1 .. $col_count ];
# Fill_form
my $form = $tf->fill_form(
$fields,
{ info => $info, prompt => 'Column names:', confirm => $confirm, back => $back . ' ' }
);
if ( ! $form ) {
return;
}
$col_names = [ map { $_->[1] } grep { length $_->[1] } @$form ]; # not quoted
unshift @$aoa, $col_names;
}
else {
$col_names = $sql->{insert_col_names};
}
lib/App/DBBrowser/GetContent/Source.pm view on Meta::CPAN
my $menu = [ @pre, $add ];
my $info = $sf->__get_read_info( $aoa );
my $choice;
if ( $stmt_type eq 'Insert' && ! $count ) {
$choice = $add;
}
else {
# Choose
$choice = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_h}}, info => $info, prompt => '', default => $default }
);
$ax->print_sql_info( $info );
if ( ! defined $choice ) {
if ( $stmt_type eq 'Create_Table' && @$aoa == 1 ) {
next COL_BY_COL;
}
elsif ( $stmt_type eq 'Insert' && @$aoa == 0 ) {
return;
}
else {
lib/App/DBBrowser/GetContent/Source.pm view on Meta::CPAN
$sql->{insert_args} = $aoa;
return 1;
}
}
elsif ( $choice eq $add ) {
my $info = $sf->__get_read_info( $aoa );
my $fields = [ map { [ $_, ] } @$col_names ];
# Fill_form
my $data = $tf->fill_form(
$fields,
{ info => $info, confirm => $confirm, back => $back . ' ', prompt => 'Enter Data:' }
);
$ax->print_sql_info( $info );
if ( ! defined $data ) {
if ( ! @$aoa && $stmt_type eq 'Create_Table' ) {
next COL_BY_COL;
}
$default = 0;
}
else {
if ( $sf->{o}{insert}{empty_to_null_plain} ) {
lib/App/DBBrowser/Options.pm view on Meta::CPAN
CONFIG_PLUGIN: while ( 1 ) {
if ( @$chosen_plugins == 1 ) {
my $plugin = $chosen_plugins->[0];
my $groups = $op_mn->groups( $plugin );
$sf->config_groups( $groups, $plugin );
last CONFIG_PLUGIN;
}
else {
my @pre = ( undef );
my $menu = [ @pre, map { '- ' . $_ } @$chosen_plugins ];
my $prompt = 'Configure Plugins';
# Choose
my $config_idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, prompt => $prompt, index => 1, default => $config_old_idx, undef => $sf->{i}{_back} }
);
if ( ! $config_idx ) {
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $config_old_idx == $config_idx && ! $ENV{TC_RESET_AUTO_UP} ) {
$config_old_idx = 0;
next CONFIG_PLUGIN;
}
$config_old_idx = $config_idx;
lib/App/DBBrowser/Options.pm view on Meta::CPAN
my $op_mn = App::DBBrowser::Options::Menus->new( $sf->{i}, $sf->{o} );
my $op_rw = App::DBBrowser::Options::ReadWrite->new( $sf->{i}, $sf->{o} );
my $driver = '';
if ( $plugin ) {
my $plugin_full_name = "App::DBBrowser::DB::$plugin";
eval "require $plugin_full_name" or die $@;
my $plugin = $plugin_full_name->new( $sf->{i}, $sf->{o} );
$driver = $plugin->get_db_driver();
}
my $lo = $op_rw->read_config_file( $driver, $plugin );
my $prompt = '';
my $info;
my @pre = ( undef );
if ( $plugin ) {
$info = 'Configure ' . $plugin;
$prompt = $info;
}
else {
#$prompt = 'Your choice:';
}
my $grp_old_idx = 0;
GROUP: while( 1 ) {
my ( $group, $group_prompt );
if ( @$groups == 1 ) {
$group = $groups->[0]{name};
$group_prompt = $groups->[0]{text};
}
else {
my $menu = [ @pre, map( $_->{text}, @$groups ) ];
# Choose
my $grp_idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, prompt => $prompt, index => 1, default => $grp_old_idx, undef => ' <=' }
);
if ( ! defined $grp_idx || ! defined $menu->[$grp_idx] ) {
$op_rw->write_config_file( $lo, $plugin );
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $grp_old_idx == $grp_idx && ! $ENV{TC_RESET_AUTO_UP} ) {
$grp_old_idx = 0;
next GROUP;
}
$grp_old_idx = $grp_idx;
}
$group = $groups->[$grp_idx-@pre]{name};
$group_prompt = $groups->[$grp_idx-@pre]{text};
};
if ( length $group_prompt ) {
$group_prompt = $group_prompt =~ s/^- //r . ':';
}
my $sub_groups = $op_mn->sub_groups( $group, $driver );
my $sub_group_old_idx = 0;
OPTION: while ( 1 ) {
my ( $section, $sub_group );
if ( @$sub_groups == 1 ) {
$section = $sub_groups->[0]{section};
$sub_group = $sub_groups->[0]{name};
}
else {
my @pre = ( undef );
my $menu = [ @pre, map( $_->{text}, @$sub_groups ) ];
# Choose
my $sub_group_idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => $group_prompt,
index => 1, default => $sub_group_old_idx, undef => ' <=' } ##
);
if ( ! $sub_group_idx ) {
if ( @$groups == 1 ) {
$op_rw->write_config_file( $lo, $plugin );
return;
}
next GROUP;
}
if ( $sf->{o}{G}{menu_memory} ) {
lib/App/DBBrowser/Options.pm view on Meta::CPAN
sub __display_info {
my ( $sf ) = @_;
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my $app_dir = $sf->{i}{app_dir};
eval { $app_dir = decode( 'locale', $app_dir ) };
my $info = 'db-browser' . "\n\n";
$info .= 'Version: ' . $main::VERSION . "\n\n";
$info .= 'Path: ' . catfile( $RealBin, $RealScript ) . "\n\n";
$info .= 'App-Dir: ' . $app_dir . "\n";
$tc->choose( [ ' << ' ], { prompt => $info, color => 1, margin => [ 1, 1, 1, 1 ] } );
}
1;
__END__
lib/App/DBBrowser/Options/Menus.pm view on Meta::CPAN
sub group_connect {
my ( $sf, $info, $lo, $section, $sub_group, $driver ) = @_;
my $sub_menu_required_fields = [
[ 'host_required', "- Host required", [ $no, $yes ] ],
[ 'port_required', "- Port required", [ $no, $yes ] ],
[ 'user_required', "- User required", [ $no, $yes ] ],
[ 'pass_required', "- Password required", [ $no, $yes ] ],
];
my $items_login_data = [
{ name => 'host', prompt => "- Host" },
{ name => 'port', prompt => "- Port" },
{ name => 'user', prompt => "- User" },
];
my $sub_menu_env_variables = [
[ 'use_dbi_host', "- Use DBI_HOST", [ $no, $yes ] ],
[ 'use_dbi_port', "- Use DBI_PORT", [ $no, $yes ] ],
[ 'use_dbi_user', "- Use DBI_USER", [ $no, $yes ] ],
[ 'use_dbi_pass', "- Use DBI_PASS", [ $no, $yes ] ],
];
my $items_read_attributes = [
{ name => 'LongReadLen', text => "- LongReadLen" },
];
lib/App/DBBrowser/Options/Menus.pm view on Meta::CPAN
[ 'odbc_utf8_on', "- odbc_utf8_on", [ $no, $yes ] ],
[ 'odbc_ignore_named_placeholders', "- odbc_ignore_named_placeholders", [ $no, $yes ] ],
#[ 'odbc_array_operations', "- odbc_array_operations", [ $no, $yes ] ];
}
elsif ( $driver eq 'DuckDB' ) {
$sub_menu_required_fields = [];
$items_login_data = [];
$sub_menu_env_variables = [];
}
if ( $sub_group eq '_required_fields' ) {
my $prompt = 'Required Fields:';
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu_required_fields, $prompt );
}
elsif ( $sub_group eq '_login_data' ) {
my $prompt = 'Login Data:';
$sf->__group_readline( $info, $lo, $section, $items_login_data, $prompt );
}
elsif ( $sub_group eq '_env_variables' ) {
my $prompt = 'Environment Variables:';
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu_env_variables, $prompt );
}
elsif ( $sub_group eq '_read_attributes' ) {
my $prompt = 'Read Attributes:';
$sf->__group_readline( $info, $lo, $section, $items_read_attributes, $prompt );
}
elsif ( $sub_group eq '_set_attributes' ) {
my $prompt = 'Set Attributes:';
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu_set_attributes, $prompt );
}
else {
die "connect: unknown sub_group $sub_group";
}
return;
}
sub group_extensions {
my ( $sf, $info, $lo, $section, $sub_group ) = @_;
if ( $sub_group eq '_e_table' ) {
my $prompt = 'Extend tables menu:';
my $sub_menu = [
[ 'm_derived', "- Add subquery", [ $no, $yes ] ],
[ 'm_cte', "- Add cte", [ $no, $yes ] ],
[ 'join', "- Add join", [ $no, $yes ] ],
[ 'union', "- Add union", [ $no, $yes ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_e_join' ) {
my $prompt = 'Extend join menu:';
my $sub_menu = [
[ 'j_derived', "- Add subquery", [ $no, $yes ] ],
[ 'j_cte', "- Add cte", [ $no, $yes ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_e_union' ) {
my $prompt = 'Extend union menu:';
my $sub_menu = [
[ 'u_derived', "- Add subquery", [ $no, $yes ] ],
[ 'u_cte', "- Add cte", [ $no, $yes ] ],
[ 'u_edit_stmt', "- Edit statement", [ $no, $yes ] ],
[ 'u_parentheses', "- Parentheses", [ $no, $yes ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_e_expressions' ) {
my $prompt = 'Extended expressions:';
my $sub_menu = [
[ 'extended_cols', "- Exdented columns", [ $no, $yes ] ],
[ 'extended_values', "- Exdented values", [ $no, $yes ] ],
[ 'extended_args', "- Exdented arguments", [ $no, $yes ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_e_write_access' ) {
my $prompt = 'Write access: ';
my $sub_menu = [
[ 'insert_into', "- Insert records", [ $no, $yes ] ],
[ 'update', "- Update records", [ $no, $yes ] ],
[ 'delete', "- Delete records", [ $no, $yes ] ],
[ 'create_table', "- Create table", [ $no, $yes ] ],
[ 'drop_table', "- Drop table", [ $no, $yes ] ],
[ 'create_view', "- Create view", [ $no, $yes ] ],
[ 'drop_view', "- Drop view", [ $no, $yes ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
else {
die "extensions: unknown sub_group $sub_group";
}
return;
}
sub group_sql_settings {
my ( $sf, $info, $lo, $section, $sub_group, $driver ) = @_;
if ( $sub_group eq '_meta' ) {
my $prompt = 'System data ';
my $sub_menu = [
[ 'metadata', "- Show system DB/schemas/tables", [ $no, $yes ] ]
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq 'operators' ) {
my $prompt = 'Choose operators';
my $avail_operators = [
" = ", " != ", " <> ", " < ", " > ", " >= ", " <= ",
"REGEXP", "REGEXP_i", "NOT REGEXP", "NOT REGEXP_i", "LIKE", "NOT LIKE",
"IS NULL", "IS NOT NULL", "IN", "NOT IN", "BETWEEN", "NOT BETWEEN",
"ANY", "ALL",
];
$sf->__choose_a_subset_wrap( $info, $lo, $section, $sub_group, $avail_operators, $prompt );
}
elsif ( $sub_group eq '_add_aliases' ) {
my $prompt = 'Add alias:';
my $sub_menu = [
[ 'complex_cols_select', "- Functions/Subqueries in select", [ 'NO', undef, 'ASK', undef ] ],
[ 'tables_in_join', "- Tables in join", [ undef, 'AUTO', undef, 'ASK/AUTO' ] ],
[ 'join_columns', "- Non-unique columns in join", [ 'NO', 'AUTO', 'ASK', 'ASK/AUTO' ] ],
[ 'derived_table', "- Derived table", [ 'NO', 'AUTO', 'ASK', 'ASK/AUTO' ] ],
[ 'ordinary_table', "- Ordinary table", [ 'NO', 'AUTO', 'ASK', 'ASK/AUTO' ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_aliases_in_clauses' ) {
my $prompt = 'Use aliases in: ';
my $sub_menu = [
[ 'use_in_group_by', "- Group by", [ $no, $yes ] ],
[ 'use_in_having', "- Having", [ $no, $yes ] ],
[ 'use_in_order_by', "- Order by", [ $no, $yes ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_sql_identifiers' ) {
my $prompt = 'Your choice: ';
my $sub_menu = [
[ 'qualified_table_name', "- Qualified table names", [ $no, $yes ] ],
[ 'quote_tables', "- Quote table names", [ $no, $yes ] ],
[ 'quote_columns', "- Quote column names", [ $no, $yes ] ],
];
if ( $driver eq 'Firebird' ) {
shift @$sub_menu;
}
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_view_name_prefix' ) {
my $items = [
{ name => 'view_name_prefix', prompt => "View name prefix" },
];
my $prompt = 'Set a view name prefix';
$sf->__group_readline( $info, $lo, $section, $items, $prompt );
}
elsif ( $sub_group eq '_other_sql_settings' ) {
my $prompt = 'Your choice: ';
my $sub_menu = [
[ 'edit_sql_menu_sq', "- Subqueries created with 'SQL Menu': Allow editing.", [ $no, $yes ] ],
];
if ( $driver eq 'Pg' ) {
push @$sub_menu, [ 'pg_autocast', "- Pg: Convert to 'text' automatically when required.", [ $no, $yes ] ];
}
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
else {
die "sql_settings: unknown sub_group $sub_group";
}
return;
}
sub group_create_table {
my ( $sf, $info, $lo, $section, $sub_group ) = @_;
if ( $sub_group eq '_enable_ct_opt' ) {
my $prompt = 'Activate options';
my $sub_menu = [
[ 'option_ai_column_enabled', "- Offer auto increment column", [ $no, $yes ] ],
[ 'data_type_guessing', "- Data type guessing", [ $no, $yes ] ],
[ 'encode_for_data_type_guessing', "- Encode for data type guessing", [ $no, $yes ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_add_ct_fields' ) {
my $prompt = 'Add fields';
my $sub_menu = [
[ 'table_constraint_rows', "- Table constraint fields", [ 0 .. 9 ] ],
[ 'table_option_rows', "- Table option fields", [ 0 .. 9 ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_default_ai_column_name' ) {
my $items = [
{ name => 'default_ai_column_name', prompt => "Default primary key auto increment column name" },
];
my $prompt = 'Set a default auto increment column name';
$sf->__group_readline( $info, $lo, $section, $items, $prompt );
}
else {
die "create_table: unknown sub_group $sub_group";
}
return;
}
sub group_output {
my ( $sf, $info, $lo, $section, $sub_group ) = @_;
if ( $sub_group eq '_binary_filter' ) {
my $prompt = 'How to print arbitrary binray data';
my $sub_menu = [
[ 'binary_filter', "- Binary filter", [ $no, 'BNRY', 'Hexadecimal' ] ]
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_squash_spaces' ) {
my $prompt = 'Remove leading and trailing spaces and squash consecutive spaces';
my $sub_menu = [
[ 'squash_spaces', "- Squash spaces", [ $no, $yes ] ]
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_set_string' ) {
my $items = [
{ name => 'undef', prompt => "Show undefined fields as" },
];
my $prompt = 'Undef string';
$sf->__group_readline( $info, $lo, $section, $items, $prompt );
}
elsif ( $sub_group eq '_color' ) {
my $prompt = '"ANSI color escapes"';
my $sub_menu = [
[ 'color', "- ANSI color escapes", [ $no, $yes ] ]
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq 'trunc_fract_first' ) {
my $prompt = 'If the terminal is not wide enough:';
my $sub_menu = [
[ 'trunc_fract_first', "- First step: truncate fraction of numbers", [ $no, $yes ] ]
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_base_indent' ) {
my $prompt = 'Set the indentation width for SQL substatements';
my $sub_menu = [
[ 'base_indent', "- Indentation", [ 0, 1, 2, 3, 4 ] ]
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq 'tab_width' ) {
my $digits = 3;
my $prompt = 'Set the tab width ';
$sf->__choose_a_number_wrap( $info, $lo, $section, $sub_group, $prompt, $digits, 0 );
}
elsif ( $sub_group eq '_pad_row_edges' ) {
my $prompt = '"Pad row edges"';
my $sub_menu = [
[ 'pad_row_edges', "- Pad row edges with a space.", [ $no, $yes ] ]
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_expand_rows' ) {
my $prompt = 'Your choice: ';
my $sub_menu = [
[ 'table_expand', "- Expand table rows", [ $no, $yes ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_expanded_line_spacing' ) {
my $prompt = 'Your choice: ';
my $sub_menu = [
[ 'expanded_line_spacing', "- Blank line between columns when a row is expanded.", [ $no, $yes ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq 'expanded_max_width' ) {
my $digits = 3;
my $prompt = 'Maximum width of expanded table rows';
$sf->__choose_a_number_wrap( $info, $lo, $section, $sub_group, $prompt, $digits, 0 );
}
elsif ( $sub_group eq 'col_trim_threshold' ) {
my $digits = 3;
my $prompt = 'Column trim threshold ';
$sf->__choose_a_number_wrap( $info, $lo, $section, $sub_group, $prompt, $digits, 0 );
}
elsif ( $sub_group eq '_db2_encoding' ) {
my $items = [
{ name => 'db2_encoding', prompt => "DB2 application code set" },
];
my $prompt = 'Set the DB2 application code set';
$sf->__group_readline( $info, $lo, $section, $items, $prompt );
}
else {
die "output: unknown sub_group $sub_group";
}
return;
}
sub group_import {
my ( $sf, $info, $lo, $section, $sub_group ) = @_;
if ( $sub_group eq '_data_source_type' ) {
my $prompt = 'Data source options';
my $sub_menu = [
[ 'data_source_create_table', "- Data source \"Create table\"", [ 'plain', 'file', 'menu' ], ],
[ 'data_source_insert', "- Data source \"Insert into\"", [ 'plain', 'file', 'menu' ], ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq 'max_cols_plain' ) {
my $digits = 2;
my $prompt = 'Create table, source plain.' . "\n" . 'Maximum columns:';
$sf->__choose_a_number_wrap( $info, $lo, $section, $sub_group, $prompt, $digits, 1 );
}
elsif ( $sub_group eq '_parse_file' ) {
my $prompt = 'How to parse input files';
my $sub_menu = [
[ 'parse_mode_input_file', "- Use", [ 'Text::CSV', 'split', 'Template', 'Spreadsheet::Read' ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_csv_in_char' ) {
my $items = [
{ name => 'sep_char', prompt => "sep_char " },
{ name => 'quote_char', prompt => "quote_char " },
{ name => 'escape_char', prompt => "escape_char" },
{ name => 'eol', prompt => "eol " },
{ name => 'comment_str', prompt => "comment_str" },
];
my $prompt = 'Text::CSV_XS options a';
$sf->__group_readline( $info, $lo, $section, $items, $prompt );
}
elsif ( $sub_group eq '_csv_in_options' ) {
my $prompt = 'Text::CSV_XS options b';
my $sub_menu = [
[ 'allow_loose_escapes', "- allow_loose_escapes", [ $no, $yes ] ],
[ 'allow_loose_quotes', "- allow_loose_quotes", [ $no, $yes ] ],
[ 'allow_whitespace', "- allow_whitespace", [ $no, $yes ] ],
[ 'blank_is_undef', "- blank_is_undef", [ $no, $yes ] ],
[ 'binary', "- binary", [ $no, $yes ] ],
[ 'decode_utf8', "- decode_utf8", [ $no, $yes ] ],
[ 'empty_is_undef', "- empty_is_undef", [ $no, $yes ] ],
[ 'skip_empty_rows', "- skip_empty_rows", [ $no, $yes ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_split_config' ) {
my $items = [
{ name => 'field_sep', prompt => "Field separator " },
{ name => 'field_l_trim', prompt => "Trim field left " },
{ name => 'field_r_trim', prompt => "Trim field right " },
{ name => 'record_sep', prompt => "Record separator " },
{ name => 'record_l_trim', prompt => "Trim record left " },
{ name => 'record_r_trim', prompt => "Trim record right" },
];
my $prompt = 'Config \'split\' mode';
$sf->__group_readline( $info, $lo, $section, $items, $prompt );
}
elsif ( $sub_group eq '_input_filter' ) {
my $prompt = 'Enable input filter';
my $sub_menu = [
[ 'enable_input_filter', "- Enable input filter", [ $no, $yes ] ]
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_empty_to_null' ) {
my $prompt = 'Enable "Empty to NULL":';
my $sub_menu = [
[ 'empty_to_null_plain', "- Source type 'plain'", [ $no, $yes ] ],
[ 'empty_to_null_file', "- Source type 'file'", [ $no, $yes ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_file_encoding_in' ) {
my $items = [
{ name => 'file_encoding', prompt => "Input file encoding" },
];
my $prompt = 'Encoding of input data text files';
$sf->__group_readline( $info, $lo, $section, $items, $prompt );
}
elsif ( $sub_group eq 'history_dirs' ) {
my $digits = 2;
my $prompt = 'Number of saved dirs: ';
$sf->__choose_a_number_wrap( $info, $lo, $section, $sub_group, $prompt, $digits, 1 );
}
elsif ( $sub_group eq '_file_filter' ) {
my $items = [
{ name => 'file_filter', prompt => "File filter glob pattern" },
];
my $prompt = 'Set the glob pattern for the file filter';
$sf->__group_readline( $info, $lo, $section, $items, $prompt );
}
elsif ( $sub_group eq '_show_hidden_files' ) {
my $prompt = 'Show hidden files';
my $sub_menu = [
[ 'show_hidden_files', "- Show hidden files", [ $no, $yes ] ]
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
else {
die "import: unknown sub_group $sub_group";
}
return;
}
sub group_export {
my ( $sf, $info, $lo, $section, $sub_group ) = @_;
if ( $sub_group eq 'export_dir' ) {
my $prompt = 'Select the destination folder for data exported as CSV files.';
$sf->__choose_a_directory_wrap( $info, $lo, $section, $sub_group, $prompt );
}
elsif ( $sub_group eq '_exported_files' ) {
my $prompt = 'Data export to CSV files';
my $sub_menu = [
[ 'add_extension', "- Add automatically '.csv'-extension", [ $no, $yes ] ],
[ 'default_filename', "- Table name is default file name", [ $no, $yes ] ]
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_file_encoding_out' ) {
my $items = [
{ name => 'file_encoding', prompt => "Encoding CSV file" },
];
my $prompt = 'Data to CSV-files';
$sf->__group_readline( $info, $lo, $section, $items, $prompt );
}
elsif ( $sub_group eq '_csv_out_char' ) {
my $items = [
{ name => 'sep_char', prompt => "sep_char " },
{ name => 'quote_char', prompt => "quote_char " },
{ name => 'escape_char', prompt => "escape_char" },
{ name => 'eol', prompt => "eol " },
{ name => 'undef_str', prompt => "undef_str" },
];
my $prompt = 'Text::CSV_XS write options a';
$sf->__group_readline( $info, $lo, $section, $items, $prompt );
}
elsif ( $sub_group eq '_csv_out_options' ) {
my $prompt = 'Text::CSV_XS write options b';
my $sub_menu = [
[ 'always_quote', "- always_quote", [ $no, $yes ] ],
[ 'binary', "- binary", [ $no, $yes ] ],
[ 'escape_null', "- escape_null", [ $no, $yes ] ],
[ 'quote_binary', "- quote_binary", [ $no, $yes ] ],
[ 'quote_empty', "- quote_empty", [ $no, $yes ] ],
[ 'quote_space', "- quote_space", [ $no, $yes ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
else {
die "export: unknown sub_group $sub_group";
}
return;
}
sub group_misc {
my ( $sf, $info, $lo, $section, $sub_group, $driver ) = @_;
if ( $sub_group eq '_search' ) {
my $prompt = 'Your choice: ';
my $sub_menu = [
[ 'search', "- Row filter", [ 'disabled', 'case insensitive', 'case sensitive' ] ]
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_warnings' ) {
my $prompt = '"Disable/Enable warnings"';
my $sub_menu = [
[ 'warnings_table_print', "- Warnings table-print", [ $no, $yes ] ],
];
if ( $driver eq 'SQLite' ) {
push @$sub_menu, [ 'file_find_warnings', "- Warnings \"File::Find\" search", [ $no, $yes ] ];
}
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq 'progress_bar' ) {
my $digits = 7;
my $prompt = 'Set the threshold for the progress bar ';
$sf->__choose_a_number_wrap( $info, $lo, $section, $sub_group, $prompt, $digits, 0 );
}
else {
die "misc: unknown sub_group: $sub_group";
}
return;
}
sub group_global {
my ( $sf, $info, $lo, $section, $sub_group ) = @_;
if ( $sub_group eq '_menu_memory' ) {
my $prompt = 'Your choice: ';
my $sub_menu = [
[ 'menu_memory', "- Menu memory", [ $no, $yes ] ],
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
elsif ( $sub_group eq '_mouse' ) {
my $prompt = 'Your choice: ';
my $sub_menu = [
[ 'mouse', "- Mouse mode", [ $no, $yes ] ]
];
$sf->__settings_menu_wrap( $info, $lo, $section, $sub_menu, $prompt );
}
else {
die "global: unknown sub_group: $sub_group";
}
return;
}
sub group_select_plugins {
my ( $sf, $info, $lo, $section, $sub_group ) = @_;
if ( $sub_group eq 'plugins' ) {
my %installed_plugins;
for my $dir ( @INC ) {
my $glob_pattern = catfile $dir, 'App', 'DBBrowser', 'DB', '*.pm';
map { $installed_plugins{( fileparse $_, '.pm' )[0]}++ } glob $glob_pattern;
}
my $avail_plugins = [ sort keys %installed_plugins ];
my $prompt = 'Select plugins';
# $info = undef;
$sf->__choose_a_subset_wrap( $info, $lo, $section, $sub_group, $avail_plugins, $prompt );
}
else {
die "global: unknown sub_group: $sub_group";
}
return;
}
sub __settings_menu_wrap {
# sets the options to the index of the chosen values, not to the values itself
my ( $sf, $info, $lo, $section, $sub_menu, $prompt ) = @_;
my $tu = Term::Choose::Util->new( $sf->{i}{tcu_default} );
my $changed = $tu->settings_menu(
$sub_menu, $lo->{$section},
{ info => $info, prompt => $prompt, back => $sf->{i}{_back}, confirm => $sf->{i}{_confirm} }
);
}
sub __choose_a_subset_wrap {
my ( $sf, $info, $lo, $section, $opt, $available, $prompt ) = @_;
my $tu = Term::Choose::Util->new( $sf->{i}{tcu_default} );
my $current = $lo->{$section}{$opt};
$info .= "\n" if length $info;
$info .= 'Cur: ';
$info .= join( ', ', @$current ) if defined $current;
my $name = 'New: ';
# Choose_a_list
my $list = $tu->choose_a_subset(
$available,
{ info => $info, prompt => $prompt, cs_label => $name, prefix => '- ', keep_chosen => 0,
index => 0, confirm => $sf->{i}{_confirm}, back => $sf->{i}{_back}, layout => 2,
clear_screen => 1 }
);
return if ! defined $list;
return if ! @$list;
$lo->{$section}{$opt} = $list;
return;
}
sub __choose_a_number_wrap {
my ( $sf, $info, $lo, $section, $opt, $prompt, $digits, $small_first ) = @_;
my $tu = Term::Choose::Util->new( $sf->{i}{tcu_default} );
my $current = $lo->{$section}{$opt};
my $w = $digits + int( ( $digits - 1 ) / 3 ) * length $sf->{i}{info_thsd_sep};
$info .= "\n" . 'Cur: ';
$info .= sprintf( "%*s", $w, insert_sep( $current, $sf->{i}{info_thsd_sep} ) ) if defined $current;
my $name = 'New: ';
# Choose_a_number
my $choice = $tu->choose_a_number( $digits,
{ info => $info, prompt => $prompt, cs_label => $name, small_first => $small_first,
clear_screen => 1, confirm => $sf->{i}{confirm}, back => $sf->{i}{back} }
);
return if ! defined $choice;
$lo->{$section}{$opt} = $choice;
return;
}
sub __choose_a_directory_wrap {
my ( $sf, $info, $lo, $section, $opt, $prompt ) = @_;
my $tu = Term::Choose::Util->new( $sf->{i}{tcu_default} );
my $current = $lo->{$section}{$opt};
# Choose_a_directory
my $choice = $tu->choose_a_directory(
{ show_hidden => 1, info => $info, prompt => $prompt, clear_screen => 1, decoded => 1,
confirm => $sf->{i}{confirm}, back => $sf->{i}{back}, init_dir => $current }
);
return if ! defined $choice;
$lo->{$section}{$opt} = $choice;
return;
}
sub __group_readline {
my ( $sf, $info, $lo, $section, $items, $prompt ) = @_;
my $list = [ map {
[ exists $_->{prompt} ? $_->{prompt} : $_->{name}, $lo->{$section}{$_->{name}} ]
} @{$items} ];
my $tf = Term::Form->new( $sf->{i}{tf_default} );
# Fill_Form
my $new_list = $tf->fill_form(
$list,
{ info => $info, prompt => $prompt, confirm => $sf->{i}{confirm}, back => $sf->{i}{back} }
);
if ( $new_list ) {
for my $i ( 0 .. $#$items ) {
$lo->{$section}{$items->[$i]{name}} = $new_list->[$i][1];
}
}
}
lib/App/DBBrowser/Table.pm view on Meta::CPAN
my ( $class, $info, $options, $d ) = @_;
bless {
i => $info,
o => $options,
d => $d
}, $class;
}
sub browse_the_table {
my ( $sf, $sql, $return_stmt_prompt ) = @_;
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my $ax = App::DBBrowser::Auxil->new( $sf->{i}, $sf->{o}, $sf->{d} );
my $sb = App::DBBrowser::Table::Substatement->new( $sf->{i}, $sf->{o}, $sf->{d} );
$sf->{d}{stmt_types} = [ 'Select' ];
my $changed = {};
my $hidden = 'Customize:';
my ( $print_table, $select, $distinct, $where, $group_by, $having, $order_by, $limit, $offset, $export ) =
( 'Print TABLE',
'- SELECT',
'- DISTINCT',
lib/App/DBBrowser/Table.pm view on Meta::CPAN
'- GROUP BY',
'- HAVING',
'- ORDER BY',
'- LIMIT',
'- OFFSET',
' Export',
);
my @choices = ( $print_table, $select, $distinct, $where, $group_by, $having, $order_by, $limit, $offset, $export );
my @pre = ( $hidden, undef );
my $back = $sf->{i}{back};
my ( $return_statement, $hidden_print ) = ( $sf->{i}{_confirm}, $return_stmt_prompt );
if ( $return_stmt_prompt ) {
$choices[0] = $return_statement;
@pre = ( $hidden_print, undef );
$back = $sf->{i}{_back};
}
my $footer = $sf->{d}{table_origin} eq 'ordinary' ? $sf->{d}{table_key} : ucfirst $sf->{d}{table_origin};
$sf->{d}{table_footer} = " '$footer' ";
my $old_idx = 1;
CUSTOMIZE: while ( 1 ) {
my $menu = [ @pre, @choices ];
my $info = $ax->get_sql_info( $sql );
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => '', index => 1, default => $old_idx, undef => $back }
);
$ax->print_sql_info( $info );
if ( ! defined $idx || ! defined $menu->[$idx] ) {
for my $key ( keys %{$changed} ) {
if ( $changed->{$key} ) {
$changed = {};
$ax->reset_sql( $sql );
next CUSTOMIZE;
}
}
lib/App/DBBrowser/Table.pm view on Meta::CPAN
if ( $sf->{o}{export}{add_extension} && $tmp_file_name !~ /\.csv\z/i ) {
$file_name .= '.csv';
}
my $export_dir = $sf->{o}{export}{export_dir};
my $dir_fs = realpath( encode( 'locale_fs', $export_dir ) ) or die "$export_dir: $!";
my $file_fs = catfile $dir_fs, encode( 'locale_fs', $file_name );
my ( $new_name, $overwrite ) = ( '- New name', '- Overwrite' );
my $chosen;
if ( -e $file_fs ) {
my $menu;
my $prompt;
if ( -d $file_fs ) {
$prompt = 'A directory \'' . decode( 'locale_fs', $file_fs ) . '\' already exists:';
$menu = [ undef, $new_name ];
}
else {
$prompt = 'A file \'' . decode( 'locale_fs', $file_fs ) . '\' already exists:';
$menu = [ undef, $new_name, $overwrite ];
}
# Choose
$chosen = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => $prompt, keep => scalar( @$menu ) }
);
$ax->print_sql_info( $info );
if ( ! defined $chosen ) {
return;
}
elsif ( $chosen eq $new_name ) {
next FILE_NAME;
}
}
my ( $yes, $no ) = ( '- YES', '- NO' );
my $hidden;
if ( defined $chosen && $chosen eq $overwrite ) {
$hidden = 'Overwrite "' . decode( 'locale_fs', $file_fs ) . '"?';
}
else {
$hidden = 'Write data to "' . decode( 'locale_fs', $file_fs ) . '"?';
}
# Choose
my $choice = $tc->choose(
[ $hidden, undef, $yes, $no ],
{ info => $info, prompt => '', default => 1, layout => 2, undef => ' <<' }
);
$ax->print_sql_info( $info );
if ( ! defined $choice ) {
next FILE_NAME;
}
elsif ( $choice eq $hidden ) {
my $op = App::DBBrowser::Options->new( $sf->{i}, $sf->{o} );
my $op_rw = App::DBBrowser::Options::ReadWrite->new( $sf->{i}, $sf->{o} );
$op->config_groups( [ { name => 'group_export', text => "- Export" } ], $sf->{i}{plugin} );
$op_rw->read_config_file( $sf->{i}{driver}, $sf->{i}{plugin} );
lib/App/DBBrowser/Table/CommitWriteSQL.pm view on Meta::CPAN
my $sth = $dbh->prepare( $stmt );
$sth->execute();
my $col_names = $sth->{NAME};
$all_arrayref = $sth->fetchall_arrayref;
$count_affected = @$all_arrayref;
unshift @$all_arrayref, $col_names;
1 }
) {
$ax->print_error_message( $@ );
}
my $prompt = "Affected records:";
my $info = $ax->get_sql_info( $sql );
if ( @$all_arrayref > 1 ) {
my $tp = Term::TablePrint->new( $sf->{o}{table} );
if ( ! $sf->{o}{G}{warnings_table_print} ) {
local $SIG{__WARN__} = sub {};
$tp->print_table( $all_arrayref, { info => $info, prompt => $prompt, footer => $sf->{d}{table_footer} } );
}
else {
$tp->print_table( $all_arrayref, { info => $info, prompt => $prompt, footer => $sf->{d}{table_footer} } );
}
}
$ax->print_sql_info( $info, $waiting );
}
else {
die $stmt_type // 'undefined_stmt_type';
}
my $transaction;
lib/App/DBBrowser/Table/CommitWriteSQL.pm view on Meta::CPAN
if ( $stmt_type eq 'Insert' && $sf->{d}{stmt_types}[0] eq 'Create_Table' ) {
# already asked for confirmation (create table + insert data) in Create_Table
}
else {
my $commit_ok = sprintf qq( %s %s "%s"), 'EXECUTE', insert_sep( $count_affected, $sf->{i}{info_thsd_sep} ), $stmt_type;
my $menu = [ undef, $commit_ok ];
my $info = $ax->get_sql_info( $sql ); #
# Choose
my $choice = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => '', keep => scalar( @$menu ) }
);
$ax->print_sql_info( $info, $waiting );
if ( ! defined $choice || $choice ne $commit_ok ) {
return;
}
}
if ( ! eval {
my $sth = $dbh->prepare( $ax->get_stmt( $sql, $stmt_type, 'prepare' ) );
if ( $stmt_type eq 'Insert' ) {
$sth->execute( @$_ ) for @{$sql->{insert_args}};
lib/App/DBBrowser/Table/Extensions.pm view on Meta::CPAN
#my $last_idx = $#$r_data;
my $ext_argument = $sf->__choose_extension( $sql, $clause, $r_data, 'argument', $extensions, $opt );
#die if $#$r_data != $last_idx;
return $ext_argument;
}
sub enable_extended_arguments {
my ( $sf, $info ) = @_;
my $tc = Term::Choose->new( $sf->{i}{tc_default} );
my $prompt = 'Extended arguments:';
my $yes = '- YES';
# Choose
my $choice = $tc->choose(
[ undef, '- NO', $yes ],
{ %{$sf->{i}{lyt_v}}, info => $info, prompt => $prompt, undef => '<=' }
);
if ( ! defined $choice ) {
return;
}
if ( $choice eq $yes ) {
$sf->{o}{enable}{extended_args} = 1;
}
else {
$sf->{o}{enable}{extended_args} = 0;
}
lib/App/DBBrowser/Table/Extensions.pm view on Meta::CPAN
else {
my $empty;
if ( $caller eq 'column' && $clause eq 'where' ) {
$empty = 'skip'; ##
}
my @pre = ( undef );
# Choose
my $idx = $tc->choose(
[ @pre, @$extensions ],
{ %{$sf->{i}{lyt_h}}, info => $info, index => 1, default => $old_idx,
prompt => $opt->{prompt}, undef => '<<', empty => $empty }
);
$ax->print_sql_info( $info );
if ( ! $idx ) { ##
return;
}
if ( $sf->{o}{G}{menu_memory} ) {
if ( $old_idx == $idx && ! $ENV{TC_RESET_AUTO_UP} ) {
$old_idx = 0;
next EXTENSION;
}
$old_idx = $idx;
}
$extension = $extensions->[$idx-@pre];
}
my $cols = $sf->__avail_cols_in_extenstions( $sql, $clause, $extension );
if ( $extension eq $e_const ) {
my $prompt = $opt->{prompt} // 'Value: ';
# Readline
my $value = $tr->readline(
$prompt,
{ info => $info, history => $opt->{history} }
);
$ax->print_sql_info( $info );
if ( ! defined $value ) {
return if @$extensions = 1;
next EXTENSION;
}
# return if ! length $value; ##
if ( $opt->{is_numeric} ) {
if ( $opt->{is_numeric} == -1 ) {
lib/App/DBBrowser/Table/Extensions.pm view on Meta::CPAN
if ( ! defined $col_aliases ) {
return if @$extensions == 1;
next EXTENSION;
}
return $col_aliases;
}
elsif ( $extension eq $e_multi_col ) {
# Choose
my $chosen_cols = $tu->choose_a_subset(
$cols,
{ info => $info, prompt => '', layout => 1, index => 0, all_by_default => 0,
cs_label => 'Columns: ', cs_begin => '(', cs_separator => ',', cs_end => ')' }
);
$ax->print_sql_info( $info );
if ( ! defined $chosen_cols ) {
return if @$extensions == 1;
next EXTENSION;
}
return "(" . join( ",", @$chosen_cols ) . ")";
}
}
lib/App/DBBrowser/Table/Extensions/Case.pm view on Meta::CPAN
$menu = [ @pre, $end ];
}
else {
$menu = [ @pre, $when, $else, $end ];
}
$r_data->[-1] = [ 'case', @$case_parts, '' ];
my $info = $ax->get_sql_info( $sql ) . $ext->nested_func_info( $r_data );
# Choose
my $idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_h}}, info => $info, prompt => 'Your choice:', index => 1, undef => '<=' }
);
$ax->print_sql_info( $info );
if ( ! $idx ) {
if ( @bu ) {
$case_parts = pop @bu;
$r_data->[-1] = [ 'case', @$case_parts ];
$else_on = 0;
next SUBSTMT;
}
pop @$r_data;
lib/App/DBBrowser/Table/Extensions/ColAliases.pm view on Meta::CPAN
}
elsif ( $menu->[$idx] eq $rearrange ) {
$rearranged = $sf->__rearrange_columns( $sql );
next COLUMN;
}
elsif ( $menu->[$idx] eq $change_table_alias ) {
$sf->__table_alias( $sql, $table_no_alias );
next COLUMN;
}
my $chosen_col = $sql->{selected_cols}[$idx - @pre];
my $prompt = $ax->normalize_space_in_stmt( $chosen_col );
my $default = $sql->{alias}{$chosen_col} // '';
$info = $ax->get_sql_info( $sql );
# Readline
my $alias = $tr->readline(
$prompt . " as ",
{ info => $info, default => $default, history => [ 'a' .. 'z' ] }
);
$ax->print_sql_info( $info );
if ( ( $alias // '' ) eq $default ) {
next COLUMN;
}
if ( ! length $alias ) {
push @bu, { %{$sql->{alias}} };
delete $sql->{alias}{$chosen_col};
next COLUMN;
lib/App/DBBrowser/Table/Extensions/ColAliases.pm view on Meta::CPAN
my @bu_selected_cols = @{$sql->{selected_cols}};
$sql->{selected_cols} = [];
my @pre = ( undef, $sf->{i}{ok} );
my $menu = [ @pre, @bu_selected_cols ];
COLUMNS: while ( 1 ) {
my $info = $ax->get_sql_info( $sql );
# Choose
my @idx = $tc->choose(
$menu,
{ %{$sf->{i}{lyt_h}}, info => $info, prompt => 'Rearragne columns:', meta_items => [ 0 .. $#pre - 1 ], no_spacebar => [ $#pre ],
include_highlighted => 2, index => 1 }
);
$ax->print_sql_info( $info );
if ( ! $idx[0] ) {
if ( @{$sql->{selected_cols}} ) {
pop @{$sql->{selected_cols}};
next COLUMNS;
}
$sql->{selected_cols} = [ @bu_selected_cols ];
return;
lib/App/DBBrowser/Table/Extensions/Columns.pm view on Meta::CPAN
@table_key = ( map( "- $_", @$user_table_keys ) );
}
my $local_table = ' Local table';
my @pre = ( undef, $local_table );
my @tmp_id_alias = map { '- ' . $ax->unquote_identifier( $_->[0] ) } @identifier_alias;
my $menu_tables = [ @pre, @tmp_id_alias, @table_key ];
my $info = $ax->get_sql_info( $sql );
# Choose
my $idx = $tc->choose(
$menu_tables,
{ %{$sf->{i}{lyt_v}}, prompt => 'Column from:', info => $info, undef => '<<', index => 1 }
);
$ax->print_sql_info( $info );
if ( ! defined $idx || ! defined $menu_tables->[$idx] ) {
next COLUMN;
}
elsif ( $menu_tables->[$idx] eq $local_table ) {
@avail_cols = @$cols;
next COLUMN;
}
else {
( run in 1.925 second using v1.01-cache-2.11-cpan-6aa56a78535 )