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 escape_search_string_pattern run_module_method get_module_var); %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 &escape_search_string_pattern &run_module_method &get_module_var)], 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 &escape_search_string_pattern &run_module_method &get_module_var)]); 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; } sub escape_search_string_pattern { my ($searchString,$no_pattern,$append,$prepend) = @_; $searchString //= ""; my $is_pattern = 0; return ($searchString,$is_pattern) if $no_pattern; my $searchString_escaped = join('',map { my $token = $_; if ($token ne '\\\\') { $token =~ s/%/\\%/g; $token =~ s/_/\\_/g; if ($token =~ s/(? 0) { if ($append) { $searchString_escaped .= '%'; $is_pattern = 1; } if ($prepend) { $searchString_escaped = '%' . $searchString_escaped; $is_pattern = 1; } } return ($searchString_escaped,$is_pattern); } sub _load_module { my $package_element = shift; eval { (my $module = $package_element) =~ s/::[a-zA-Z_0-9]+$//g; (my $file = $module) =~ s|::|/|g; require $file . '.pm'; #$module->import(); 1; } or do { die($@); }; } sub run_module_method { my $method_name = 'NGCP::Panel::' . shift; _load_module($method_name); no strict "refs"; ## no critic (ProhibitNoStrict) return $method_name->(@_); } sub get_module_var { my $var_name = 'NGCP::Panel::' . shift; _load_module($var_name); no strict "refs"; ## no critic (ProhibitNoStrict) return @{$var_name} if wantarray; return ${$var_name}; } 1;