view release on metacpan or  search on metacpan

lib/App/SD/Replica/redmine/PullEncoder.pm  view on Meta::CPAN

package App::SD::Replica::redmine::PullEncoder;
use Any::Moose;
extends 'App::SD::ForeignReplica::PullEncoder';

# use YAML::XS qw(Dump);
use Params::Validate qw(:all);

has sync_source => (
    isa => 'App::SD::Replica::redmine',
    is  => 'rw',
    required => 1
);

sub ticket_id {
    my ($self, $ticket) = @_;
    return $ticket->id;
}

sub find_matching_tickets {
    my $self = shift;
    my %query = (@_);

    my $redmine = $self->sync_source->redmine;
    my $search = $redmine->search_ticket( $query{query} );

    my @results = $search->results;
    return \@results;
}

sub find_matching_transactions {
    my $self = shift;
    my %args = validate( @_, { ticket => 1, starting_transaction => 1 } );

    my @txns;
    my $raw_txn = $args{ticket}->histories;

    for my $txn (@$raw_txn) {
        push @txns, {
            timestamp => $txn->date->epoch,
            serial => $txn->id,
            object => $txn
        }
    }

    # if ($args{ticket}->id == 420) {
    #     die Dump({
    #         ticket_id => $args{ticket}->id,
    #         txn => [ map { { id => $_->{serial}, comment => $_->{comment} } } @txns ]
    #     });
    # }

    return \@txns;
}

sub translate_ticket_state {
    my $self         = shift;
    my $ticket       = shift;
    my $transactions = shift;

    my $final_state = {
        $self->sync_source->uuid . '-id' => $ticket->id,
        status      => lc($ticket->status),
        summary     => $ticket->subject,
        description => $ticket->description,
        priority    => $ticket->priority,
        created     => $ticket->created_at->ymd . " " . $ticket->created_at->hms,
        creator     => $ticket->author->email
    };
    my $initial_state = {%$final_state};

    for my $txn ( sort { $b->{'serial'} <=> $a->{'serial'} } @$transactions ) {
        $txn->{post_state} = { %$final_state };

        if ($txn->{serial} == 0) {
            $txn->{pre_state} = {};
            last;
        }

        my $property_changes = $txn->{object}->property_changes;
        while (my ($name, $changes) = each(%$property_changes)) {
            $initial_state->{$name} = $changes->{from};
        }

        $txn->{pre_state} = {%$initial_state};
    }

    return $initial_state, $final_state;
}

sub transcode_one_txn {
    my $self               = shift;
    my $txn_wrapper        = shift;