File Coverage

blib/lib/Algorithm/Genetic/Diploid/Base.pm
Criterion Covered Total %
statement 32 32 100.0
branch 5 6 83.3
condition n/a
subroutine 10 10 100.0
pod 7 7 100.0
total 54 55 98.1


line stmt bran cond sub pod time code
1             package Algorithm::Genetic::Diploid::Base;
2 2     2   11 use strict;
  2         4  
  2         83  
3 2     2   11 use Algorithm::Genetic::Diploid::Logger;
  2         3  
  2         91  
4 2     2   1821 use YAML::Any qw(Load Dump);
  2         1999  
  2         12  
5              
6             my $id = 1;
7             my $experiment;
8             my $logger = Algorithm::Genetic::Diploid::Logger->new;
9              
10             =head1 NAME
11              
12             Algorithm::Genetic::Diploid::Base - base class for core objects
13              
14             =head1 METHODS
15              
16             =over
17              
18             =item new
19              
20             Base constructor for everyone, takes named arguments
21              
22             =cut
23              
24             sub new {
25 2752     2752 1 6277 my $package = shift;
26 2752         19367 $logger->debug("instantiating new $package object");
27 2752         22521 my %self = @_;
28 2752         8841 $self{'id'} = $id++;
29            
30             # experiment is provided as an argument
31 2752 100       9090 if ( $self{'experiment'} ) {
32 150         211 $experiment = $self{'experiment'};
33 150         289 delete $self{'experiment'};
34             }
35            
36             # create the object
37 2752         4857 my $obj = \%self;
38 2752         12347 bless $obj, $package;
39            
40             # maybe the object was the experiment?
41 2752 100       34654 if ( $obj->isa('Algorithm::Genetic::Diploid::Experiment') ) {
42 1         2 $experiment = $obj;
43             }
44            
45 2752         16745 return $obj;
46             }
47              
48             =item logger
49              
50             The logger is a singleton object so there's no point in having each object carrying
51             around its own object reference. Hence, we just return a static reference here to the
52             L object.
53              
54             =cut
55              
56 59     59 1 259 sub logger { $logger }
57              
58             =item experiment
59              
60             We don't want there to be circular references from each object to the experiment
61             and back because it will create recursive YAML serializations and interfere with
62             object cloning. Hence this is a static method to access the
63             L object.
64              
65             =cut
66              
67             sub experiment {
68 11120     11120 1 20256 my $self = shift;
69 11120 50       26810 $experiment = shift if @_;
70 11120         58243 return $experiment;
71             }
72              
73             =item id
74              
75             Accessor for the numerical ID, which is generated when the object is instantiated
76              
77             =cut
78              
79 7500     7500 1 26451 sub id { shift->{'id'} }
80              
81             =item dump
82              
83             Write the object to a YAML string
84              
85             =cut
86              
87             sub dump {
88 10000     10000 1 20951 my $self = shift;
89 10000         41190 my $string = Dump($self);
90 10000         46567306 return $string;
91             }
92              
93             =item load
94              
95             Read an object from a YAML string (static method)
96              
97             =cut
98              
99             sub load {
100 10000     10000 1 26796 my ( $package, $raw ) = @_;
101 10000         44874 return Load($raw);
102             }
103              
104             =item clone
105              
106             Clone an object by writing, then reading
107              
108             =cut
109              
110             sub clone {
111 10000     10000 1 59535 return __PACKAGE__->load(shift->dump);
112             }
113              
114             =back
115              
116             =cut
117              
118             1;