File Coverage

blib/lib/Chemistry/PeriodicTable.pm
Criterion Covered Total %
statement 88 88 100.0
branch 17 20 85.0
condition 16 18 88.8
subroutine 15 15 100.0
pod 5 5 100.0
total 141 146 96.5


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.0501';
7              
8 1     1   1533 use Moo;
  1         11253  
  1         4  
9 1     1   1934 use strictures 2;
  1         1638  
  1         37  
10 1     1   195 use Carp qw(croak);
  1         3  
  1         43  
11 1     1   534 use File::ShareDir qw(dist_dir);
  1         26099  
  1         56  
12 1     1   565 use List::SomeUtils qw(first_index);
  1         9910  
  1         66  
13 1     1   979 use Text::CSV_XS ();
  1         19490  
  1         30  
14 1     1   504 use namespace::clean;
  1         8242  
  1         8  
15              
16              
17             has symbols => (is => 'lazy', init_args => undef);
18              
19             sub _build_symbols {
20 1     1   715 my ($self) = @_;
21              
22 1         3 my $file = $self->as_file;
23              
24 1         3 my %data;
25              
26 1         8 my $csv = Text::CSV_XS->new({ binary => 1 });
27              
28 1 50       146 open my $fh, '<', $file
29             or die "Can't read $file: $!";
30              
31 1         6 my $counter = 0;
32              
33 1         37 while (my $row = $csv->getline($fh)) {
34 119         4097 $counter++;
35              
36             # skip the first row
37 119 100       246 next if $counter == 1;
38              
39 118         2535 $data{ $row->[2] } = $row;
40             }
41              
42 1         45 close $fh;
43              
44 1         14 return \%data;
45             }
46              
47              
48             has header => (is => 'lazy', init_args => undef);
49              
50             sub _build_header {
51 1     1   380 my ($self) = @_;
52              
53 1         3 my $file = $self->as_file;
54              
55 1         5 my @headers;
56              
57 1         9 my $csv = Text::CSV_XS->new({ binary => 1 });
58              
59 1 50       202 open my $fh, '<', $file
60             or die "Can't read $file: $!";
61              
62 1         66 while (my $row = $csv->getline($fh)) {
63 1         104 push @headers, @$row;
64 1         4 last;
65             }
66              
67 1         17 close $fh;
68              
69 1         18 return \@headers;
70             }
71              
72              
73             sub as_file {
74 3     3 1 2195 my ($self) = @_;
75              
76 3         5 my $file = eval { dist_dir('Chemistry-PeriodicTable') . '/Periodic-Table.csv' };
  3         14  
77 3 50 33     436 $file = 'share/Periodic-Table.csv'
78             unless $file && -e $file;
79              
80 3         11 return $file;
81             }
82              
83              
84             sub number {
85 2     2 1 721 my ($self, $string) = @_;
86 2         4 my $n;
87             # looking for a symbol
88 2 100       8 if (length $string < 4) {
89 1         27 $n = $self->symbols->{ ucfirst $string }[0];
90             }
91             # looking for an element name
92             else {
93 1         1 for my $symbol (keys %{ $self->symbols }) {
  1         24  
94 57 100       1149 if (lc $self->symbols->{$symbol}[1] eq lc $string) {
95 1         21 $n = $self->symbols->{$symbol}[0];
96 1         8 last;
97             }
98             }
99             }
100 2         42 return $n;
101             }
102              
103              
104             sub name {
105 2     2 1 5 my ($self, $string) = @_;
106 2         3 my $n;
107 2         4 for my $symbol (keys %{ $self->symbols }) {
  2         45  
108 114 100 100     4073 if (
      100        
109             ($string =~ /^\d+$/ && $self->symbols->{$symbol}[0] == $string)
110             ||
111             (lc $self->symbols->{$symbol}[2] eq lc $string)
112             ) {
113 2         44 $n = $self->symbols->{$symbol}[1];
114 2         15 last;
115             }
116             }
117 2         21 return $n;
118             }
119              
120              
121             sub symbol {
122 4     4 1 9 my ($self, $string) = @_;
123 4         5 my $s;
124 4         8 for my $symbol (keys %{ $self->symbols }) {
  4         80  
125 230 100 100     7387 if (
      100        
126             ($string =~ /^\d+$/ && $self->symbols->{$symbol}[0] == $string)
127             ||
128             (lc $self->symbols->{$symbol}[1] eq lc $string)
129             ) {
130 4         35 $s = $symbol;
131 4         8 last;
132             }
133             }
134 4         40 return $s;
135             }
136              
137              
138             sub value {
139 3     3 1 16 my ($self, $key, $string) = @_;
140 3         5 my $v;
141 3     19   12 my $idx = first_index { $_ =~ /$string/i } @{ $self->header };
  19         83  
  3         73  
142 3 100 100     23 if ($key !~ /^\d+$/ && length $key < 4) {
143 1         19 $v = $self->symbols->{$key}[$idx];
144             }
145             else {
146 2         7 $key = $self->symbol($key);
147 2         4 for my $symbol (keys %{ $self->symbols }) {
  2         33  
148 116 100       233 next unless $symbol eq $key;
149 2         39 $v = $self->symbols->{$symbol}[$idx];
150 2         15 last;
151             }
152             }
153 3         39 return $v;
154             }
155              
156             1;
157              
158             __END__