File Coverage

blib/lib/Data/Record/Serialize/Util.pm

Criterion	Covered	Total	%
statement	32	32	100.0
branch			n/a
condition			n/a
subroutine	10	10	100.0
pod	0	2	0.0
total	42	44	95.4

package Data::Record::Serialize::Util;

# ABSTRACT: Useful things

use v5.12;
use strict;
use warnings;
our $VERSION = '2.02';

use parent 'Exporter::Tiny';

my @TYPE_CATEGORY_NAMES;
my %TYPES;
BEGIN {
    @TYPE_CATEGORY_NAMES = qw(
      ANY
      INTEGER
      FLOAT
      NUMBER
      STRING
      NOT_STRING
      BOOLEAN
    );

    %TYPES = (
        T_INTEGER => 'I',
        T_NUMBER  => 'N',
        T_STRING  => 'S',
        T_BOOLEAN => 'B',
    );
}

use enum @TYPE_CATEGORY_NAMES;
use constant \%TYPES;

## no critic(BuiltinFunctions::ProhibitComplexMappings)
our @TYPE_CATEGORIES = map {
    ;                    # add a ; to help 5.10
    no strict 'refs';    ## no critic(ProhibitNoStrict)
    $_->();
} @TYPE_CATEGORY_NAMES;

our %EXPORT_TAGS = (
    types      => [ keys %TYPES ],
    categories => \@TYPE_CATEGORY_NAMES,
    subs       => [qw( is_type index_types )],
);

our @EXPORT_OK = map { @{$_} } values %EXPORT_TAGS;

my @TypeRE;
$TypeRE[ $_->[0] ] = $_->[1]
  for [ +( ANY ) => qr/.*/ ],
  [ +( STRING )     => qr/^S/i ],
  [ +( FLOAT )      => qr/^N/i ],
  [ +( INTEGER )    => qr/^I/i ],
  [ +( BOOLEAN )    => qr/^B/i ],
  [ +( NUMBER )     => qr/^[NI]/i ],
  [ +( NOT_STRING ) => qr/^[^S]+/ ];

sub is_type {
    my ( $type, $type_enum ) = @_;
    $type =~ $TypeRE[$type_enum];
}

sub index_types {
    my ( $types ) = @_;

    my @fields = keys %$types;
    my @type_index;

    for my $category ( @TYPE_CATEGORIES ) {
        my $re = $TypeRE[$category];
        $type_index[$category] = [ grep { $types->{$_} =~ $re } @fields ];
    }

    return \@type_index;
}

1;

#
# This file is part of Data-Record-Serialize
#
# This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 3, June 2007
#

__END__