File Coverage

blib/lib/Protocol/FIX/Group.pm
Criterion Covered Total %
statement 28 28 100.0
branch 6 8 75.0
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 43 45 95.5


line stmt bran cond sub pod time code
1             package Protocol::FIX::Group;
2              
3 11     11   83 use strict;
  11         23  
  11         378  
4 11     11   60 use warnings;
  11         20  
  11         286  
5              
6 11     11   54 use Protocol::FIX;
  11         21  
  11         421  
7              
8             our $VERSION = '0.06'; ## VERSION
9              
10             =head1 NAME
11              
12             Protocol::FIX::Group - allows repetition of common fieds/groups/components
13              
14             =cut
15              
16             =head1 METHODS (for protocol developers)
17              
18             =head3 new
19              
20             new($class, $name, $composites)
21              
22             Creates new Group (performed by Protocol, when it parses XML definition)
23              
24             =cut
25              
26 11     11   64 use mro;
  11         18  
  11         75  
27 11     11   339 use parent qw/Protocol::FIX::BaseComposite/;
  11         24  
  11         67  
28              
29             sub new {
30 651     651 1 2253 my ($class, $base_field, $composites) = @_;
31              
32 651 50       1841 die "base field for group must be a class of 'Protocol::FIX::Field'"
33             unless UNIVERSAL::isa($base_field, "Protocol::FIX::Field");
34              
35             die "type of base field must be strictly 'NUMINGROUP'"
36 651 50       1714 unless $base_field->{type} eq 'NUMINGROUP';
37              
38 651         1729 my $obj = next::method($class, $base_field->{name}, 'group', $composites);
39              
40 650         1397 $obj->{base_field} = $base_field;
41              
42 650         1539 return $obj;
43             }
44              
45             =head3 serialize
46              
47             serialize($self, $values)
48              
49             Serializes array of C<$values>. Not for end-user usage. Please, refer
50             L
51              
52             =cut
53              
54             sub serialize {
55 19     19 1 4651 my ($self, $repetitions) = @_;
56              
57 19 100       103 die '$repetitions must be ARRAY in $obj->serialize($repetitions)'
58             unless ref($repetitions) eq 'ARRAY';
59              
60 18 100       61 die '@repetitions must be non-empty in $obj->serialize($repetitions)'
61             if @$repetitions == 0;
62              
63 17         65 my @strings = ($self->{base_field}->serialize(scalar @$repetitions));
64              
65 17         48 for my $values (@$repetitions) {
66 24         82 push @strings, $self->next::method($values);
67             }
68              
69 13         63 return join $Protocol::FIX::SEPARATOR, @strings;
70             }
71              
72             1;