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

package Chemistry::PeriodicTable;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Provide access to chemical element properties

our $VERSION = '0.0400';

use Moo;
use strictures 2;
use Carp qw(croak);
use File::ShareDir qw(dist_dir);
use List::SomeUtils qw(first_index);
use Text::CSV_XS ();
use namespace::clean;


has symbols => (is => 'lazy', init_args => undef);

sub _build_symbols {
    my ($self) = @_;
    my $symbols = $self->as_hash;
    return $symbols;
}


has header => (is => 'lazy', init_args => undef);

sub _build_header {
    my ($self) = @_;
    my @headers = $self->headers;
    return \@headers;
}


sub as_file {
    my ($self) = @_;

    my $file = eval { dist_dir('Chemistry-PeriodicTable') . '/Periodic-Table.csv' };
    $file = 'share/Periodic-Table.csv'
        unless $file && -e $file;

    return $file;
}


sub as_hash {
    my ($self) = @_;

    my $file = $self->as_file;

    my %data;

    my $csv = Text::CSV_XS->new({ binary => 1 });

    open my $fh, '<', $file
        or die "Can't read $file: $!";

    my $counter = 0;

    while (my $row = $csv->getline($fh)) {
        $counter++;

        # skip the first row
        next if $counter == 1;

        $data{ $row->[2] } = $row;
    }

    close $fh;

    return \%data;
}


sub headers {
    my ($self) = @_;

    my $file = $self->as_file;

    my @headers;

    my $csv = Text::CSV_XS->new({ binary => 1 });

    open my $fh, '<', $file
        or die "Can't read $file: $!";

    while (my $row = $csv->getline($fh)) {
        push @headers, @$row;
        last;
    }

    close $fh;

    return @headers;
}


sub number {
    my ($self, $string) = @_;
    my $n;
    if (length $string < 4) {
        $n = $self->symbols->{ ucfirst $string }[0];
    }
    else {
        for my $symbol (keys %{ $self->symbols }) {
            if (lc $self->symbols->{$symbol}[1] eq lc $string) {
                $n = $self->symbols->{$symbol}[0];
            }
        }
    }
    return $n;
}


sub name {
    my ($self, $string) = @_;
    my $n;
    for my $symbol (keys %{ $self->symbols }) {
        if (
            ($string =~ /^\d+$/ && $self->symbols->{$symbol}[0] == $string)
            ||
            (lc $self->symbols->{$symbol}[2] eq lc $string)
        ) {
            $n = $self->symbols->{$symbol}[1];
            last;
        }
    }
    return $n;
}


sub symbol {
    my ($self, $string) = @_;
    my $s;
    for my $symbol (keys %{ $self->symbols }) {
        if (
            ($string =~ /^\d+$/ && $self->symbols->{$symbol}[0] == $string)
            ||
            (lc $self->symbols->{$symbol}[1] eq lc $string)
        ) {
            $s = $symbol;
            last;
        }
    }
    return $s;
}


sub value {
    my ($self, $key, $string) = @_;
    my $v;
    my $idx = first_index { $_ =~ /$string/i } @{ $self->header };
    if ($key !~ /^\d+$/ && length $key < 4) {
        $v = $self->symbols->{$key}[$idx];
    }
    else {
        $key = $self->symbol($key);
        for my $symbol (keys %{ $self->symbols }) {
            next unless $symbol eq $key;
            $v = $self->symbols->{$symbol}[$idx];
            last;
        }
    }
    return $v;
}

1;

__END__