File Coverage

blib/lib/xDT/Object.pm
Criterion Covered Total %
statement 8 28 28.5
branch 0 2 0.0
condition 0 8 0.0
subroutine 3 8 37.5
pod 5 5 100.0
total 16 51 31.3


line stmt bran cond sub pod time code
1             package xDT::Object;
2              
3 1     1   18 use v5.10;
  1         4  
4 1     1   6 use Moose;
  1         3  
  1         11  
5              
6 1     1   7649 use xDT::Record;
  1         3  
  1         506  
7              
8             =head1 NAME
9              
10             xDT::Object - Instances of this module are collections of xDT records.
11              
12             =head1 SYNOPSIS
13              
14             Instances should be used to aggregate records for a single patient.
15             Each object should start and end with respective record types of the used xDT version.
16              
17             use xDT::Object;
18              
19             my @records = (); # should be an array of xDT::Record instances
20             my $object = xDT::Object->new();
21             $object->add_record(@records);
22              
23             say 'Patient number: '. $object->get_value('patient_number');
24             say 'Birthdate: '. $object->get_value('birthdate');
25              
26             =head1 ATTRIBUTES
27              
28             =head2 records
29              
30             An ArrayRef to xDT::Record instances.
31              
32             =cut
33              
34             has 'records' => (
35             is => 'rw',
36             isa => 'ArrayRef[xDT::Record]',
37             traits => ['Array'],
38             default => sub { [ ] },
39             handles => {
40             get_records => 'elements',
41             add_record => 'push',
42             map_records => 'map',
43             record_count => 'count',
44             sorted_records => 'sort',
45             next_record => 'shift',
46             },
47             documentation => q{A collection of logical associated records.},
48             );
49              
50             =head1 SUBROUTINES/METHODS
51              
52             =head2 is_empty
53              
54             Checks if this object has any records.
55              
56             =cut
57              
58             sub is_empty {
59 0     0 1   my $self = shift;
60              
61 0           return $self->record_count == 0;
62             }
63              
64             =head2 get_every_record($accessor)
65              
66             Returns all records as arrayref, which have the given accessor.
67              
68             =cut
69              
70             sub get_every_record {
71 0     0 1   my $self = shift;
72 0   0       my $accessor = shift // die 'Error: parameter $accessor missing.';
73 0           return [ grep { $_->get_accessor() eq $accessor } $self->get_records() ];
  0            
74             }
75              
76             =head2 get_record($accessor)
77              
78             Returns the first record with the given accessor, if there are any, else undef.
79              
80             =cut
81              
82             sub get_record {
83 0     0 1   my $self = shift;
84 0   0       my $accessor = shift // die 'Error: parameter $accessor missing.';
85 0           my ($record) = grep { $_->get_accessor() eq $accessor } $self->get_records();
  0            
86              
87 0           return $record;
88             }
89              
90             =head2 get_every_value($accessor)
91              
92             Returns the values of all records as arrayref, which have the given accessor.
93              
94             =cut
95              
96             sub get_every_value {
97 0     0 1   my $self = shift;
98 0   0       my $accessor = shift // die 'Error: parameter $accessor missing.';
99 0           my $records = $self->get_every_record($accessor);
100              
101 0           return [ map { $_->get_value } @$records ];
  0            
102             }
103              
104             =head2 get_value($accessor)
105              
106             Returns the value of the first record with the given accessor, if there are any, else undef.
107              
108             =cut
109              
110             sub get_value {
111 0     0 1   my $self = shift;
112 0   0       my $accessor = shift // die 'Error: parameter $accessor missing.';
113 0           my $record = $self->get_record($accessor);
114              
115 0 0         return $record ? $record->get_value : undef;
116             }
117              
118             =head2 get_records
119              
120             Corresponse to the elements function.
121              
122             =cut
123              
124             =head2 add_record
125              
126             Corresponse to the push function.
127              
128             =cut
129              
130             =head2 map_records
131              
132             Corresponse to the map function.
133              
134             =cut
135              
136             =head2 record_count
137              
138             Correpsonse to the count function.
139              
140             =cut
141              
142             =head2 sorted_records
143              
144             Corresponse to the sort function.
145              
146             =cut
147              
148             =head2 next_record
149              
150             Corresponse to the shift function.
151              
152             =cut
153              
154             =head1 AUTHOR
155              
156             Christoph Beger, C<< <christoph.beger at medizin.uni-leipzig.de> >>
157              
158             =cut
159              
160             __PACKAGE__->meta->make_immutable;
161              
162             1; # End of xDT::Object