view release on metacpan or  search on metacpan

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

        if ( ! /^[$iqc']/ ) { s/\s+/ /g; s|\(\s|(|; s|\s\)|)| };
        $_
    } split $split_rx, $stmt;
    return $stmt;
}


sub major_server_version {
    my ( $sf ) = @_;
    my $dbms = $sf->{i}{dbms};
    my $dbh = $sf->{d}{dbh};
    my $major_server_version;
    if ( $dbms eq 'Firebird' ) {
        eval {
            my ( $firebird_version ) = $dbh->selectrow_array( "SELECT RDB\$GET_CONTEXT('SYSTEM', 'ENGINE_VERSION') FROM RDB\$DATABASE" );
            ( $major_server_version  ) = $firebird_version =~ /^(\d+)\./;
        };
        return $major_server_version // 3;
    }
    else {
        my $database_version  = $dbh->get_info( $GetInfoType{SQL_DBMS_VER} );
        ( $major_server_version ) = $database_version =~ /^v?(\d+)\D/i;
        if ( $dbms eq 'Pg' ) {
            return $major_server_version // 10;
        }
        elsif ( $dbms eq 'Oracle' ) {
            return $major_server_version // 12;
        }
        elsif ( $dbms eq 'MSSQL' ) {
            return $major_server_version // 16;
        }
    }
}


sub clone_data {
    my ( $sf, $data ) = @_;
    require Storable;
    return Storable::dclone( $data );
}


sub format_list {
    my ( $sf, $list ) = @_;
    return    if ! defined $list;
    return '' if ! @$list;
    my $sep = ', ';
    my $formated_list = join( $sep, @$list );
    $formated_list =~ s/$sep(?=$list->[-1]\z)/ or /;
    return $formated_list;
}


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;
        return;
    }
    my $json = JSON::MaybeXS->new->utf8->pretty->canonical->encode( $ref );
    open my $fh, '>', $file_fs or die "$file_fs: $!";
    print $fh $json;
    close $fh;
}


sub read_json {
    my ( $sf, $file_fs ) = @_;
    if ( ! defined $file_fs || ! -f $file_fs ) {
        return;
    }
    open my $fh, '<', $file_fs or die "$file_fs: $!";
    my $json = do { local $/; <$fh> };
    close $fh;
    my $ref;
    if ( ! eval {
        $ref = decode_json( $json ) if $json;
        1 }
    ) {
        die "In '$file_fs':\n$@";
    }
    return $ref;
}





1;

__END__