File Coverage

blib/lib/JMAP/Tester/Role/SentenceCollection.pm

Criterion	Covered	Total	%
statement	132	143	92.3
branch	22	32	68.7
condition	6	6	100.0
subroutine	20	21	95.2
pod	13	14	92.8
total	193	216	89.3

use v5.20.0;
package JMAP::Tester::Role::SentenceCollection 0.110;

use Moo::Role;

use experimental 'signatures';

requires 'sentence_broker';

BEGIN {
  for my $m (qw(
    client_ids_for_items
    sentence_for_item
    paragraph_for_items

    strip_json_types
  )) {
    my $sub = sub ($self, @rest) {
      $self->sentence_broker->$m(@rest);
    };
    no strict 'refs';
    *$m = $sub;
  }
}

requires 'items';
requires 'add_items';

after add_items => sub ($self, @) { $self->_index_setup };

sub BUILD ($self, @) {
  $self->_index_setup;
}

sub _index_setup ($self) {
  my @cids = $self->client_ids_for_items([ $self->items ]);

  my $prev_cid;
  my $next_para_idx = 0;

  my %cid_indices;
  my @para_indices;

  for my $i (0 .. $#cids) {
    my $cid = $cids[$i];
    unless (defined $cid) {
      Carp::cluck("undefined client_id in position $i");
      next;
    }

    if (defined $prev_cid && $prev_cid ne $cid) {
      # We're transition from cid1 to cid2. -- rjbs, 2016-04-08
      $self->abort("client_id <$cid> appears in non-contiguous positions")
        if $cid_indices{$cid};

      $next_para_idx++;
    }

    push @{ $cid_indices{$cid} }, $i;
    push @{ $para_indices[ $next_para_idx ] }, $i;

    $prev_cid = $cid;
  }

  $self->_cid_indices(\%cid_indices);
  $self->_para_indices(\@para_indices);
}

# The reason we don't have cid-to-para and para-to-lines is that in the event
# that one cid appears in non-contiguous positions, we want to allow it, even
# though it's garbage.  -- rjbs, 2016-04-11
has cid_indices  => (is => 'bare', accessor => '_cid_indices');
has para_indices => (is => 'bare', accessor => '_para_indices');

#pod =method sentence
#pod
#pod   my $sentence = $response->sentence($n);
#pod
#pod This method returns the Ith L of
#pod the response.
#pod
#pod =cut

sub sentence ($self, $n) {
  my @items = $self->items;
  $self->abort("there is no sentence for index $n")
    unless my $item = $items[$n];

  return $self->sentence_for_item($item);
}

#pod =method sentences
#pod
#pod   my @sentences = $response->sentences;
#pod
#pod This method returns a list of all sentences in the response.
#pod
#pod =cut

sub sentences ($self) {
  my @sentences = map {; $self->sentence_for_item($_) }
                  $self->items;

  return @sentences;
}

#pod =method single_sentence
#pod
#pod   my $sentence = $response->single_sentence;
#pod   my $sentence = $response->single_sentence($name);
#pod
#pod This method returns the only L of
#pod the response, raising an exception if there's more than one Sentence.  If
#pod C<$name> is given, an exception is raised if the Sentence's name doesn't match
#pod the given name.
#pod
#pod =cut

sub single_sentence {
  my ($self, $name) = @_;

  my @items = $self->items;
  unless (@items == 1) {
    $self->abort(
      sprintf("single_sentence called but there are %i sentences", 0+@items)
    );
  }

  my $sentence = $self->sentence_for_item($items[0]);

  my $have = $sentence->name;
  if (defined $name && $have ne $name) {
    $self->abort(qq{single sentence has name "$have" not "$name"});
  }

  return $sentence;
}

#pod =method sentence_named
#pod
#pod   my $sentence = $response->sentence_named($name);
#pod
#pod This method returns the sentence with the given name.  If no such sentence
#pod exists, or if two sentences with the name exist, the tester will abort.
#pod
#pod =cut

sub sentence_named ($self, $name = undef) {
  Carp::confess("no name given") unless defined $name;

  my @sentences = grep {; $_->name eq $name } $self->sentences;

  unless (@sentences) {
    $self->abort(qq{no sentence found with name "$name"});
  }

  if (@sentences > 1) {
    $self->abort(qq{found more than one sentence with name "$name"});
  }

  return $sentences[0];
}

#pod =method assert_n_sentences
#pod
#pod   my ($s1, $s2, ...) = $response->assert_n_sentences($n);
#pod
#pod This method returns all the sentences in the response, as long as there are
#pod exactly C<$n>.  Otherwise, it aborts.
#pod
#pod =cut

sub assert_n_sentences ($self, $n = undef) {
  Carp::confess("no sentence count given") unless defined $n;

  my @sentences = $self->sentences;

  unless (@sentences == $n) {
    $self->abort("expected $n sentences but got " . @sentences)
  }

  return @sentences;
}

#pod =method paragraph
#pod
#pod   my $para = $response->paragraph($n);
#pod
#pod This method returns the Ith L
#pod of the response.
#pod
#pod =cut

sub paragraph ($self, $n) {
  $self->abort("there is no paragraph for index $n")
    unless my $indices = $self->_para_indices->[$n];

  my @items    = $self->items;
  my @selected = @items[ @$indices ];

  $self->paragraph_for_items(\@selected);
}

#pod =method paragraphs
#pod
#pod   my @paragraphs = $response->paragraphs;
#pod
#pod This method returns a list of all paragraphs in the response.
#pod
#pod =cut

sub paragraphs ($self) {
  my @para_indices = @{ $self->_para_indices };
  my @items        = $self->items;

  my @paragraphs;
  for my $i_set (@para_indices) {
    push @paragraphs, $self->paragraph_for_items(
      [ @items[ @$i_set ] ]
    );
  }

  return @paragraphs;
}

#pod =method assert_n_paragraphs
#pod
#pod   my ($p1, $p2, ...) = $response->assert_n_paragraphs($n);
#pod
#pod This method returns all the paragraphs in the response, as long as there are
#pod exactly C<$n>.  Otherwise, it aborts.
#pod
#pod =cut

sub assert_n_paragraphs ($self, $n = undef) {
  Carp::confess("no paragraph count given") unless defined $n;

  my @para_indices = @{ $self->_para_indices };
  unless ($n == @para_indices) {
    $self->abort("expected $n paragraphs but got " . @para_indices)
  }

  return $self->paragraphs;
}

#pod =method paragraph_by_client_id
#pod
#pod   my $para = $response->paragraph_by_client_id($cid);
#pod
#pod This returns the paragraph for the given client id.  If there is no paragraph
#pod for that client id, an empty list is returned.
#pod
#pod =cut

sub paragraph_by_client_id ($self, $cid = undef) {
  Carp::confess("no client id given") unless defined $cid;

  $self->abort("there is no paragraph for client_id $cid")
    unless my $indices = $self->_cid_indices->{$cid};

  my @items    = $self->items;
  my @selected = @items[ @$indices ];

  return $self->paragraph_for_items(\@selected);
}

#pod =method as_triples
#pod
#pod =method as_stripped_triples
#pod
#pod This method returns an arrayref of arrayrefs, holding the data returned by the
#pod JMAP server.  With C, some of the JSON data may be in objects
#pod provided by L. If you'd prefer raw data, use the
#pod C form.
#pod
#pod =cut

sub as_triples ($self) {
  return [
    map {; $self->sentence_for_item($_)->as_triple }
    $self->items
  ];
}

sub as_stripped_triples ($self) {
  return $self->strip_json_types($self->as_triples);
}

#pod =method as_pairs
#pod
#pod =method as_stripped_pairs
#pod
#pod These methods do the same thing as C and ,
#pod but omit client ids.
#pod
#pod =cut

sub as_pairs ($self) {
  return [
    map {; $self->sentence_for_item($_)->as_pair }
    $self->items
  ];
}

sub as_stripped_pairs ($self) {
  return $self->strip_json_types($self->as_pairs);
}

1;

__END__