view release on metacpan or  search on metacpan

lib/Algorithm/VectorClocks.pm  view on Meta::CPAN

package Algorithm::VectorClocks;

use warnings;
use strict;
use Carp;

use version; our $VERSION = qv('0.1.2');

use JSON::Any;
use List::MoreUtils qw(uniq);
use List::Util qw(max);
use Perl6::Export::Attrs;
use Sys::Hostname;

use overload (
    '""' => \&serialize,
    '++' => \&increment,
    '+=' => \&merge,
    '==' => \&equal,
    'eq' => \&equal,
    '!=' => \&not_equal,
    'ne' => \&not_equal,
    fallback => undef,
);

use base qw(Class::Accessor::Fast Class::Data::Inheritable);

__PACKAGE__->mk_accessors(qw(clocks));
__PACKAGE__->mk_classdata($_) for qw(id json);

__PACKAGE__->id(hostname);
__PACKAGE__->json(JSON::Any->new);

sub new {
    my $class = shift;
    my($arg) = @_;
    my $self = UNIVERSAL::isa($arg, $class) ? $arg
             :                                { clocks => $class->json->jsonToObj($arg || '{}') };
    bless $self, $class;
}

sub serialize {
    my $self = shift;
    $self->json->objToJson($self->clocks);
}

sub increment {
    my $self = shift;
    $self->clocks->{ $self->id }++; # increment its own clock
    $self;
}

sub merge {
    my $self = shift;
    my($other) = @_;
       $other = __PACKAGE__->new($other);
    my @ids = _list_ids($self, $other);
    for my $id (@ids) {
        $self->clocks->{$id}
            = max( ($self->clocks->{$id} || 0), ($other->clocks->{$id} || 0) );
    }
    $self;
}

sub equal {
    my @vcs = @_;
    $_ = __PACKAGE__->new($_) for @vcs;
    my @ids = _list_ids(@vcs);
    for my $id (@ids) {
        return 0
            unless ($vcs[0]->clocks->{$id} || 0) == ($vcs[1]->clocks->{$id} || 0);
    }
    return 1;
}

sub not_equal { !equal(@_) }

sub order_vector_clocks :Export(:DEFAULT) {
    my($vcs) = @_;
    my @vcs;
    while (my($id, $vc) = each %$vcs) {
        $vc = __PACKAGE__->new($vc);
        $vc->{_id} = $id;
        push @vcs, $vc;
    }
    @vcs = sort { _compare($b, $a) } @vcs;
    _pack_independent_vector_clocks(@vcs);
}

sub _pack_independent_vector_clocks {
    my @vcs = @_;
    my @ret;
    my $i = 0;
    while ($i < @vcs) {
        my @equals = (
            $vcs[$i],
            (grep { _compare($vcs[$i], $_) == 0 } @vcs[($i+1)..$#vcs]),
        );
        push @ret, @equals == 1 ? $equals[0]->{_id} : [ map $_->{_id}, @equals ];