view release on metacpan or  search on metacpan

lib/DBD/Crate.pm  view on Meta::CPAN

package DBD::Crate;
use strict;
use DBI;
use HTTP::Tiny;
use JSON::MaybeXS;
use vars qw($VERSION $REVISION);
use vars qw($err $errstr $state $drh);
$VERSION = "0.0.3";

$err     = 0;
$errstr  = "";
$state   = "";
$drh     = undef;
my $methods_are_installed = 0;
my ($HTTP, $JSON);

sub driver {
    return $drh if $drh;
    my ($class, $attr) = @_;
    $class .= "::dr";
    $drh = DBI::_new_drh($class, {
        'Name'        => 'Crate',
        'Version'     => $VERSION,
        'Err'         => \$err,
        'Errstr'      => \$errstr,
        'State'       => \$state,
        'Attribution' => 'DBD::Crate by Mamod Mehyar',
        'AutoCommit'  => 1
    }) or return undef;
    return $drh;
}

sub http { $HTTP }
sub json { $JSON }

#====================================================================
# DBD::Crate::dr
#====================================================================
package DBD::Crate::dr; {
    use strict;
    use DBI qw(:sql_types);
    use vars qw($imp_data_size);
    use Carp qw(carp croak);
    use Data::Dumper;
    use DBI;

    $imp_data_size = 0;

    sub connect {
        my ($drh, $dburl, $user, $pass, $attr) = @_;
        my $UTF8 = defined $attr->{utf8} ?
                        $attr->{utf8} : 1;

        $JSON = JSON::MaybeXS->new({ utf8 => $UTF8 });
        $HTTP = HTTP::Tiny->new( keep_alive => 1 );

        my @addresses = ($dburl);
        my @addr;
        if ($dburl =~ s/^\[(.*?)\]$/$1/){
            @addresses = split ',', $dburl;
        }

        foreach my $addr (@addresses){
            $addr =~ s/\s+//;
            if (!$addr){
                $addr = 'http://localhost:4200';
            }

            if ($addr !~ /^http/){
                $addr = 'http://' . $addr;
            }

            if ($user || $pass){
                my $auth = ($user || '') . ':' . ($pass || '');
                $addr =~ s/^(http(?:.)?:\/\/)(.*?)/$1$auth\@$2/;
            }
            push @addr, $addr;
        }

        my ($t, $dbh) = DBI::_new_dbh($drh, {
            'Name'   => \@addr
        });

        return $dbh;
    }

    sub data_sources { return "Cratedb" }
    sub disconnect_all { 1 }
};

#====================================================================
# DBD::Crate::db
#====================================================================
package DBD::Crate::db; {
    use strict;
    use base qw(DBD::_::db);
    use vars qw($imp_data_size);
    use Data::Dumper;
    use DBI;
    use Digest::SHA1  qw(sha1_hex);

    $imp_data_size = 0;

    sub prepare {
        my ($dbh, $statement, @attr) = @_;
        my $sth = DBI::_new_sth($dbh, {
            'Statement'      => $statement,
            'ConnectionHOST' => $dbh->{Name}
        });
        return $sth;
    }

    #=============================================================
    # blob methods
    #=============================================================