File Coverage

blib/lib/Geoffrey/Utils.pm

Criterion	Covered	Total	%
statement	60	63	95.2
branch	20	24	83.3
condition			n/a
subroutine	14	14	100.0
pod	9	9	100.0
total	103	110	93.6

package Geoffrey::Utils;

use utf8;
use 5.016;
use strict;
use Readonly;
use warnings;

$Geoffrey::Utils::VERSION = '0.000204';

Readonly::Scalar our $INT_64BIT_SIGNED => 9_223_372_036_854_775_807;

sub replace_spare {
    my ( $string, $options ) = @_;
    if ( !$string ) {
        require Geoffrey::Exception::RequiredValue;
        Geoffrey::Exception::RequiredValue::throw_common( 'String to replace', __PACKAGE__ . '::replace_spare' );
    }
    eval { $string =~ s/\{(\d+)\}/$options->[$1]/g; } or do { };
    return $string;
}

sub add_schema {
    my ($s_string) = @_;
    return q// unless $s_string;
    return qq~$s_string.~;
}

sub add_name {
    my ($hr_params) = @_;
    return $hr_params->{name} if $hr_params->{name};
    my @name_values = ( $hr_params->{prefix} );
    push @name_values, $hr_params->{context} if $hr_params->{context};
    push @name_values, time;
    return join q/_/, @name_values;
}

sub obj_from_name {
    my $s_module_name = shift;
    if ( !$s_module_name ) {
        require Geoffrey::Exception::RequiredValue;
        Geoffrey::Exception::RequiredValue::throw_package_name('obj_from_name');
    }
    my $return_eval = eval qq~require $s_module_name~;
    if ( !$return_eval ) {
        require Geoffrey::Exception::General;
        Geoffrey::Exception::General::throw_eval($@);
    }
    return $s_module_name->new(@_);
}

sub converter_obj_from_name {
    my $s_converter_name = shift;
    return obj_from_name( 'Geoffrey::Converter::' . $s_converter_name );
}

sub action_obj_from_name {
    my $s_action_name = shift;
    return obj_from_name( 'Geoffrey::Action::' . $s_action_name, @_ );
}

sub changelog_io_from_name {
    my $s_file_name = shift;
    return obj_from_name( 'Geoffrey::Changelog::' . $s_file_name );
}

sub parse_package_sub {
    my ($s_action) = @_;
    my @a_action = split /\./, lc $s_action;
    my $s_sub = pop @a_action;
    return ( $s_sub, join q//, map { ucfirst } split /_/, ( join q/::/, map { ucfirst } @a_action ) );
}

sub to_lowercase {
    my ($ur_entry) = @_;
    return unless $ur_entry;
    if ( ref($ur_entry) eq 'ARRAY' ) {
        $_ = to_lowercase($_) for @{$ur_entry};
        return $ur_entry;
    }
    for my $s_key ( sort keys %{$ur_entry} ) {
        my $ur_value = delete $ur_entry->{$s_key};
        next unless $ur_value;
        $ur_entry->{ lc $s_key eq 'plain_sql' ? 'as' : lc $s_key } =
          ref($ur_value) =~ /(HASH|ARRAY)/ ? to_lowercase($ur_value) : $ur_value;
    }
    return $ur_entry;
}

1;    # End of Geoffrey::Utils

__END__