view release on metacpan or  search on metacpan

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

package DBD::D1;

# DBD::D1 - DBI driver for Cloudflare D1 (SQLite-compatible serverless database)
# Communicates with Cloudflare D1 via the REST API using HTTP::Tiny and JSON::PP.

use strict;
use warnings;

our $VERSION  = '0.02';
our $err      = 0;
our $errstr   = '';
our $sqlstate = '';
our $drh      = undef;

use DBI ();
use DBI::DBD;

sub driver {
    return $drh if $drh;
    my ($class, $attr) = @_;
    $class .= '::dr';
    $drh = DBI::_new_drh($class, {
        Name        => 'D1',
        Version     => $VERSION,
        Err         => \$DBD::D1::err,
        Errstr      => \$DBD::D1::errstr,
        State       => \$DBD::D1::sqlstate,
        Attribution => 'DBD::D1',
    }) or return undef;
    return $drh;
}

sub CLONE { undef $drh }

# ---------------------------------------------------------------
# Internal HTTP helper
# ---------------------------------------------------------------
package DBD::D1::_http;

use strict;
use warnings;
use HTTP::Tiny ();
use JSON::PP   ();

my $json = JSON::PP->new->utf8->allow_nonref;

sub _ssl_available { HTTP::Tiny->can_ssl ? 1 : 0 }

# Returns ($result_arrayref, undef) on success or (undef, $error_string) on failure.
sub query {
    my ($account_id, $database_id, $api_token, $sql, $params) = @_;

    unless (_ssl_available()) {
        return (undef,
            'DBD::D1 requires HTTPS. Install IO::Socket::SSL and Net::SSLeay: '
          . 'cpanm IO::Socket::SSL Net::SSLeay');
    }

    my $url = sprintf(
        'https://api.cloudflare.com/client/v4/accounts/%s/d1/database/%s/query',
        $account_id, $database_id,
    );

    my $body = $json->encode({
        sql    => $sql,
        params => ($params && @$params) ? $params : [],
    });

    my $http = HTTP::Tiny->new(
        default_headers => {
            'Authorization' => "Bearer $api_token",
            'Content-Type'  => 'application/json',
        },
        timeout => 30,
    );

    my $res = $http->post($url, { content => $body });

    # Try to parse JSON response to get detailed error info
    my $data;
    if ($res->{content}) {
        $data = eval { $json->decode($res->{content}) };
    }

    unless ($res->{success}) {
        my $detail = $res->{content} // '';
        if ($res->{status} == 599 && $detail =~ /ssl|IO::Socket/i) {
            return (undef,
                'HTTPS failed (status 599). '
              . 'Install IO::Socket::SSL and Net::SSLeay: '
              . 'cpanm IO::Socket::SSL Net::SSLeay');
        }
        
        # If we have JSON error details, use those
        if ($data && ref $data eq 'HASH') {
            if (!$data->{success}) {
                my $errs = $data->{errors} // [];
                if (@$errs) {
                    my $msg = $errs->[0]{message} // 'Unknown D1 API error';
                    return (undef, $msg);
                }
            }
        }
        
        return (undef, sprintf('HTTP %s: %s', $res->{status}, $res->{reason} // 'Unknown'));
    }

    if (!$data) {
        $data = eval { $json->decode($res->{content}) };
        if ($@) { return (undef, "JSON decode error: $@") }
    }

    unless ($data->{success}) {
        my $errs = $data->{errors} // [];
        my $msg  = @$errs ? $errs->[0]{message} : 'Unknown D1 API error';
        return (undef, $msg);
    }

    return ($data->{result}, undef);
}

# ---------------------------------------------------------------
# DBD::D1::dr  – driver handle
# ---------------------------------------------------------------
package DBD::D1::dr;

use strict;
use warnings;

$DBD::D1::dr::imp_data_size = 0;

# DSN:  dbi:D1:account_id=<id>;database_id=<id>
# Pass Cloudflare API token as $password.
sub connect {
    my ($drh, $dsn, $user, $auth, $attr) = @_;

    my %dsnargs;
    for my $pair (split /;/, $dsn) {
        my ($k, $v) = split /=/, $pair, 2;
        $dsnargs{$k} = $v if defined $k && defined $v;
    }

    # Use DBI->set_err on the drh with the caller's err/errstr so that
    # PrintError/RaiseError on the caller handle control output, not the drh.
    my $account_id = $dsnargs{account_id}
        or return $drh->set_err(1,
            "DBD::D1 connect: 'account_id' missing from DSN", undef, 'connect');

    my $database_id = $dsnargs{database_id}
        or return $drh->set_err(1,
            "DBD::D1 connect: 'database_id' missing from DSN", undef, 'connect');

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

=encoding UTF-8

=head1 NAME

DBD::D1 - DBI driver for Cloudflare D1 (serverless SQLite)

=head1 VERSION

0.02

=head1 SYNOPSIS

    use DBI;

    my $dbh = DBI->connect(
        'dbi:D1:account_id=<ACCOUNT_ID>;database_id=<DATABASE_ID>',
        undef,
        $ENV{CF_API_TOKEN},
        { RaiseError => 1, PrintError => 0 },
    ) or die $DBI::errstr;

    my $sth = $dbh->prepare('SELECT * FROM users WHERE active = ?');
    $sth->execute(1);

    while (my $row = $sth->fetchrow_hashref) {
        printf "%s <%s>\n", $row->{name}, $row->{email};
    }

    $dbh->disconnect;

=head1 DESCRIPTION

B<DBD::D1> is a L<DBI> driver for L<Cloudflare D1|https://developers.cloudflare.com/d1/>,
Cloudflare's serverless SQLite-compatible relational database.

It communicates via the D1 REST API using L<HTTP::Tiny> and L<JSON::PP>
(both ship with Perl 5.14+), so no compiled extensions are required.

=head1 DSN FORMAT

    dbi:D1:account_id=<ACCOUNT_ID>;database_id=<DATABASE_ID>

=head1 AUTHENTICATION

Pass your Cloudflare API token (B<D1 Edit> permission) as the C<$password>
argument to C<DBI-E<gt>connect()>.

=head1 LIMITATIONS

=over 4

=item * B<AutoCommit only> – D1 REST has no multi-statement transaction support.

=item * B<Column ordering> – rows arrive as JSON objects; column order follows
C<sort> on key names. Use C<fetchrow_hashref> for reliable named access.

=back

=head1 DEPENDENCIES

L<DBI>, L<HTTP::Tiny>, L<JSON::PP>, L<IO::Socket::SSL>, L<Net::SSLeay>

=head1 AUTHOR

Aldo Montes Zapata, C<< <amontes@cpan.org> >>

=head1 COPYRIGHT (c)

Copyright 2026 by Aldo Montes Zapata C<< <amontes@cpan.org> >>.

=head1 LICENSE

Same terms as Perl itself.

=cut