view release on metacpan or  search on metacpan

lib/BusyBird/StatusStorage/Common.pm  view on Meta::CPAN

package BusyBird::StatusStorage::Common;
use v5.8.0;
use strict;
use warnings;
use Carp;
use Exporter 5.57 qw(import);
use BusyBird::Util qw(future_of);
use BusyBird::DateTime::Format;
use DateTime;
use Try::Tiny;
use Future::Q;

our @EXPORT_OK = qw(contains ack_statuses get_unacked_counts);

sub ack_statuses {
    my ($self, %args) = @_;
    croak 'timeline arg is mandatory' if not defined $args{timeline};
    my $ids;
    if(defined($args{ids})) {
        if(!ref($args{ids})) {
            $ids = [$args{ids}];
        }elsif(ref($args{ids}) eq 'ARRAY') {
            $ids = $args{ids};
            croak "ids arg array must not contain undef" if grep { !defined($_) } @$ids;
        }else {
            croak "ids arg must be either undef, status ID or array-ref of IDs";
        }
    }
    my $max_id = $args{max_id};
    my $timeline = $args{timeline};
    my $callback = $args{callback} || sub {};
    my $ack_str = BusyBird::DateTime::Format->format_datetime(
        DateTime->now(time_zone => 'UTC')
    );
    my @subfutures = (_get_unacked_statuses_by_ids_future($self, $timeline, $ids));
    if(!defined($ids) || defined($max_id)) {
        push @subfutures, future_of(
            $self, 'get_statuses',
            timeline => $timeline,
            max_id => $max_id, count => 'all',
            ack_state => 'unacked'
        );
    }
    Future::Q->needs_all(@subfutures)->then(sub {
        my @statuses_list = @_;
        my @target_statuses = _uniq_statuses(map { @$_ } @statuses_list);
        if(!@target_statuses) {
            return 0;
        }
        $_->{busybird}{acked_at} = $ack_str foreach @target_statuses;
        return future_of(
            $self, 'put_statuses',
            timeline => $timeline, mode => 'update',
            statuses => \@target_statuses,
        );
    })->then(sub {
        ## invocations of $callback should be at the same level of
        ## then() chain, because $callback might throw exception and
        ## we should not catch that exception.
        
        my ($changed) = @_;
        @_ = (undef, $changed);
        goto $callback;
    }, sub {
        my ($error) = @_;
        @_ = ($error);
        goto $callback;
    });
}