File Coverage

lib/BoutrosLab/TSVStream/Format/AnnovarInput/Types.pm
Criterion Covered Total %
statement 28 31 90.3
branch 4 6 66.6
condition 7 12 58.3
subroutine 10 11 90.9
pod n/a
total 49 60 81.6


line stmt bran cond sub pod time code
1             # safe Perl
2 6     6   21 use warnings;
  6         11  
  6         156  
3 6     6   17 use strict;
  6         8  
  6         81  
4 6     6   17 use Carp;
  6         6  
  6         370  
5              
6             =head1 NAME
7              
8             BoutrosLab::TSVStream::Format::AnnovarInput::Types
9              
10             =head1 SYNOPSIS
11              
12             Collection of types used in AnnovarInput format fields. Used internally in
13             BoutrosLab::TSVStream::Format::AnnovarInput::Role.
14              
15             =cut
16              
17             package BoutrosLab::TSVStream::Format::AnnovarInput::Types;
18              
19 6         32 use MooseX::Types -declare => [
20             qw(
21             AI_Ref
22             AI_ChrHuman
23             AI_ChrHumanNoChr
24             AI_ChrHumanWithChr
25             AI_ChrHumanTag
26             AI_ChrHumanTagNoChr
27             AI_ChrHumanTagWithChr
28             )
29 6     6   1895 ];
  6         104609  
30              
31 6     6   29898 use MooseX::Types::Moose qw( Int Str ArrayRef );
  6         41798  
  6         37  
32             # use Type::Utils -all;
33              
34             subtype AI_Ref,
35             as Str,
36             where { /^-$/ || /^[CGAT]+(?:,[CGAT]+)*$/i },
37             message {"AI_Ref must be '-' (dash), or one or more series of 'CGAT' characters separated by ','"};
38              
39             sub _human_chr {
40 48     48   51 my ($val, $allow_tag) = @_;
41 48 50 66     138 return 1 if $allow_tag && $val =~ /^(?:chr)?Un_\S+$/;
42 48 100       229 return 0 unless my ( $l, $v, $tag ) = $val =~ /^(?:chr)?(?:([XYM])|(\d+))(_\S+)?$/;
43 44 50 66     315 return 1 if ($l || ( 1 <= $v && $v <= 22 )) && ($allow_tag || !$tag);
      66        
      33        
44 0         0 return 0;
45             }
46              
47             sub _apply_chr_subtypes {
48 12     12   2535 my ($type, $wc, $nc) = @_;
49              
50             subtype $wc,
51             as $type,
52 12     28   51 where { /^chr/ };
  28         108  
53             subtype $nc,
54             as $type,
55 12     16   17041 where { /^(?!chr)/ };
  16         70  
56 12     0   16896 coerce $nc, from $wc, via { s/^chr//; $_ };
  0         0  
  0         0  
57 12     6   8597 coerce $wc, from $nc, via { s/^/chr/; $_ };
  6         47  
  6         205  
58             }
59              
60             my $notagmessage = " - must be '1'..'22', 'X', 'Y', or 'M'. (A leading 'chr' string is optional.)";
61              
62             subtype AI_ChrHuman,
63             as Str,
64             where { _human_chr($_) },
65             message { "$notagmessage Found: $_" };
66              
67             _apply_chr_subtypes( AI_ChrHuman, AI_ChrHumanWithChr, AI_ChrHumanNoChr );
68              
69             my $tagmessage = " - must be '1'..'22', 'X', 'Y', or 'M'; optionally followed a tag; or 'Un' followed by a (required) tag. A tag must start with an underscore. (A leading 'chr' string is optional.)";
70              
71             subtype AI_ChrHumanTag,
72             as Str,
73             where { _human_chr($_, 1) },
74             message { "$tagmessage Found: $_" };
75              
76             _apply_chr_subtypes( AI_ChrHumanTag, AI_ChrHumanTagWithChr, AI_ChrHumanTagNoChr );
77              
78             =head1 AUTHOR
79              
80             John Macdonald - Boutros Lab
81              
82             =head1 ACKNOWLEDGEMENTS
83              
84             Paul Boutros, Phd, PI - Boutros Lab
85              
86             The Ontario Institute for Cancer Research
87              
88             =cut
89              
90             1;
91