File Coverage

lib/BoutrosLab/TSVStream/IO/Role/Base/Dyn.pm
Criterion Covered Total %
statement 31 31 100.0
branch n/a
condition n/a
subroutine 8 8 100.0
pod n/a
total 39 39 100.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             BoutrosLab::TSVStream::IO::Role::Base::Dyn
4              
5             =head1 SYNOPSIS
6              
7             This is a collection of base attributes and methods used internally
8             by dynamic TSVStream reader and writer role modules. It augments
9             BoutrosLab::IO::Role::Base::Fixed.
10              
11             =cut
12              
13             package BoutrosLab::TSVStream::IO::Role::Base::Dyn;
14              
15             # safe Perl
16 1     1   4 use warnings;
  1         1  
  1         24  
17 1     1   3 use strict;
  1         1  
  1         12  
18 1     1   3 use Carp;
  1         1  
  1         38  
19              
20 1     1   3 use Moose::Role;
  1         1  
  1         5  
21 1     1   3526 use BoutrosLab::TSVStream::IO::Role::Base::Fixed;
  1         1  
  1         29  
22 1     1   12 use namespace::autoclean;
  1         1  
  1         2  
23              
24             with 'BoutrosLab::TSVStream::IO::Role::Base::Fixed';
25              
26             # Base role for all Dynamic reader/writer variants
27              
28             has dyn_fields => (
29             is => 'ro',
30             isa => 'ArrayRef[Str]',
31             predicate => '_has_dyn_fields',
32             writer => '_set_dyn_fields',
33             trigger => \&_dyn_fields_set
34             );
35              
36             has _dyn_fields_initialized => (
37             is => 'rw',
38             isa => 'Bool',
39             default => 0
40             );
41              
42             for my $name ( qw( _fixed_start _fixed_end _dyn_start _dyn_end) ) {
43             has $name => ( is => 'ro', isa => 'Int', writer => "_set$name" );
44             }
45              
46             sub _dyn_fields_set {
47 87     87   87 my( $self, $dyn ) = @_;
48 87         65 my $fixed_size = scalar(@{$self->fields});
  87         2387  
49 87         85 my $dyn_size = scalar(@$dyn);
50 87         3157 $self->_set_fixed_start(0);
51 87         2801 $self->_set_fixed_end($fixed_size-1);
52 87         2773 $self->_set_dyn_start($fixed_size);
53 87         2788 $self->_set_dyn_end($fixed_size+$dyn_size-1);
54 87         2600 $self->_num_fields($fixed_size+$dyn_size);
55             }
56              
57             sub _extra_names {
58 51     51   62 my $self = shift;
59 51         42 my $cnt = shift;
60 51         1109 return map { "extra$_" } 1 .. $cnt;
  36         793  
61             }
62              
63             around '_to_fields' => sub {
64             my $orig = shift;
65             my $self = shift;
66             my $obj = shift;
67             unless ($self->_dyn_fields_initialized) {
68             $self->_set_dyn_fields( $obj->dyn_fields );
69             $self->_dyn_fields_initialized(1);
70             }
71             return( ($self->$orig($obj), @{ $obj->dyn_values } ) );
72             };
73              
74             around '_read_config' => sub {
75             my $orig = shift;
76             my $self = shift;
77             return ($self->$orig, dyn_fields => $self->dyn_fields);
78             };
79              
80              
81             =head1 AUTHOR
82              
83             John Macdonald - Boutros Lab
84              
85             =head1 ACKNOWLEDGEMENTS
86              
87             Paul Boutros, Phd, PI - Boutros Lab
88              
89             The Ontario Institute for Cancer Research
90              
91             =cut
92              
93             1;
94