ngcp-panel/lib/NGCP/Panel/Utils/Generic.pm

package NGCP::Panel::Utils::Generic;
use strict;
use warnings;
use Exporter;
use URI::Escape qw(uri_escape_utf8);
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION     = 1.00;
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = qw(is_int is_integer is_decimal merge compare is_false is_true get_inflated_columns_all hash2obj mime_type_to_extension extension_to_mime_type array_to_map escape_js escape_uri trim);
%EXPORT_TAGS = ( DEFAULT => [qw(&is_int &is_integer &is_decimal &merge &compare &is_false &is_true &mime_type_to_extension &extension_to_mime_type &array_to_map &escape_js &escape_uri &trim)],
    all    =>  [qw(&is_int &is_integer &is_decimal &merge &compare &is_false &is_true &get_inflated_columns_all &hash2obj &mime_type_to_extension &extension_to_mime_type &array_to_map &escape_js &escape_uri &trim)]);

use Hash::Merge;
use Data::Compare qw//;

my $MIME_TYPES = {
    #first extension is default, others are for extension 2 mime_type detection
    'audio/x-wav'   => ['wav'],
    'audio/mpeg'    => ['mp3'],
    'audio/ogg'     => ['ogg'],
    'text/calendar' => ['ics'],
};

sub is_int {
    my $val = shift;
    return defined $val && $val =~ /^[+-]?\d+\z/;
}

sub is_integer {
    return is_int(@_);
}

sub is_decimal {
    my $val = shift;
    # TODO: also check if only 0 or 1 decimal point
    if($val =~ /^[+-]?\.?[0-9\.]+$/) {
        return 1;
    }
    return;
}

sub merge {
    my ($a, $b) = @_;
    return Hash::Merge::merge($a, $b);
}

sub is_true {
    my ($v) = @_;
    my $val;
    if(ref $v eq "") {
        $val = $v;
    } else {
        $val = ${$v};
    }
    return 1 if(defined $val && $val == 1);
    return;
}

sub is_false {
    my ($v) = @_;
    my $val;
    if(ref $v eq "") {
        $val = $v;
    } else {
        $val = ${$v};
    }
    return 1 unless(defined $val && $val == 1);
    return;
}
# 0 if different, 1 if equal
sub compare {
    return Data::Compare::Compare(@_);
}

sub get_inflated_columns_all{
    my ($rs,%params) = @_;
    #params = {
    #    hash   => result will be hash, with key, taken from the column with name, stored in this param,
    #    column => if hash param exists, value of the hash will be taken from the column with, stored in the param "column"
    #    force_array => hash values always will be an array ref
    #}
    my ($res);
    $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
    if(my $hashkey_column = $params{hash}){
        my %lres;
        my $register_value = sub {
            my($hash,$key,$value) = @_;
            if( $params{force_array} || exists $hash->{$key} ){
                if('ARRAY' eq ref $hash->{$key}){
                    push @{$hash->{$key}}, $value;
                }else{
                    if( exists $hash->{$key}){
                        $hash->{$key} = [$hash->{$key}, $value];
                    }else{
                        $hash->{$key} = [$value];
                    }
                }
            }else{
                $hash->{$key} = $value;
            }
        };
        my $hashvalue_column = $params{column};
        foreach($rs->all){
            $register_value->(\%lres,$_->{$hashkey_column}, $hashvalue_column ? $_->{$hashvalue_column} : $_);
        }
        $res = \%lres;
    }else{
        $res = [$rs->all];
    }
    return $res;
    #return [ map { { $_->get_inflated_columns }; } $rs->all ];
}

sub hash2obj {
    my %params = @_;
    my ($hash,$private,$classname,$accessors) = @params{qw/hash private classname accessors/};

    my $obj;
    $obj = $hash if 'HASH' eq ref $hash;
    $obj //= {};
    $obj = { %$obj, %$private } if 'HASH' eq ref $private;
    unless (defined $classname and length($classname) > 0) {
        my @chars = ('A'..'Z');
        $classname //= '';
        $classname .= $chars[rand scalar @chars] for 1..8;
    }
    $classname = __PACKAGE__ . '::' . $classname unless $classname =~ /::/;
    bless($obj,$classname);
    no strict "refs";  ## no critic (ProhibitNoStrict)
    return $obj if scalar %{$classname . '::'};
    use strict "refs";
    #print "registering class $classname\n";
    $accessors //= {};
    foreach my $accessor (keys %$accessors) {
        #print "registering accessor $classname::$accessor\n";
        no strict "refs";  ## no critic (ProhibitNoStrict)
        *{$classname . '::' . $accessor} = sub {
            my $self = shift;
            return &{$accessors->{$accessor}}($self,@_);
        } if 'CODE' eq ref $accessors->{$accessor};
        *{$classname . '::' . $accessor} = sub {
            my $self = shift;
            return $self->{$accessors->{$accessor}};
        } if '' eq ref $accessors->{$accessor};
    }
    return $obj;
}

sub mime_type_to_extension {
    my ($mime_type) = @_;
    return $MIME_TYPES->{$mime_type}->[0];
}

sub extension_to_mime_type {
    my ($extension) = @_;
    my $mime_type;
    $extension = lc($extension);
    $extension =~s/\s+//g;
    foreach my $k (keys %$MIME_TYPES) {
        if (grep {$_ eq $extension} @{$MIME_TYPES->{$k}}) {
            $mime_type = $k;
            last;
        }
    }
    return $mime_type;
}

sub array_to_map {

    my ($array_ptr,$get_key_code,$get_value_code,$mode) = @_;
    my $map = {};
    my @keys = ();
    my @values = ();
    if (defined $array_ptr and ref $array_ptr eq 'ARRAY') {
        if (defined $get_key_code and ref $get_key_code eq 'CODE') {
            if (not (defined $get_value_code and ref $get_value_code eq 'CODE')) {
                $get_value_code = sub { return shift; };
            }
            $mode = lc($mode);
            if (not ($mode eq 'group' or $mode eq 'first' or $mode eq 'last')) {
                $mode = 'group';
            }
            foreach my $item (@$array_ptr) {
                my $key = &$get_key_code($item);
                if (defined $key) {
                    my $value = &$get_value_code($item);
                    if (defined $value) {
                        if (not exists $map->{$key}) {
                            if ($mode eq 'group') {
                                $map->{$key} = [ $value ];
                            } else {
                                $map->{$key} = $value;
                            }
                            push(@keys,$key);
                        } else {
                            if ($mode eq 'group') {
                                push(@{$map->{$key}}, $value);
                            } elsif ($mode eq 'last') {
                                $map->{$key} = $value;
                            }
                        }
                        push(@values,$value);
                    }
                }
            }
        }
    }
    return ($map,\@keys,\@values);

}

sub escape_js {
    my $str = shift // '';
    my $quote_char = shift;
    $quote_char //= "'";
    $str =~ s/\\/\\\\/g;
    $str =~ s/$quote_char/\\$quote_char/g;
    return $str;
}

sub escape_uri {
    my $str = shift // '';
    return uri_escape_utf8($str);
}

sub trim {
    my $value = shift;
    $value =~ s/^\s+|\s+$//g;
    return $value;
}

1;