File Coverage

blib/lib/xDT/Object.pm
Criterion Covered Total %
statement 17 28 60.7
branch 1 2 50.0
condition 2 8 25.0
subroutine 5 8 62.5
pod 5 5 100.0
total 30 51 58.8


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