File Coverage

blib/lib/Chemistry/PeriodicTable.pm
Criterion Covered Total %
statement 93 93 100.0
branch 17 20 85.0
condition 16 18 88.8
subroutine 17 17 100.0
pod 7 7 100.0
total 150 155 96.7


line stmt bran cond sub pod time code
1             package Chemistry::PeriodicTable;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: Provide access to chemical element properties
5              
6             our $VERSION = '0.0303';
7              
8 1     1   1289 use Moo;
  1         12049  
  1         5  
9 1     1   2028 use strictures 2;
  1         1674  
  1         39  
10 1     1   187 use Carp qw(croak);
  1         2  
  1         45  
11 1     1   499 use File::ShareDir qw(dist_dir);
  1         27500  
  1         58  
12 1     1   567 use List::SomeUtils qw(first_index);
  1         10239  
  1         71  
13 1     1   1056 use Text::CSV_XS ();
  1         20364  
  1         29  
14 1     1   516 use namespace::clean;
  1         8185  
  1         7  
15              
16              
17             has data => (is => 'lazy', init_args => undef);
18              
19             sub _build_data {
20 1     1   608 my ($self) = @_;
21 1         4 my $data = $self->as_hash;
22 1         7 return $data;
23             }
24              
25              
26             has header => (is => 'lazy', init_args => undef);
27              
28             sub _build_header {
29 1     1   706 my ($self) = @_;
30 1         4 my @headers = $self->headers;
31 1         23 return \@headers;
32             }
33              
34              
35             sub as_file {
36 5     5 1 2085 my ($self) = @_;
37              
38 5         12 my $file = eval { dist_dir('Chemistry-PeriodicTable') . '/Periodic-Table.csv' };
  5         17  
39 5 50 33     662 $file = 'share/Periodic-Table.csv'
40             unless $file && -e $file;
41              
42 5         19 return $file;
43             }
44              
45              
46             sub as_hash {
47 2     2 1 4 my ($self) = @_;
48              
49 2         6 my $file = $self->as_file;
50              
51 2         5 my %data;
52              
53 2         14 my $csv = Text::CSV_XS->new({ binary => 1 });
54              
55 2 50       305 open my $fh, '<', $file
56             or die "Can't read $file: $!";
57              
58 2         10 my $counter = 0;
59              
60 2         78 while (my $row = $csv->getline($fh)) {
61 238         8799 $counter++;
62              
63             # skip the first row
64 238 100       492 next if $counter == 1;
65              
66 236         5237 $data{ $row->[2] } = $row;
67             }
68              
69 2         103 close $fh;
70              
71 2         26 return \%data;
72             }
73              
74              
75             sub headers {
76 2     2 1 330 my ($self) = @_;
77              
78 2         6 my $file = $self->as_file;
79              
80 2         5 my @headers;
81              
82 2         18 my $csv = Text::CSV_XS->new({ binary => 1 });
83              
84 2 50       370 open my $fh, '<', $file
85             or die "Can't read $file: $!";
86              
87 2         114 while (my $row = $csv->getline($fh)) {
88 2         181 push @headers, @$row;
89 2         5 last;
90             }
91              
92 2         35 close $fh;
93              
94 2         36 return @headers;
95             }
96              
97              
98             sub atomic_number {
99 2     2 1 6 my ($self, $string) = @_;
100 2         9 my $n;
101 2 100       7 if (length $string < 4) {
102 1         27 $n = $self->data->{ ucfirst $string }[0];
103             }
104             else {
105 1         2 for my $symbol (keys %{ $self->data }) {
  1         26  
106 118 100       2452 if (lc $self->data->{$symbol}[1] eq lc $string) {
107 1         29 $n = $self->data->{$symbol}[0];
108             }
109             }
110             }
111 2         34 return $n;
112             }
113              
114              
115             sub name {
116 2     2 1 6 my ($self, $string) = @_;
117 2         4 my $n;
118 2         3 for my $symbol (keys %{ $self->data }) {
  2         47  
119 16 100 100     558 if (
      100        
120             ($string =~ /^\d+$/ && $self->data->{$symbol}[0] == $string)
121             ||
122             (lc $self->data->{$symbol}[2] eq lc $string)
123             ) {
124 2         56 $n = $self->data->{$symbol}[1];
125 2         19 last;
126             }
127             }
128 2         22 return $n;
129             }
130              
131              
132             sub symbol {
133 4     4 1 13 my ($self, $string) = @_;
134 4         7 my $s;
135 4         6 for my $symbol (keys %{ $self->data }) {
  4         83  
136 71 100 100     2780 if (
      100        
137             ($string =~ /^\d+$/ && $self->data->{$symbol}[0] == $string)
138             ||
139             (lc $self->data->{$symbol}[1] eq lc $string)
140             ) {
141 4         36 $s = $symbol;
142 4         7 last;
143             }
144             }
145 4         29 return $s;
146             }
147              
148              
149             sub value {
150 3     3 1 10 my ($self, $key, $string) = @_;
151 3         4 my $v;
152 3     19   13 my $idx = first_index { $_ =~ /$string/i } @{ $self->header };
  19         84  
  3         71  
153 3 100 100     23 if ($key !~ /^\d+$/ && length $key < 4) {
154 1         55 $v = $self->data->{$key}[$idx];
155             }
156             else {
157 2         17 $key = $self->symbol($key);
158 2         3 for my $symbol (keys %{ $self->data }) {
  2         51  
159 55 100       129 next unless $symbol eq $key;
160 2         33 $v = $self->data->{$symbol}[$idx];
161 2         14 last;
162             }
163             }
164 3         35 return $v;
165             }
166              
167             1;
168              
169             __END__