view release on metacpan or  search on metacpan

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

package App::DBBrowser;
use warnings;
use strict;
use 5.016;

our $VERSION = '2.442';

use File::Basename        qw( basename );
use File::Spec::Functions qw( catfile catdir );
use Getopt::Long          qw( GetOptions );

use DBI::Const::GetInfoType;
use Encode::Locale           qw( decode_argv );
use File::HomeDir            qw();
use File::Which              qw( which );

use Term::Choose         qw();
use Term::Choose::Screen qw( clear_screen );

use App::DBBrowser::Auxil;
#use App::DBBrowser::CreateDropAttach;  # required
use App::DBBrowser::DB;
#use App::DBBrowser::From               # required
#use App::DBBrowser::Options;           # required
use App::DBBrowser::Options::Defaults;
use App::DBBrowser::Options::ReadWrite;
#use App::DBBrowser::Table;             # required


BEGIN { decode_argv() }


sub new {
    my ( $class ) = @_;
    my $info = {
        dots          => [ '...', 3 ],
        quit          => 'Quit',
        back          => 'Back',
#        continue      => 'Continue'
        confirm       => 'Confirm',
        reset         => 'Reset',
        _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 {
    my ( $sf ) = @_;
    my $home = File::HomeDir->my_home();
    if ( ! $home ) {
        print "'File::HomeDir->my_home()' could not find the home directory!\n";
        print "'db-browser' requires a home directory\n";
        exit;
    }
    $sf->{i}{home_dir} = $home;
    my $config_home;
    if ( which( 'xdg-user-dir' ) ) {
        $config_home = File::HomeDir::FreeDesktop->my_config();
    }
    else {
        $config_home = File::HomeDir->my_data();
    }
    my $app_dir = catdir( $config_home // $home, 'db_browser' );
    mkdir $app_dir or die $! if ! -d $app_dir;
    $sf->{i}{app_dir} = $app_dir;
    $sf->{i}{f_attached_db}        = catfile $app_dir, 'attached_DB.json';
    $sf->{i}{f_dir_history}        = catfile $app_dir, 'dir_history.json';
    $sf->{i}{f_subqueries}         = catfile $app_dir, 'subqueries.json';
    $sf->{i}{f_search_and_replace} = catfile $app_dir, 'search_and_replace.json';
    $sf->{i}{f_global_settings}    = catfile $app_dir, 'global_settins.json';
    my $db_cache_dir = catdir( $app_dir, 'cache_database_names' );
    mkdir $db_cache_dir or die $! if ! -d $db_cache_dir;
    $sf->{i}{db_cache_file_fmt} = catfile $db_cache_dir, 'databases_%s.json';
    my $plugin_config_dir = catdir( $app_dir, 'config_plugins' );
    mkdir $plugin_config_dir or die $! if ! -d $plugin_config_dir;
    $sf->{i}{plugin_config_file_fmt} = catfile $plugin_config_dir, 'config_%s.json';
    $sf->{i}{db_config_file_fmt}     = catfile $plugin_config_dir, 'config_%s_Databases.json';
}


sub __options {
    my ( $sf ) = @_;
    if ( ! eval {
        my $help;
        GetOptions (
            'h|?|help' => \$help,
            's|search' => \$sf->{i}{search},
        );
        if ( $help ) {
            print clear_screen();
            require App::DBBrowser::Options;
            my $op = App::DBBrowser::Options->new( $sf->{i}, $sf->{o} );
            $op->set_options();
        }
        1 }
    ) {
        my $ax = App::DBBrowser::Auxil->new( $sf->{i}, {}, {} );
        $ax->print_error_message( $@ );
        while ( $ARGV[0] && $ARGV[0] =~ /^-/ ) {
            my $arg = shift @ARGV;