#!/usr/bin/perl

package PG_LSN;

=pod

=head1 PG_LSN

Value-class to represent a PostgreSQL LSN, our funky uint64 representation.

Values are immutable, operators return new instances.

Supports comparison operators and incrementing.

=cut

use strict;
use warnings;
use Exporter qw(import);
use Carp;
use Scalar::Util qw(blessed reftype looks_like_number);
use Data::Dumper;

our @EXPORT = qw(pg_lsn);
our @EXPORT_OK = qw();

# Set up overloads at the end so the module can be run directly to check it.
use overload
    '<=>'  => "pg_lsn_numcmp",
    '+' => "pg_lsn_add",
    '""' => "pg_lsn_str";

=over

=item PG_LSN->new($class, $value)

Construct a value. Use L<pg_lsn()> instead.

=cut

# Terse Data::Dumper output for argument errors
sub _vardump {
    return Data::Dumper->new([@_])->Indent(0)->Varname('')->Terse(1)->Maxdepth(1)->Dump;
}

# Constructor, usually private
sub new {
	my ($klass, $value) = @_;
	my $self = bless {}, $klass;
	$self->{_lsn} = $self->_parse_as_lsn($value);
    ((looks_like_number($self->{_lsn})) && ($self->{_lsn} >= 0)) or confess "internal error creating PG_LSN";
	return $self;
}

# String lsn to number 
sub _parse_lsn_string {
    my ($self, $value) = @_;
    if ($value =~ /([[:xdigit:]]{1,8})\/([[:xdigit:]]{1,8})/) {
        my ($highword, $lowword) = (hex($1),hex($2));
        return ($highword << 32) + $lowword;
    } else {
        confess('Could not parse ' . _vardump($value) . ' as lsn');
    }
}

# String, number or PG_LSN instance to number
sub _parse_as_lsn {
    my ($self, $value) = @_;
    defined($value) or confess("constructing PG_LSN from undef");
    if (ref($value) eq '') {
        if (looks_like_number($value)) {
            $value >= 0 or confess("negative value \"$value\" passed as pg_lsn operand");
            return $value;
        } else {
            return $self->_parse_lsn_string($value);
        }
    } elsif (blessed($value) && $value->isa('PG_LSN')) {
        # unwrap PG_LSN instance value
        return $value->int_value();
    } else {
        if ($value eq '0/0') {
            confess("val: $value" . ", ref: " . ref($value) . ", num: " . looks_like_number($value) . ", repr: " . _vardump($value));
        }
        confess('Could not convert ' . _vardump($value) . ' to PG_LSN');
    }
}

=pod

=item PG_LSN::pg_lsn($value)

Construct a new C<PG_LSN> with C<$value>.

This is not a method, do not call it with the -> syntax.

=cut

sub pg_lsn {
	my ($value) = @_;
	return PG_LSN->new($value);
}

=pod

=item int_value()

Return unsigned long integer representation of the lsn.

=cut

sub int_value {
    my ($self) = @_;
    return $self->{_lsn};
}

=pod

=item str_value()

Return lsn-string representation of the lsn.

=cut

sub str_value {
    my ($self) = @_;
    return sprintf("%X/%08X", ($self->{_lsn} >> 32), ($self->{_lsn} & 0xFFFFFFFF));
}

=pod

=back

=cut

# Operator implementatations

# Implementation of <=> which is perl's numeric cmp(), see perldoc perlop and
# perldoc overload
#
# This implementation doesn't properly respect subclassing. If you want to
# subclass PG_LSN (why?!@##) you'll want to change it to detect which operand
# is a PG_LSN instance and resolve the _parse_as_lsn method through it.
#
sub pg_lsn_numcmp {
	my ($lhs, $rhs, $swapped) = @_;
    return unless scalar(@_);
    defined($swapped) or confess("cannot mutate PG_LSN");
    my $lhs_num = $lhs->_parse_as_lsn($lhs);
    my $rhs_num = $lhs->_parse_as_lsn($rhs);
    ($rhs_num, $lhs_num) = ($lhs_num, $rhs_num) if $swapped;
	return $lhs_num <=> $rhs_num;
}

sub pg_lsn_add {
	my ($lhs, $rhs, $swapped) = @_;
    return unless scalar(@_);
    looks_like_number($rhs) or confess("second operand of pg_lsn + should be a simple number but got " . _vardump($rhs));
    # Result is new instance, since pg_lsn is immutable.
    return ref($lhs)->new($lhs->int_value + $rhs);
}

sub pg_lsn_str {
    my ($lhs, $rhs, $swapped) = @_;
    return unless scalar(@_);
    return $lhs->str_value;
}

# Don't load unless minimally sane
pg_lsn('0/0') == pg_lsn('0/0') or confess;
pg_lsn('0/0') == 0 or confess;
pg_lsn('0/0') == "0" or confess;
pg_lsn('FFFFFFFF/FFFFFFFF') == pg_lsn('FFFFFFFF/FFFFFFFF') or confess;
pg_lsn(0) == pg_lsn('0/0') or confess;
pg_lsn(0) < pg_lsn(1) or confess;
pg_lsn(0) < 1 or confess;
0 < pg_lsn(1) or confess;
pg_lsn(0) <=> pg_lsn(1) or confess;
0 <=> pg_lsn(1) or confess;
pg_lsn(0) <=> 1 or confess;
(pg_lsn(0) + 1) == pg_lsn(1) or confess;

1;

# vim: ts=4 sw=4 ai et