File Coverage

blib/lib/Algorithm/VectorClocks.pm

Criterion	Covered	Total	%
statement	91	106	85.8
branch	11	20	55.0
condition	11	18	61.1
subroutine	22	24	91.6
pod	8	8	100.0
total	143	176	81.2

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,
    '!=' => \¬_equal,
    'ne' => \¬_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 ];
        $i += @equals;
    }
    @ret;
}

sub are_independent {
    my @vcs = @_;
    for (my $j = 0; $j < @vcs; $j++) {
        for (my $k = $j+1; $k < @vcs; $k++) {
            return 1 if $vcs[$j]->_is_independent($vcs[$k]);
        }
    }
}

sub _is_independent {
    my $self = shift;
    my($other) = @_;
    $other = __PACKAGE__->new($other);
    my @ids = _list_ids($self, $other);
    my $res = 0;
    for my $id (@ids) {
        my $r = ($self->clocks->{$id} || 0) - ($other->clocks->{$id} || 0);
        if    ($res == 0 ) { $res = $r }
        elsif ($r   == 0 ) {           }
        elsif ($res != $r) { return 1  }
    }
    0;
}

sub _compare {
    my $self = shift;
    my($other) = @_;
    $other = __PACKAGE__->new($other);
    my @ids = _list_ids($self, $other);
    my $res = 0;
    for my $id (@ids) {
        my $r = ($self->clocks->{$id} || 0) - ($other->clocks->{$id} || 0);
        if    ($res == 0 ) { $res = $r }
        elsif ($r   == 0 ) {           }
        elsif ($res != $r) { return 0  } # independent
    }
    $res;
}

sub _list_ids { uniq map { keys %{ $_->clocks } } @_ }

1; # Magic true value required at end of module
__END__