File Coverage

blib/lib/Bio/Phylo/Util/CONSTANT.pm

Criterion	Covered	Total	%
statement	46	46	100.0
branch	12	12	100.0
condition	3	3	100.0
subroutine	12	12	100.0
pod	6	6	100.0
total	79	79	100.0

package Bio::Phylo::Util::CONSTANT;
use strict;
use base 'Exporter';
use Scalar::Util 'blessed';
use Bio::Phylo::Util::Exceptions 'throw';
use Bio::Phylo::Util::CONSTANT::Int;

BEGIN {
    our ( @EXPORT_OK, %EXPORT_TAGS );
    @EXPORT_OK = qw(
      _NONE_
      _NODE_
      _TREE_
      _FOREST_
      _TAXON_
      _TAXA_
      _CHAR_
      _DATUM_
      _MATRIX_
      _MATRICES_
      _SEQUENCE_
      _ALIGNMENT_
      _CHARSTATE_
      _CHARSTATESEQ_
      _MATRIXROW_
      _PROJECT_
      _ANNOTATION_
      _DICTIONARY_
      _DOMCREATOR_
      _META_
      _DESCRIPTION_
      _RESOURCE_
      _HTTP_SC_SEE_ALSO_
      _DOCUMENT_
      _ELEMENT_
      _CHARACTERS_
      _CHARACTER_
      _SET_
      _MODEL_
      _OPERATION_
      _DATATYPE_
      looks_like_number
      looks_like_object
      looks_like_hash
      looks_like_class
      looks_like_instance
      looks_like_implementor
      _NS_OWL_
      _NS_DC_
      _NS_DCTERMS_
      _NS_NEXML_
      _NS_RDF_
      _NS_RDFS_
      _NS_XSI_
      _NS_XSD_
      _NS_XML_
      _NS_TOL_
      _NS_CDAO_
      _NS_BIOPHYLO_
      _NS_SKOS_
      _NEXML_VERSION_
      _PI_
      _NS_PHYLOXML_
      _NS_TB2PURL_
      _NS_TNRS_
      _NS_FIGTREE_
      _NS_PHYLOMAP_
      _NS_BIOVEL_
      _NS_NHX_
      _NS_DWC_
      _NS_GBIF_
    );
    %EXPORT_TAGS = (
        'all'         => [@EXPORT_OK],
        'objecttypes' => [
            qw(
              _NONE_
              _NODE_
              _TREE_
              _FOREST_
              _TAXON_
              _TAXA_
              _CHAR_
              _DATUM_
              _MATRIX_
              _MATRICES_
              _SEQUENCE_
              _ALIGNMENT_
              _CHARSTATE_
              _CHARSTATESEQ_
              _MATRIXROW_
              _PROJECT_
              _ANNOTATION_
              _DICTIONARY_
              _DOMCREATOR_
              _META_
              _DESCRIPTION_
              _RESOURCE_
              _HTTP_SC_SEE_ALSO_
              _DOCUMENT_
              _ELEMENT_
              _CHARACTERS_
              _CHARACTER_
              _SET_
              _MODEL_
              _OPERATION_
              _DATATYPE_
            )
        ],
        'functions' => [
            qw(
              looks_like_number
              looks_like_object
              looks_like_hash
              looks_like_class
              looks_like_instance
              looks_like_implementor
            )
        ],
        'namespaces' => [
            qw(
              _NS_OWL_
              _NS_DC_
              _NS_DCTERMS_
              _NS_NEXML_
              _NS_RDF_
              _NS_RDFS_
              _NS_XSI_
              _NS_XSD_
              _NS_XML_
              _NS_TOL_
              _NS_CDAO_
              _NS_BIOPHYLO_
              _NS_SKOS_
              _NS_PHYLOXML_
              _NS_TB2PURL_
              _NS_TNRS_
              _NS_FIGTREE_
              _NS_PHYLOMAP_
              _NS_BIOVEL_
              _NS_NHX_
              _NS_DWC_
              _NS_GBIF_
            )
        ]
    );
}

# according to perlsub:
# "Functions with a prototype of () are potential candidates for inlining.
# If the result after optimization and constant folding is either a constant
# or a lexically-scoped scalar which has no other references, then it will
# be used in place of function calls made without & or do."
sub _NS_OWL_ ()      { 'http://www.w3.org/2002/07/owl#' }
sub _NS_DC_ ()       { 'http://purl.org/dc/elements/1.1/' }
sub _NS_DCTERMS_ ()  { 'http://purl.org/dc/terms/' }
sub _NS_NEXML_ ()    { 'http://www.nexml.org/2009' }
sub _NS_RDF_ ()      { 'http://www.w3.org/1999/02/22-rdf-syntax-ns#' }
sub _NS_RDFS_ ()     { 'http://www.w3.org/2000/01/rdf-schema#' }
sub _NS_XSI_ ()      { 'http://www.w3.org/2001/XMLSchema-instance' }
sub _NS_XSD_ ()      { 'http://www.w3.org/2001/XMLSchema#' }
sub _NS_XML_ ()      { 'http://www.w3.org/XML/1998/namespace' }
sub _NS_TOL_ ()      { 'http://tolweb.org/tree/home.pages/downloadtree.html#' }
sub _NS_CDAO_ ()     { 'http://www.evolutionaryontology.org/cdao/1.0/cdao.owl#' }
sub _NS_BIOPHYLO_ () { 'http://search.cpan.org/dist/Bio-Phylo/terms#' }
sub _NS_SKOS_ ()     { 'http://www.w3.org/2004/02/skos/core#' }
sub _NS_PHYLOXML_ () { 'http://www.phyloxml.org/1.10/terms#' }
sub _NS_TB2PURL_ ()  { 'http://purl.org/phylo/treebase/phylows/' }
sub _NS_TNRS_ ()     { 'http://phylotastic.org/tnrs/terms#' }
sub _NS_FIGTREE_ ()  { 'http://tree.bio.ed.ac.uk/software/figtree/terms#' }
sub _NS_PHYLOMAP_ () { 'http://phylomap.org/terms.owl#' }
sub _NS_BIOVEL_ ()   { 'http://biovel.eu/terms#' }
sub _NS_NHX_ ()      { 'http://sites.google.com/site/cmzmasek/home/software/forester/nhx' }
sub _NS_DWC_ ()      { 'http://rs.tdwg.org/dwc/terms/' }
sub _NS_GBIF_ ()     { 'http://rs.gbif.org/terms/1.0/' }

our $NS = {
    'tnrs' => _NS_TNRS_(),
    'pxml' => _NS_PHYLOXML_(),
    'skos' => _NS_SKOS_(),
    'bp'   => _NS_BIOPHYLO_(),
    'cdao' => _NS_CDAO_(),
    'tol'  => _NS_TOL_(),
    'xml'  => _NS_XML_(),
    'xsd'  => _NS_XSD_(),
    'xsi'  => _NS_XSI_(),
    'rdf'  => _NS_RDF_(),
    'rdfs' => _NS_RDFS_(),
    'nex'  => _NS_NEXML_(),
    'dc'   => _NS_DC_(),
    'owl'  => _NS_OWL_(),
    'bv'   => _NS_BIOVEL_(),
    'dcterms' => _NS_DCTERMS_(),
    'fig'     => _NS_FIGTREE_(),
    'nhx'     => _NS_NHX_(),
    'dwc'     => _NS_DWC_(),
    'gbif'    => _NS_GBIF_(),
};

sub _NEXML_VERSION_ () { '0.9' }
sub _NONE_ ()          { Bio::Phylo::Util::CONSTANT::Int::_NONE_ }
sub _NODE_ ()          { Bio::Phylo::Util::CONSTANT::Int::_NODE_ }
sub _TREE_ ()          { Bio::Phylo::Util::CONSTANT::Int::_TREE_ }
sub _FOREST_ ()        { Bio::Phylo::Util::CONSTANT::Int::_FOREST_ }
sub _TAXON_ ()         { Bio::Phylo::Util::CONSTANT::Int::_TAXON_ }
sub _TAXA_ ()          { Bio::Phylo::Util::CONSTANT::Int::_TAXA_ }
sub _DATUM_ ()         { Bio::Phylo::Util::CONSTANT::Int::_DATUM_ }
sub _MATRIX_ ()        { Bio::Phylo::Util::CONSTANT::Int::_MATRIX_ }
sub _MATRICES_ ()      { Bio::Phylo::Util::CONSTANT::Int::_MATRICES_ }
sub _SEQUENCE_ ()      { Bio::Phylo::Util::CONSTANT::Int::_SEQUENCE_ }
sub _ALIGNMENT_ ()     { Bio::Phylo::Util::CONSTANT::Int::_ALIGNMENT_ }
sub _CHAR_ ()          { Bio::Phylo::Util::CONSTANT::Int::_CHAR_ }
sub _PROJECT_ ()       { Bio::Phylo::Util::CONSTANT::Int::_PROJECT_ }
sub _CHARSTATE_ ()     { Bio::Phylo::Util::CONSTANT::Int::_CHARSTATE_ }
sub _CHARSTATESEQ_ ()  { Bio::Phylo::Util::CONSTANT::Int::_CHARSTATESEQ_ }
sub _MATRIXROW_ ()     { Bio::Phylo::Util::CONSTANT::Int::_MATRIXROW_ }
sub _ANNOTATION_ ()    { Bio::Phylo::Util::CONSTANT::Int::_ANNOTATION_ }
sub _DICTIONARY_ ()    { Bio::Phylo::Util::CONSTANT::Int::_DICTIONARY_ }
sub _DOMCREATOR_ ()    { Bio::Phylo::Util::CONSTANT::Int::_DOMCREATOR_ }
sub _META_ ()          { Bio::Phylo::Util::CONSTANT::Int::_META_ }
sub _DESCRIPTION_ ()   { Bio::Phylo::Util::CONSTANT::Int::_DESCRIPTION_ }
sub _RESOURCE_ ()      { Bio::Phylo::Util::CONSTANT::Int::_RESOURCE_ }
sub _DOCUMENT_ ()      { Bio::Phylo::Util::CONSTANT::Int::_DOCUMENT_ }
sub _ELEMENT_ ()       { Bio::Phylo::Util::CONSTANT::Int::_ELEMENT_ }
sub _CHARACTERS_ ()    { Bio::Phylo::Util::CONSTANT::Int::_CHARACTERS_ }
sub _CHARACTER_ ()     { Bio::Phylo::Util::CONSTANT::Int::_CHARACTER_ }
sub _SET_ ()           { Bio::Phylo::Util::CONSTANT::Int::_SET_ }
sub _MODEL_ ()         { Bio::Phylo::Util::CONSTANT::Int::_MODEL_ }
sub _OPERATION_ ()     { Bio::Phylo::Util::CONSTANT::Int::_OPERATION_ }
sub _DATATYPE_ ()      { Bio::Phylo::Util::CONSTANT::Int::_DATATYPE_ }

# for PhyloWS
sub _HTTP_SC_SEE_ALSO_ () { '303 See Other' }

# for tree drawing
sub _PI_ () { 4 * atan2(1,1) }

# this is a drop in replacement for Scalar::Util's function
my $looks_like_number;
{
    eval { Scalar::Util::looks_like_number(0) };
    if ($@) {
        my $LOOKS_LIKE_NUMBER_RE =
          qr/^([-+]?\d+(\.\d+)?([eE][-+]\d+)?|Inf|NaN)$/;
        $looks_like_number = sub {
            my $num = shift;
            if ( defined $num and $num =~ $LOOKS_LIKE_NUMBER_RE ) {
                return 1;
            }
            else {
                return;
            }
          }
    }
    else {
        $looks_like_number = \&Scalar::Util::looks_like_number;
    }
    undef($@);
}
sub looks_like_number($) { return $looks_like_number->(shift) }

sub looks_like_object($$) {
    my ( $object, $constant ) = @_;
    my $type;
    eval { $type = $object->_type };
    if ( $@ or $type != $constant ) {
        throw 'ObjectMismatch' => 'Invalid object!';
    }
    else {
        return 1;
    }
}

sub looks_like_implementor($$) {
    return UNIVERSAL::can( $_[0], $_[1] );
}

sub looks_like_instance($$) {
    my ( $object, $class ) = @_;
    if ( ref $object ) {
        if ( blessed $object ) {
            return $object->isa($class);
        }
        else {
            return ref $object eq $class;
        }
    }
    else {
        return;
    }
}

sub looks_like_hash(@) {
    if ( scalar(@_) % 2 ) {
        throw 'OddHash' => 'Odd number of elements in hash assignment';
    }
    else {
        return @_;
    }
}

sub looks_like_class($) {
    my $class = shift;
    my $path  = $class;
    $path =~ s|::|/|g;
    $path .= '.pm';
    if ( not exists $INC{$path} ) {
        eval { require $path };
        if ($@) {
            throw 'ExtensionError' => $@;
        }
    }
    return $class;
}
1;
__END__