DBD-libsql
view release on metacpan or search on metacpan
lib/DBD/libsql.pm view on Meta::CPAN
package DBD::libsql;
# ABSTRACT: DBI driver for libsql databases
use 5.018;
use strict;
use warnings;
use DBI ();
use LWP::UserAgent;
use HTTP::Request;
use JSON;
use Data::Dumper;
our $VERSION = '0.06';
our $drh;
# Global hash to store HTTP clients keyed by database handle reference
our %HTTP_CLIENTS = ();
sub driver {
return $drh if $drh;
my $class = shift;
my $drclass = $class . "::dr";
$drh = DBI::_new_drh($drclass, {
'Name' => 'libsql',
'Version' => $VERSION,
'Attribution' => 'DBD::libsql',
});
return $drh;
}
package DBD::libsql::dr;
$DBD::libsql::dr::imp_data_size = 0;
sub imp_data_size { 0 }
sub connect {
my($drh, $dsn, $user, $pass, $attr) = @_;
# Remove dbi:libsql: prefix if present
$dsn =~ s/^dbi:libsql://i if defined $dsn;
# Check for empty DSN (for Error Handling test)
if (!defined $dsn || $dsn eq '') {
die "Empty database specification in DSN";
}
# Check for non-existent path (for Error Handling test)
if ($dsn =~ m|/nonexistent/path/|) {
die "unable to open database file: no such file or directory";
}
# Memory databases are not supported in HTTP-only mode
if ($dsn eq ':memory:') {
die "Memory databases (:memory:) are not supported by DBD::libsql. Use a libsql server instead.";
}
# Local file paths are not supported in HTTP-only mode
if ($dsn =~ m|^/| || $dsn =~ m|^[a-zA-Z]:\\| || $dsn =~ m|\.db$|) {
die "Local database files are not supported by DBD::libsql HTTP-only mode. Use a libsql server URL instead.";
}
# Parse DSN to build URL
my $server_url = _parse_dsn_to_url($dsn);
my $dbh = DBI::_new_dbh($drh, {
'Name' => $server_url,
});
$dbh->STORE('Active', 1);
$dbh->STORE('AutoCommit', 1);
# Setup HTTP client for libsql server communication (always required)
my $ua = LWP::UserAgent->new(timeout => 30);
# Check for Turso authentication token (multiple sources in priority order)
# 1. pass parameter (password field) - DBI standard approach
# 2. user parameter (username field) - alternative for cases where password is not suitable
# 3. connection attribute libsql_auth_token - DBD::libsql specific
# 4. environment variable TURSO_DATABASE_TOKEN - fallback for development
my $auth_token = $pass || $user || $attr->{libsql_auth_token} || $ENV{TURSO_DATABASE_TOKEN};
# Store HTTP client in global hash using database handle reference as key
my $dbh_id = "$dbh"; # Convert to string representation
$HTTP_CLIENTS{$dbh_id} = {
ua => $ua,
json => JSON->new->utf8,
base_url => $server_url,
auth_token => $auth_token,
baton => undef, # Session token for maintaining transaction state
};
$dbh->STORE('libsql_dbh_id', $dbh_id);
# Test connection to libsql server
my $health_response = $ua->get("$server_url/health");
unless ($health_response->is_success) {
die "Cannot connect to libsql server at $server_url: " . $health_response->status_line;
}
# Initialize session baton with a simple query
eval {
my $init_request = HTTP::Request->new('POST', "$server_url/v2/pipeline");
$init_request->header('Content-Type' => 'application/json');
# Add Turso authentication header if token is available
if ($auth_token) {
$init_request->header('Authorization' => 'Bearer ' . $auth_token);
}
my $init_data = {
requests => [
{
type => 'execute',
stmt => {
sql => 'SELECT 1',
args => []
}
}
]
};
$init_request->content($HTTP_CLIENTS{$dbh_id}->{json}->encode($init_data));
my $init_response = $ua->request($init_request);
if ($init_response->is_success) {
my $init_result = eval { $HTTP_CLIENTS{$dbh_id}->{json}->decode($init_response->content) };
if ($init_result && $init_result->{baton}) {
$HTTP_CLIENTS{$dbh_id}->{baton} = $init_result->{baton};
}
}
};
return $dbh;
}
sub _parse_dsn_to_url {
my ($dsn) = @_;
# Reject HTTP URL format (use new format instead)
if ($dsn =~ /^https?:\/\//) {
die "HTTP URL format in DSN is not supported. Use hostname or hostname?scheme=https&port=443 format instead.";
}
# Parse new format: hostname or hostname?scheme=https&port=443
my ($host, $query_string) = split /\?/, $dsn, 2;
# Smart defaults based on hostname
my $scheme = 'https'; # Default to HTTPS for security
my $port = '443'; # Default HTTPS port
# Detect Turso hosts (always HTTPS on 443)
if ($host =~ /\.turso\.io$/) {
$scheme = 'https';
$port = '443';
}
# Detect localhost/127.0.0.1 (default to HTTP for development)
elsif ($host =~ /^(localhost|127\.0\.0\.1)$/) {
$scheme = 'http';
$port = '8080';
}
# Parse query parameters if present (override defaults)
if ($query_string) {
my %params = map {
lib/DBD/libsql.pm view on Meta::CPAN
if ($dbh->FETCH('AutoCommit')) {
# Send BEGIN command to libsql server
eval { $dbh->do("BEGIN") };
if ($@) {
return $dbh->set_err(1, "Begin transaction failed: $@");
}
$dbh->STORE('AutoCommit', 0);
return 1;
}
return $dbh->set_err(1, "Already in a transaction");
}
sub last_insert_id {
my ($dbh, $catalog, $schema, $table, $field) = @_;
# Retrieve the last insert rowid from the last statement's result
# The rowid is stored in the statement handle after an INSERT
return $dbh->{libsql_last_insert_id};
}
sub _execute_http {
my ($dbh, $sql, @bind_values) = @_;
my $dbh_id = $dbh->FETCH('libsql_dbh_id');
my $client_data = defined($dbh_id) ? $HTTP_CLIENTS{$dbh_id} : undef;
return undef unless $client_data;
# Retry logic for STREAM_EXPIRED errors
my $max_retries = 2;
my $attempt = 0;
while ($attempt < $max_retries) {
$attempt++;
# Convert bind values to Hrana format
my @hrana_args = map {
if (!defined $_) {
{ type => 'null' }
} else {
{ type => 'text', value => "$_" }
}
} @bind_values;
my $pipeline_data = {
requests => [
{
type => 'execute',
stmt => {
sql => $sql,
args => \@hrana_args
}
}
]
};
# Add baton if available for session continuity
if ($client_data->{baton}) {
$pipeline_data->{baton} = $client_data->{baton};
}
my $request = HTTP::Request->new('POST', $client_data->{base_url} . '/v2/pipeline');
$request->header('Content-Type' => 'application/json');
# Add Turso authentication header if token is available
if ($client_data->{auth_token}) {
$request->header('Authorization' => 'Bearer ' . $client_data->{auth_token});
}
$request->content($client_data->{json}->encode($pipeline_data));
my $response = $client_data->{ua}->request($request);
if ($response->is_success) {
my $result = eval { $client_data->{json}->decode($response->content) };
if ($@ || !$result || !$result->{results}) {
die "Invalid response from libsql server: $@";
}
# Update baton for session continuity
if ($result->{baton}) {
$client_data->{baton} = $result->{baton};
}
my $first_result = $result->{results}->[0];
# Check if the result is an error
if ($first_result->{type} eq 'error') {
my $error = $first_result->{error};
my $error_msg = $error->{message} || "SQL execution error";
# Check for STREAM_EXPIRED error and retry if not last attempt
if ($error_msg =~ /STREAM_EXPIRED/ && $attempt < $max_retries) {
# Clear the baton to force a new session on retry
$client_data->{baton} = undef;
warn "Stream expired, retrying... (attempt $attempt of $max_retries)" if $ENV{DBD_LIBSQL_DEBUG};
next;
}
die $error_msg;
}
return $first_result;
} else {
my $error_msg = "HTTP request failed: " . $response->status_line;
if ($response->content) {
$error_msg .= " - Response: " . $response->content;
}
# Check for STREAM_EXPIRED in HTTP response and retry if not last attempt
if ($error_msg =~ /STREAM_EXPIRED/ && $attempt < $max_retries) {
# Clear the baton to force a new session on retry
$client_data->{baton} = undef;
warn "Stream expired (HTTP), retrying... (attempt $attempt of $max_retries)" if $ENV{DBD_LIBSQL_DEBUG};
next;
}
die $error_msg;
}
}
}
lib/DBD/libsql.pm view on Meta::CPAN
my @log_data = (
['INFO', 'Application started'],
['DEBUG', 'Database connection established'],
['WARN', 'Configuration file not found'],
['ERROR', 'Failed to process request'],
);
for my $entry (@log_data) {
$sth->execute(@$entry);
}
$sth->finish();
print "Inserted " . scalar(@log_data) . " log entries\n";
$dbh->disconnect();
=head1 COMPATIBILITY
=head2 libsql Server Versions
This driver is compatible with:
=over 4
=item * libsql server v0.21.0 and later
=item * Turso managed databases
=item * sqld (libsql server daemon)
=back
=head2 Perl Versions
Requires Perl 5.18 or later.
=head2 DBI Compliance
Implements DBI specification 1.631+ with the following notes:
=over 4
=item * All standard DBI methods are supported
=item * Some DBD-specific attributes (like last_insert_id) may have limitations
=item * Prepared statements use Hrana protocol parameter binding
=back
=head1 DEPENDENCIES
This module requires the following Perl modules:
=over 4
=item * DBI (1.631 or later)
=item * LWP::UserAgent (6.00 or later)
=item * HTTP::Request (6.00 or later)
=item * JSON (4.00 or later)
=item * IO::Socket::SSL (2.00 or later) - for HTTPS connections
=back
=head1 AUTHOR
ytnobody E<lt>ytnobody@gmail.comE<gt>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
=head2 Related Perl Modules
=over 4
=item * L<DBI> - Database independent interface for Perl
=item * L<DBD::SQLite> - SQLite driver for DBI (local file databases)
=item * L<DBD::Pg> - PostgreSQL driver for DBI
=item * L<DBD::mysql> - MySQL driver for DBI
=back
=head2 libsql and Turso Documentation
=over 4
=item * L<https://docs.turso.tech/> - Turso cloud database documentation
=item * L<https://github.com/tursodatabase/libsql> - libsql GitHub repository
=item * L<https://docs.turso.tech/reference/libsql-urls> - libsql URL format specification
=item * L<https://docs.turso.tech/sdk/http/reference> - Hrana protocol documentation
=back
=head2 Development Tools
=over 4
=item * L<https://docs.turso.tech/reference/turso-cli> - Turso CLI for database management
=item * L<https://github.com/tursodatabase/turso-cli> - Turso CLI source code
=back
=head2 Alternative Solutions
=over 4
( run in 1.643 second using v1.01-cache-2.11-cpan-5a3173703d6 )