File Coverage

blib/lib/Petrophysics/Units.pm

Criterion	Covered	Total	%
statement	48	56	85.7
branch	13	16	81.2
condition			n/a
subroutine	23	26	88.4
pod	0	22	0.0
total	84	120	70.0

package Petrophysics::Units;

# The following POSC (c) products were used in the creation of this work:
#    - epsgUnits.xml
#    - poscUnits.xml
# These files can be downloaded from http://www.posc.org.  Please see
# http://www.posc.org/ebiz/pefxml/patternsobjects.html#units
#
# Due to the POSC Product License Agreement, these files are not
# distributed in their original form.  This derivative work converted
# those files to perl objects, and added unit conversion functionality
# to the objects.

#    This file is part of the "OSPetro" project.  Please see
#    http://OSPetro.sourceforge.net for further details.
#
#    Copyright (C) 2003  Bjarne Steinsbo
#
#    This library is free software; you can redistribute it and/or modify
#    it under the same terms as Perl itself.
#
#    The author can be contacted at "[e-mail]"

use 5.006;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

# Nothing exported
our @EXPORT_OK = ();
our @EXPORT = ();
our $VERSION = '0.01';

# Read pre-formatted units database to class variable "@objects".
our @objects;
require 'units_database.inc';
# printf STDERR "%d objects in file\n", scalar @objects;

# Make a lookup table by id
our %by_id = map { $_->id => $_ } @objects;
# And a similar one by short name (annotation)
our %by_annotation = map { $_->annotation => $_ } @objects;


# Lookup a unit by id
sub lookup {
    my ($class, $id) = @_;
    return $by_id{$id};
}

# Lookup a unit by annotation.  Please note that annotation is not
# guaranteed to be unique, so the result is an arbitrary unit with the
# given annotation
sub lookup_annotation {
    my ($class, $annotation) = @_;
    return $by_annotation{$annotation};
}

# Generic search
sub grep {
    my ($class, $expr) = @_;
    # Shift to package main namespace
    package main;
    no strict 'refs';
    return grep (&$expr, @{"${class}::objects"});
}

# Return entire list
sub all_units {
    return \@objects;
}

# Are two units compatible?
sub is_compatible {
    my ($self, $other) = @_;
    my $b1 = $self->is_base_unit ? $self->id : $self->base_unit->id;
    my $b2 = $other->is_base_unit ? $other->id : $other->base_unit->id;
    return $b1 eq $b2;
}

# Convert to base unit
sub convert_to_base {
    my ($self, $nr) = @_;
    return $self->is_base_unit ? $nr : (
	($self->A + $self->B * $nr) / ($self->C + $self->D * $nr)
    );
}

# Convert from one unit to another.  Just one scalar value converted.
sub scalar_convert {
    my ($self, $other, $nr) = @_;
    return undef unless $self->is_compatible ($other);
    $nr = $self->convert_to_base ($nr);
    return $other->is_base_unit ? $nr : (
	($other->C * $nr - $other->A) / ($other->B - $other->D * $nr)
    );
}

# Convert from one unit to another.  Convert an array of values.
# The user is probably using the array version for performance reasons,
# so take some care to reduce number of method invocations.
sub vector_convert {
    my ($self, $other, $vec) = @_;
    my @out;
    return undef unless $self->is_compatible ($other);
    if ($self->is_base_unit) {
	@out = @$vec;
    } else {
	my ($A, $B, $C, $D) = ($self->A, $self->B, $self->C, $self->D);
	@out = map { ($A + $B * $_) / ($C + $D * $_) } @$vec;
    }
    unless ($other->is_base_unit) {
	my ($A, $B, $C, $D) = ($other->A, $other->B, $other->C, $other->D);
	$_ = ($C * $_ - $A) / ($B - $D * $_) foreach (@out);
    }
    return \@out;
}

# Accessor routines
sub id { shift->{id} };
sub name { shift->{name} };
sub annotation { shift->{annotation} };
sub quantity_type { shift->{quantity_type} };
sub catalog_name { shift->{catalog_name} };
sub catalog_symbol { shift->{catalog_symbol} };
sub description { shift->{description} };
sub base_unit { shift->{base_unit} };
sub display { shift->{display} };
sub A { shift->{A} };
sub B { shift->{B} };
sub C { shift->{C} };
sub D { shift->{D} };
sub is_base_unit { exists shift->{is_base} };

1;
__END__