view release on metacpan or  search on metacpan

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

#
#  You may distribute under the terms of either the GNU General Public
#  License or the Artistic License, as specified in the Perl README file.

use strict;
use warnings;

package DBD::Patroni;

use DBI;
require DBD::Pg;

our $VERSION = '0.03';
our $drh     = undef;    # Driver handle
our $err     = 0;        # DBI error code
our $errstr  = '';       # DBI error string
our $state   = '';       # DBI state
our $rr_idx  = 0;        # Round-robin index for replica selection

# Load submodules
require DBD::Patroni::dr;
require DBD::Patroni::db;
require DBD::Patroni::st;

# DBI driver method - required for DBI->connect("dbi:Patroni:...")
sub driver {
    return $drh if $drh;
    my ( $class, $attr ) = @_;

    $class .= "::dr";

    $drh = DBI::_new_drh(
        $class,
        {
            Name        => 'Patroni',
            Version     => $VERSION,
            Attribution => 'DBD::Patroni by Xavier Guimard',
        }
    );
    return $drh;
}

# Discover Patroni cluster via REST API
sub _discover_cluster {
    my ( $urls, $timeout ) = @_;
    $timeout //= 3;

    require LWP::UserAgent;
    require JSON;

    my $ua = LWP::UserAgent->new(
        timeout   => $timeout,
        env_proxy => 1,
    );

    for my $url ( split /[,\s]+/, $urls ) {
        next unless $url;
        my $resp = $ua->get($url);
        next unless $resp->is_success;

        my $data = eval { JSON::decode_json( $resp->decoded_content ) };
        next if $@ or !$data->{members} or ref( $data->{members} ) ne 'ARRAY';

        my ($leader) = grep { $_->{role} eq 'leader' } @{ $data->{members} };
        my @replicas = grep { $_->{role} ne 'leader' } @{ $data->{members} };

        return ( $leader, @replicas ) if $leader;
    }
    return;
}

# Select a replica based on load balancing mode
sub _select_replica {
    my ( $replicas, $mode ) = @_;
    return undef unless $replicas && @$replicas;

    $mode //= 'round_robin';

    if ( $mode eq 'random' ) {
        return $replicas->[ int( rand(@$replicas) ) ];
    }
    elsif ( $mode eq 'leader_only' ) {
        return undef;
    }
    else {    # round_robin
        return $replicas->[ $rr_idx++ % @$replicas ];
    }
}

# Parse and extract Patroni parameters from DSN
sub _parse_dsn {
    my ($dsn) = @_;
    my %params;
    my @remaining;

    for my $part ( split /;/, $dsn ) {
        if ( $part =~ /^(patroni_url|patroni_lb|patroni_timeout)=(.*)$/i ) {
            $params{ lc($1) } = $2;
        }
        else {
            push @remaining, $part;
        }
    }

    return ( join( ';', @remaining ), \%params );
}

# Build DSN with host/port, cleaning up any existing host/port params
sub _build_dsn {
    my ( $dsn, $host, $port ) = @_;

    # Remove existing host/port parameters
    $dsn =~ s/(?:host|port)=[^;]*;?//gi;

    # Clean up multiple semicolons and leading/trailing semicolons
    $dsn =~ s/;+/;/g;
    $dsn =~ s/^;|;$//g;

    # Append new host/port
    return "$dsn;host=$host;port=$port";
}