########################################################################
#
# $Id: Core.pm,v 1.160 2025/02/01 14:43:09 gosha Exp $
#
# Based on:
# $Id: Core.pm,v 1.12 2009-01-29 12:08:30 gosha Exp
#
# Copyright (c) Igor Okunev <igor[at]prv.mts-nn.ru>  2008 - 2025
#
########################################################################
package XVB::Core;

use strict;

use vars qw( @ISA $VERSION @EXPORT );

use Digest::MD5 qw(md5_hex md5_base64);
use Fcntl qw(:flock);
use IO::File;
use Sys::Syslog qw(:DEFAULT setlogsock);
use Env::C;
use POSIX qw( locale_h strftime );
use Time::HiRes qw( gettimeofday );

use XVB::Macros;
use XVB::Database;
use XVB::MC;

use Exporter;

($VERSION='$Revision: 1.160 $')=~s/^\S+\s+(\S+)\s+.*/$1/;

@ISA = qw( Exporter );

@EXPORT = qw( 	
				core_sound_file_length
				core_sound_check_file
				core_media_convert
				core_media_convert_init
				core_run_system
				core_rename
				core_unlink
				core_get_unique
				core_f2ban_log
				core_log
				core_log_init
				core_log_level
				core_cfg_get
				core_cfg_init
				core_creds
				core_vboxes
				core_session
				core_watchdog
				core_change_tz
				core_get_datetime
				
				core_lists_get
				core_check_limit
				core_counters

				core_substr
				core_user_var
				core_pseudo_func
				core_regexp

				core_hup_recv
				core_prefered_codec

				core_b64hash
				core_extract_range
			);

#########################################################
#
sub core_get_datetime {
	my ( $obj, $timestamp, $format ) = @_;

	$obj->core_log( @_ ) if $obj->core_log_level(64);

	return strftime( ($format || $obj->core_creds()->{'DATE_FORMAT_STR'} || $obj->core_cfg_get( 'COMMON_DATE_FORMAT' )), localtime($timestamp) );
}

#########################################################
#
sub core_change_tz {
	my ( $obj, $tz, $lang ) = @_;

	$obj->core_log( @_ ) if $obj->core_log_level(64);

	unless ( defined $tz ) {
		Env::C::unsetenv('TZ');
		$ENV{'LANG'} = $obj->core_session()->{'_OLD_LANG'};
	} else {
		if ( $tz ne 'Default' ) {
			Env::C::setenv('TZ', $tz, 1);
			POSIX::setlocale( POSIX::LC_TIME, $lang );
		}
		$obj->core_session()->{'_OLD_LANG'} = $ENV{'LANG'};
	}
}

#########################################################
#
sub core_sound_file_length {
	my ( $obj, $file ) = @_;

	$obj->core_log( @_ ) if $obj->core_log_level(64);

	my $duration = 0;

	if ( $file =~ /\.(mp3|ogg|gsm|wav)$/i ) {
		if ( lc($1) eq 'mp3' ) {
			require MP3::Info;
			my $tag = MP3::Info::get_mp3tag($file);
			$duration = $tag->{'SECS'};
		} else {
			my $data = $obj->core_run_system( "sox $file -n stat 2>&1" );
			if ( $data =~ /Length\s*\(seconds\):\s*(\d+)/gs ) {
				$duration = $1;
			}
		}
	} else {
		my $file_size = -s $file;
		if ( $file =~ /\.(wav16|slin16)$/ ) {
			$duration = int($file_size/16000);
		} else {
			$duration = int($file_size/8000);
		}
	}

	return $duration;
}

#########################################################
#
sub core_sound_check_file {
	my ( $obj, $file ) = @_;

	#
	# check invalid __USER__ files ( null, or wav header only )
	#
	if ( index( $file, '/' ) == 0 and ( ! -r $file or -s $file <= 44 ) ) {
		$obj->core_log( [ 'Invalid file: %s, size:%s', $file, ((-s $file)||'unknown') ] ) if $obj->core_log_level(16);
		return 0;
	}
	return 1;
}

#########################################################
#
sub core_run_system {
	my (  $obj, $cmd, $ignore_error ) = @_;
	
	$obj->core_log( @_ ) if $obj->core_log_level(64);

	return '' if $cmd eq 'true';

	my $output = `$cmd`;

	if ( $? and not defined $ignore_error ) {
		$obj->core_log( [ 'SYS error: cmd=%s, output="%s"',$cmd, $output ] ) if $obj->core_log_level(1);
		return undef;
	} elsif ( not defined $output ) {
		return '';
	} else {
		return $output;
	}
}

#########################################################
#
sub core_get_unique {
	my $obj = shift;

	return core_b64hash(undef,$obj->core_cfg_get( 'COMMON_SERVER_ID' ), time, rand, $$, $obj);
}

########################################################################
#
sub core_b64hash {
	my $obj = shift;

	my $md5 = md5_base64( join('-',@_) );

	$md5 =~ s#/#I_#g;
	$md5 =~ s#\+#O_#g;

	return $md5;
}

#########################################################
#
sub core_rename {
	my ( $obj, $from_file, $to_file ) = @_;

	$obj->core_log( @_ ) if $obj->core_log_level(64);

	unless ( defined $obj->core_run_system( "mv -f '$from_file' '$to_file'") ) {
		return 0;
	} else {
		return 1;
	}
}

#########################################################
#
sub core_unlink {
	my ( $obj, @files ) = @_;

	$obj->core_log( @_ ) if $obj->core_log_level(64);

	my $cnt = unlink(@files);

	if ( $cnt < scalar(@files) ) {
		$obj->core_log( [ 'Unlink error: [' .join(', ',@files) .'] :  %s', $! ] ) if $obj->core_log_level(2);
		return 0;
	} else {
		return 1;
	}
}

#########################################################
#
#  0 - fatal errors
#  1 - errors
#  2 - warnings
#  4 - notice
#  8 - dtmf 
# 16 - debug
#
# 64 - verbose
#
sub core_log {
	my ( $obj,  @msg ) = @_;

	my @caller = caller(1);

	my $param_ind = 0;

	foreach my $str ( @msg ) {
		if ( ref $str eq 'ARRAY' ) {
			$str = sprintf( $str->[0], (@$str)[1..$#{$str}]);
		}
		unless ( defined $str ) {
			$str = 'undef';
		}
		$str =~ s#\s*\n\s*# #g;
		my ( $time, $ms ) = gettimeofday;
		my $time_str = sprintf( '%2.2d/%2.2d %2.2d:%2.2d:%2.2d%s',
									((localtime($time))[4])+1,(localtime($time))[3,2,1,0], substr( sprintf('%.3f',"0.$ms"),1 ) );
		
		my $log_str = sprintf( "[%s] [%s:%s:%s] : %s\n",
									($obj->{'_CDR'}->{'CALL_ID'}||$$),
									$caller[3],
									$caller[2],
									$param_ind++,
									$str );

		if ( index($obj->core_cfg_get( 'DEBUG_SEND_TO' ), 'FILE') > -1 ) {
			my $log_fh = $obj->{'_LOG'}->{'FH'};
			flock( $log_fh, LOCK_EX ) if $log_fh;
			if (	 	!  $log_fh
							or 
						! print( $log_fh "$time_str $log_str" ) ) {
					
					print STDERR "$time_str $log_str";

					if ( $obj->{'_LOG'}->{'OPEN_TIME'} + 60 < time ) {
						$obj->{'_LOG'}->{'OPEN_TIME'} = 0;
					}
			}
			flock( $log_fh, LOCK_UN ) if $log_fh;
			if ( $obj->{'_LOG'}->{'OPEN_TIME'} + $obj->core_cfg_get( 'TIMEOUT_LOG_REOPEN' ) < time ) {
				close $log_fh if $log_fh;
				undef $log_fh;
				$obj->core_log_init('FILE');
			}
		}
		if ( index($obj->core_cfg_get( 'DEBUG_SEND_TO' ), 'SYSLOG') > -1  ) {
			syslog( 'info', $log_str );
		}
	}
}

#
# fail2ban login errors
#
sub core_f2ban_log {
	my ( $obj, $params ) = @_;

	my $time = time;
	my $time_str = sprintf( '%4.4d/%2.2d/%2.2d %2.2d:%2.2d:%2.2d',
							((localtime($time))[5])+1900,((localtime($time))[4])+1,(localtime($time))[3,2,1,0] );

	$params->[0] =~ s#%time%#$time_str#g;
	
	my $log_fh	= IO::File->new();
	if ( $log_fh->open('>>'. $obj->core_cfg_get( 'PATH_CDR_DIR' ) .'/XVB.secure' ) ) {
		$log_fh->autoflush();
	} else {
		print STDERR "Can't open SECURE LOG FILE: $!\n";
		printf STDERR @$params;
		print STDERR "\n";
		return;
	}

	printf $log_fh @$params;
	print $log_fh "\n";
	$log_fh->close();
}

#########################################################
#
sub core_log_init {
	my ( $obj, $mode ) = @_;

	my $send_to = $mode || $obj->core_cfg_get( 'DEBUG_SEND_TO' );

	if ( index($send_to, 'FILE') > -1  ) {
		my $log_fh	= IO::File->new();
		if ( $log_fh->open('>>'. $obj->core_cfg_get( 'DEBUG_FILE' )) ) {
			$log_fh->autoflush();
		} else {
			print STDERR "Can't open LOG FILE: ". $obj->core_cfg_get( 'DEBUG_FILE' ) . ": $!\n";
		}
		$obj->{'_LOG'} = {	
							FH 			=> $log_fh,
							OPEN_TIME	=> time
						};
	}
	if ( index($send_to, 'SYSLOG') > -1  ) {
		if ( length($obj->core_cfg_get( 'DEBUG_HOST' )) ) {
			setlogsock('udp');
			$Sys::Syslog::host = $obj->core_cfg_get( 'DEBUG_HOST' );
		}
		openlog('XVB','ndelay','user');
	}
}

#########################################################
#
sub core_log_level {
	my ( $obj, $level )  = @_;
	
	if ( $obj->core_cfg_get( 'DEBUG_LEVEL' ) & $level ) {
		return 1;
	} elsif ( $obj->core_cfg_get( 'DEBUG_FULL' ) and $obj->core_cfg_get( 'DEBUG_FULL' ) =~ /\b\Q$obj->{'_CDR'}->{'ACCESS_CODE'}\E\b/ ) {
		return 1;
	} else {
		return 0;
	}
}

#########################################################
#
sub core_cfg_get {
	my ( $obj, $var ) = @_;

#	$obj->core_log( @_, $obj->{'_CONF'}->{lc $var} ) if $obj->core_log_level(64);

	return $obj->{'_CONF'}->{lc $var};
}

#########################################################
#
sub core_cfg_init {
	my ( $obj, $config_file, $conf_key, $override_options ) = @_;
	
	return unless defined $config_file;

	$conf_key ||= '_CONF';

	_core_cfg_file_read( $obj, $config_file, $conf_key );

	if ( ref $override_options eq 'HASH' ) {
		foreach my $k ( keys %$override_options ) {
			$obj->{$conf_key}->{lc($k)} = $override_options->{$k};
		}
	}
}

#########################################################
#
sub core_creds {
	my $obj = shift;

	return $obj->{'_USER_CREDS'} || ( $obj->{'_USER_CREDS'} = {} ) ;
}

#########################################################
#
sub core_vboxes {
	my $obj = shift;

	return $obj->{'_USER_VBOXES'} || ( $obj->{'_USER_VBOXES'} = {} );
}

#########################################################
#
sub core_session {
	my $obj = shift;

	return $obj->{'_SESSION'} || ( $obj->{'_SESSION'} = {} );
}

#########################################################
#
sub core_watchdog {
	my ( $obj, $param ) = @_;

	$obj->core_log( @_ ) if $obj->core_log_level(64);

	#
	# watchdog
	#
	unless ( exists $obj->core_session()->{'_WATCHDOG'} ) {
		$obj->core_session()->{'_WATCHDOG'} = {};
	}
	my $watchdog_data = $obj->core_session()->{'_WATCHDOG'};

	if ( $watchdog_data->{'PARAM'} eq $param ) {
		if ( $watchdog_data->{'CNT'}++ >= $obj->core_cfg_get('WATCHDOG_TH') ) {
			$obj->core_log( [ 'WatchDog TH, file: %s', $param ] );
			die;
		}
	} else {
		$watchdog_data->{'PARAM'} = $param;
		$watchdog_data->{'CNT'} = 1;
	}
}

#########################################################
#
sub core_counters {
	my ( $obj, $type, $key, $value, $exp, $max ) = @_;

	my $rc;

	if ( $type eq 'decr' ) {
		$rc = $obj->cache_decr( "sh-$key", $value );
		$obj->cache_decr( $key, $value ) if $obj->core_cfg_get( 'COMMON_MEM_CACHED' ) ne $obj->core_cfg_get( 'COMMON_MEM_CACHED_SHARED' );
	} else {
		unless ( $max ) {
			$rc = $obj->cache_incr( "sh-$key", $value, $exp );
			$obj->cache_incr( $key, $value ) if $obj->core_cfg_get( 'COMMON_MEM_CACHED' ) ne $obj->core_cfg_get( 'COMMON_MEM_CACHED_SHARED' );
		} else {
			$obj->cache_lock('lock',$key);
			
			$rc = $obj->cache_incr( "sh-$key", $value, $exp );
			$obj->cache_incr( $key, $value ) if $obj->core_cfg_get( 'COMMON_MEM_CACHED' ) ne $obj->core_cfg_get( 'COMMON_MEM_CACHED_SHARED' );

			if ( $rc >= $max ) {
				$obj->cache( "sh-$key", undef, 0 );
				$obj->cache( $key, undef, 0 ) if $obj->core_cfg_get( 'COMMON_MEM_CACHED' ) ne $obj->core_cfg_get( 'COMMON_MEM_CACHED_SHARED' );
			}
			
			$obj->cache_lock('unlock',$key);
		}
	}
	
	$obj->core_log( [ 'Counters: op=%s, key=%s, value=%s',  $type, $key, $rc ] )  if $obj->core_log_level(16);

	return $rc;
}

########################################################################
#
# Get lists data
#
sub core_lists_get {
	my ( $obj, $name, $order_by, $where_ref, $raw_where ) = @_;

	$obj->core_log( @_ ) if $obj->core_log_level(64);

	$name = $obj->core_cfg_get( 'TABLES_' . $name );

	my @sql_params;

	#
	# core vbox info
	#
	my $sql1 = 'select
					*
				from
					'. $name;

	#
	# parse where params
	#
	if ( $where_ref and ref $where_ref eq 'HASH' ) {
		my @param_names = keys %$where_ref;
		$sql1 .= ' where ' . join( '=? and ', @param_names ) .'=?';
		@sql_params = (map { $where_ref->{$_} } @param_names);
	} elsif ( $raw_where ) {
		$sql1 .= $raw_where;
	}

	unless ( $order_by ) {
		$sql1 .= ' order by ID';
	} else {
		$sql1 .= " order by $order_by";
	}

	# c-key
	my $cache_key = "lists-$name-". $obj->core_b64hash($sql1,@sql_params);

	#
	# mem cached
	#
	my $a_ref = $obj->cache( $cache_key );

	return $a_ref if $a_ref;

	$a_ref = $obj->db_get_array_hashref( $sql1, @sql_params );

	unless ( $a_ref ) {
		#
		# db error
		#
		$a_ref = [] 
	} else {
		#
		# mem cached
		#
		$obj->cache( $cache_key, $a_ref );
	}

	$obj->core_log( [ '%s list items found', scalar(@$a_ref) ] ) if $obj->core_log_level(64);

	return $a_ref;
}

####################################################
#
# limits
#
sub core_check_limit {
	my ( $obj, $table, $limit, $where_ref ) = @_;

	$obj->core_log( @_ ) if $obj->core_log_level(64);

	my $sql = "select count(*) from $table";

	my @params;
	my $where_str = '';

	foreach my $k ( keys %{$where_ref} ) {
		if ( length($where_str) ) {
			$where_str .= ' and ';
		} 
		if ( length($where_ref->{$k}) ) {
			$where_str .= $k . '=?';
			push @params, $where_ref->{$k};
		} else {
			$where_str .= $k;
		}
	}
	
	if ( length($where_str) ) {
		$sql .= ' where ' . $where_str;
	}

	my $count = $obj->db_get_value( $sql, @params );

	if ( ! defined $count or $count+1 > $limit ) {
		return 0;
	} else {
		return $count || -1;
	}
}

#########################################################
#
sub core_substr {
	my ( $obj, $str, $param ) = @_;

	unless ( $param ) {
		return $str;
	} else {
		my ( $from, $len ) = split(/:/,$param);
		if ( length($len) ) {
			return substr($str,($from||0),$len);
		} else {
			return substr($str,($from||0));
		}
	}
}

#########################################################
#
sub core_pseudo_func {
	my ( $obj, $func, $param ) = @_;

	if ( $func eq 'RAND' ) {
		my ( $rand_num, $flags ) = split( /:/,lc($param) );
		my $result;

		# s - string in case of custom values
		# f - return floating		
		# i - interger / default /
		# r - reinit
		
		$flags .= 'i' unless $flags =~ /[fs]/;
	
		if ( $flags =~ s/r// or not exists $obj->core_session()->{'_USER_VARIABLES'}->{"RAND($rand_num:$flags)"} ) {
			if ( $rand_num =~ /,/ ) {
				$result = (sort { rand(100000) <=> rand(100000) } ( split(/\s*,\s*/,$rand_num) ))[0];
			} else {
				$result = rand(int($rand_num)||time);
			}
		} else {
			$result = $obj->core_session()->{'_USER_VARIABLES'}->{"RAND($rand_num:$flags)"};
		}

		if ( $flags =~ /i/ ) {
			$obj->core_session()->{'_USER_VARIABLES'}->{"RAND($rand_num:$flags)"} = int($result);
		} else {
			$obj->core_session()->{'_USER_VARIABLES'}->{"RAND($rand_num:$flags)"} = $result;
		}
		
		return $obj->core_session()->{'_USER_VARIABLES'}->{"RAND($rand_num:$flags)"};
	} elsif ( $func eq 'COUNTER' and $param =~ /^([^:]+):([^:]+)(:([\w\d]+))?$/ ) {
		my ( $name, $limit, $flags ) = ( $1, $2, $4 );
		# flags: r - reinit
		unless ( lc($flags) eq 'r' ) {
			if ( exists $obj->core_session()->{'_USER_VARIABLES'}->{"COUNTER($name:$limit)"} ) {
				return $obj->core_session()->{'_USER_VARIABLES'}->{"COUNTER($name:$limit)"};
			}
		}

		if ( $limit =~ /^\d+$/ ) {
			return $obj->core_session()->{'_USER_VARIABLES'}->{"COUNTER($name:$limit)"} = $obj->core_counters( 'incr', join('-', 'u_cntr', $obj->{'_CDR'}->{'ACCESS_CODE'}, $name ), undef, undef, $limit );
		} else {
			my @u_params = split(/\s*,\s*/,$limit);
			my $ind = $obj->core_counters( 'incr', join('-', 'u_cntr', $obj->{'_CDR'}->{'ACCESS_CODE'}, $name ), undef, undef, scalar(@u_params) );
			return $obj->core_session()->{'_USER_VARIABLES'}->{"COUNTER($name:$limit)"} = $u_params[$ind-1];
		}

	} else {
		return '';
	}
}

####################################################
#
sub core_user_var {
	my ( $obj, $data, $skip_http_quote, $init_only, $l_vars, $no_macros ) = @_;

	$obj->core_log( @_ ) if $obj->core_log_level(64);
					
	#
	# check DB_VAR
	#
	my $dbvar_id;
	if ( exists $obj->{'_VTYPE'} ) {
		foreach my $l_id ( keys %{ $obj->{'_VTYPE'} } ) {
			if ( $obj->{'_VTYPE'}->{$l_id}->{'Name'} eq 'DBVar' ) {
				$dbvar_id = $l_id;
				last;
			}
		}
	}
	if ( defined($dbvar_id) ) {
		my $vb_ref = $obj->core_vboxes();
		foreach my $vb_id ( keys %{ $vb_ref } ) {
			if ( $vb_ref->{$vb_id}->{'TYPE'} eq $dbvar_id ) {
				$obj->core_session()->{'_USER_VARIABLES'}->{ uc( 'DB-'. $vb_ref->{$vb_id}->{'EXT_NUMBER'} ) } = $vb_ref->{$vb_id}->{'VAR_VALUE'};
			}
		}
	}

	return 1 if $init_only;

	if ( ! $no_macros ) {
		foreach my $i ( 0 .. $#{$data} ) {
			if ( $data->[$i] =~ m#\%\s*[Mm][Aa][Cc][Rr][Oo]\s*:\s*([^%\s]+)\s*\%#gs ) {
				$data->[$i] = $obj->macros_run($data->[$i]||'');
			}
		}
	}

	$obj->core_session()->{'_USER_VARIABLES'} = {} unless ref $obj->core_session()->{'_USER_VARIABLES'} eq 'HASH';

	my %vars = %{ $obj->core_session()->{'_USER_VARIABLES'} };

	if ( ref $l_vars eq 'HASH' ) {
		foreach my $l_k ( keys %{$l_vars} ) {
			$vars{$l_k}	= $l_vars->{$l_k};
		}
	}

	$vars{'CID'}		= $obj->{'_CDR'}->{'CALLER_ID'};
	$vars{'DID'}		= $obj->{'_CDR'}->{'CALLED_ID'};
	$vars{'CNAM'}		= $obj->{'_CDR'}->{'CNAM'};
	$vars{'C_ID'}		= $obj->{'_CDR'}->{'CALL_ID'};
	$vars{'C_TYPE'}		= $obj->{'_CDR'}->{'CALL_TYPE'};
	$vars{'C_TIME'}		= time - int($obj->{'_CDR'}->{'CALL_START'});
	$vars{'C_START'}	= $obj->{'_CDR'}->{'CALL_START'} || time;
	$vars{'CUR_EXTEN'} 		 = $obj->core_session()->{'_CUR_VBOX'};
	$vars{'CUR_EXTEN_NAME'}  = $obj->{'_USER_VBOXES'}->{ $vars{'CUR_EXTEN'} }->{'NAME'};

	if ( $vars{'CUR_EXTEN'} eq 'i' or $vars{'CUR_EXTEN'} =~ /\*i$/ ) {
		$vars{'CUR_INVALID_INPUT'} = $obj->core_session()->{'_CUR_INVALID_INPUT'};
		$vars{'CUR_INVALID_INPUT'} =~ s#\*#,#g;
	}
	
	$vars{'ACCESS_CODE'} = $obj->{'_CDR'}->{'ACCESS_CODE'};

	$obj->core_change_tz($obj->core_creds()->{'TZ_NAME'}, $obj->core_creds()->{'LANG_LOCALE'});
	$vars{'DATETIME'} = $obj->core_get_datetime(time);
	$obj->core_change_tz();

	foreach my $i ( 0 .. $#{$data} ) {
		# functions RAND/COUNTER/...
		$data->[$i] =~ s#%\s*[Vv][Aa][Rr]:(\w+)\(([^\)]+)\)(:([^%\s]+))?\s*%# $obj->core_substr( $obj->core_pseudo_func( uc($1), $2 ), $4 ) #ge;
		# static vars
		$data->[$i] =~ s#%\s*[Vv][Aa][Rr]:([\d\w_\*-]+)(:([^%\s]+))?\s*%# $obj->core_substr($vars{uc($1)},$3) #ge;
	}

	unless ( $skip_http_quote ) {
		foreach my $i ( 0 .. $#{$data} ) {
			$data->[$i] =~ s#([^\w\d/._?\\:=&;%\@-])# '%'. unpack('H2', $1) #ge;
		}
	}

	return @$data;
}

####################################################
#
# core regexp
#
sub core_regexp {
	my ( $obj, $str, $regexp ) = @_;

	my $rc = 0;

	my $op = '';
	my $eval_str = '';

	foreach my $chunk ( split( /\s*([&|]\s*)/, $regexp ) ) {
		if ( $chunk eq '&' ) {
			$eval_str .= ' and ';
		} elsif ( $chunk eq '|' ) {
			$eval_str .= ' or ';
		} else {
			$op = '';
	
			# reverse
			my $reverse = 0;
			$reverse = 1 if $chunk =~ s/^!//;

			# relax regexp
			$chunk =~ s#[^_\w\d.*\[\]\@\{\},\^?+\\:ёйцукенгшщзхъфывапролджэячсмитьбюЁЙЦУКЕНГШЩЗХФЫВАПРОЛДЖЭЯЧСМИТЬБЮ-]##gs;
			$chunk =~ s#\\+[^*.+dw]##gs;
			$chunk =~ s#\@#\\@#gs;

			if ( $reverse ) {
				$eval_str .= "\$str !~ /^$chunk\$/i";
			} else {
				$eval_str .= "\$str =~ /^$chunk\$/i";
			}
		}
	}

	eval "\$rc = 1 if ( $eval_str )";
	
	$rc = 0 if $@;

	return $rc;
}


########################################################################
#
# core_media_convert
#
sub core_media_convert {
	my ( $obj, $in_file, $out_file ) = @_;

	$obj->core_log( @_ ) if $obj->core_log_level(16);

	my ( $in_ext, $out_ext );

	$in_ext = lc($1) if $in_file =~ m/\.([\w\d]+)$/;

	$out_ext = lc($1) if $out_file =~ m/\.([\w\d]+)$/;

	if ( $in_ext eq $out_ext ) {
		if ( $in_file eq $out_file ) {
			return 'true';
		} else {
			return "cp -f $in_file $out_file";
		}
	}
	
	unless ( exists $obj->{'_MEDIA_EXT'} ) {
		core_media_convert_init( $obj );
	}

	#
	# check media type support
	#
	if ( exists $obj->{'_MEDIA_EXT'}->{$out_ext} ) {
		foreach my $h_ref (  @{ $obj->{'_MEDIA_EXT'}->{$out_ext} } ) {
			if ( exists $h_ref->{'from'}->{$in_ext} ) {
					return sprintf($h_ref->{'cmd'}, $in_file, $out_file);
			}
		}
	}

	return 0;
}

########################################################################
#
sub core_media_convert_init {
	my $obj = shift;

	if ( index(lc($obj->core_cfg_get('COMMON_USEFFMPEG4')),'g722') == -1 ) {
		$obj->{'_MEDIA_EXT'} = {
						mp3		=> [ 	{ 	from 	=> { qw( mp3 1 ul 1 al 1 gsm 1 wav16 ) },
											cmd		=> '(sox %s -b 8 '. ($obj->core_cfg_get('COMMON_SOXSIGNED') || ' -s ') .' -c 1 -t wav - | lame --quiet -m m -b 64 -h - %s ) 2> /dev/null'
										},
										{ 	from 	=> { qw( wav 1 ) },
											cmd		=> 'lame --quiet -b 64 -h --cbr %s %s 2> /dev/null'
										},
										{
											from	=> { qw( g722 1 ) },
											cmd		=> "g722_decode \%s /tmp/dec_$$.raw &>/dev/null && (sox ". ($obj->core_cfg_get('COMMON_SOXSIGNED') || ' -s ') ." -b 16 -r 16000 /tmp/dec_$$.raw -r 16000 -c 1 -t wav - | lame --quiet -m m -h --cbr -b 64 - \%s) 2>/dev/null && rm -f /tmp/dec_$$.raw || ( rm -f /tmp/dec_$$.raw; false )"
										},
										{
											from	=> { qw( ogg 1 ) },
											cmd		=> "echo y | ffmpeg -f ogg -i \%s \%s &>/dev/null"
										}
									],
						
						g722	=> [ 	{
											from 	=> { qw( wav 1 mp3 1 ul 1 al 1 gsm 1 wav16 ) },
											cmd		=> "(sox \%s ". ($obj->core_cfg_get('COMMON_SOXSIGNED') || ' -s ') ." -b 16 -r 16000 -c 1 /tmp/enc_$$.raw && g722_encode /tmp/enc_$$.raw \%s &>/dev/null) && rm -f /tmp/enc_$$.raw || ( rm -f /tmp/dec_$$.raw; false )"
										},
										{
											from	=> { qw( ogg 1 ) },
											cmd		=> "( ffmpeg -f ogg -i %s -f wav -ar 16000 /tmp/enc_$$.wav && sox /tmp/enc_$$.wav ". ($obj->core_cfg_get('COMMON_SOXSIGNED') || ' -s ') ." -b 16 -r 16000 -c 1 /tmp/enc_$$.raw && rm -f /tmp/enc_$$.wav && g722_encode /tmp/enc_$$.raw %s &>/dev/null) && rm -f /tmp/enc_$$.raw || ( rm -f /tmp/dec_$$.raw; false )"
										}
									],
						
						ul		=> [ 	{
											from 	=> { qw( wav 1 mp3 1 ul 1 al 1 gsm 1 wav16 1) },
											cmd		=> 'sox %s -r 8000 -c 1 %s'
										},
										{
											from 	=> { qw( ogg 1 ) },
											cmd		=> "echo y | ffmpeg -f ogg -i \%s -ac 1 -ar 8000 \%s &>/dev/null"
										},
										{
											from	=> { qw( g722 1 ) },
											cmd		=> "(g722_decode \%s /tmp/dec_$$.raw &>/dev/null && sox ". ($obj->core_cfg_get('COMMON_SOXSIGNED') || ' -s ') ." -b 16 -r 16000 /tmp/dec_$$.raw -r 8000 -c 1 \%s) && rm -f /tmp/dec_$$.raw || ( rm -f /tmp/dec_$$.raw; false )"
										}
									],
						
						wav		=> [ 	{
											from 	=> { qw( wav 1 mp3 1 ul 1 al 1 gsm 1 wav16 1) },
											cmd		=> 'sox %s -r 8000 -c 1 %s'
										},
										{
											from 	=> { qw( ogg 1 ) },
											cmd		=> "echo y | ffmpeg -f ogg -i \%s -ac 1 -ar 8000 \%s &>/dev/null"
										},
										{
											from	=> { qw( g722 1 ) },
											cmd		=> "(g722_decode \%s /tmp/dec_$$.raw &>/dev/null && sox ". ($obj->core_cfg_get('COMMON_SOXSIGNED') || ' -s ') ." -b 16 -r 16000 /tmp/dec_$$.raw -r 16000 -c 1 \%s) && rm -f /tmp/dec_$$.raw || ( rm -f /tmp/dec_$$.raw; false )"
										}
									],
						
						ogg		=> [ 	{
											from 	=> { qw( wav 1 mp3 1 ul 1 al 1 ogg 1 gsm 1 wav16 1) },
											cmd		=> 'sox %s %s'
										},
										{
											from	=> { qw( g722 1 ) },
											cmd		=> "(g722_decode \%s /tmp/dec_$$.raw &>/dev/null && sox ". ($obj->core_cfg_get('COMMON_SOXSIGNED') || ' -s ') ." -b 16 -r 16000 /tmp/dec_$$.raw -r 16000 \%s) && rm -f /tmp/dec_$$.raw || ( rm -f /tmp/dec_$$.raw; false )"
										}
									],

						wav16	=> [ 	{
											from 	=> { qw( wav 1 mp3 1 ul 1 al 1 gsm 1 wav16 1) },
											cmd		=> 'sox %s -r 16000 -c 1 -t wav %s'
										},
										{
											from 	=> { qw( ogg 1 ) },
											cmd		=> "echo y | ffmpeg -f ogg -i \%s -ac 1 -ar 16000 \%s &>/dev/null"
										},
										{
											from	=> { qw( g722 1 ) },
											cmd		=> "(g722_decode \%s /tmp/dec_$$.raw &>/dev/null && sox ". ($obj->core_cfg_get('COMMON_SOXSIGNED') || ' -s ') ." -b 16 -r 16000 /tmp/dec_$$.raw -r 16000 -c 1 -t wav \%s) && rm -f /tmp/dec_$$.raw || ( rm -f /tmp/dec_$$.raw; false )"
										}
									],
		};
		#
		# clone ul,al,ogg,gsm,wav
		#
		$obj->{'_MEDIA_EXT'}->{'gsm'} = $obj->{'_MEDIA_EXT'}->{'al'} = $obj->{'_MEDIA_EXT'}->{ 'ul' };
	} else {
		my ( @sox4mp3, @ffmpeg4mp3 );
	
		if ( index(lc($obj->core_cfg_get('COMMON_USEFFMPEG4')),'mp3') == -1 ) {
			@sox4mp3 = ( mp3 => 1 );
		} else {
			@ffmpeg4mp3 = ( mp3 => 1 );
		}
	
		$obj->{'_MEDIA_EXT'} = {
		
			mp3		=> [ 	{ 	from 	=> { qw( mp3 1 ul 1 al 1 gsm 1 wav16 1 ) },
								cmd		=> '(sox %s -b 8 '. ($obj->core_cfg_get('COMMON_SOXSIGNED') || ' -s ') .' -c 1 -t wav - | lame --quiet -m m -b 64 -h - %s ) 2> /dev/null'
							},
							{ 	from 	=> { qw( wav 1 ) },
								cmd		=> 'lame --quiet -b 64 -h --cbr %s %s 2> /dev/null'
							},
							{
								from	=> { qw( g722 1 ) },
								cmd		=> "ffmpeg -f g722 -ac 1 -i \%s -f wav -ar 16000 - 2>/dev/null | lame --quiet -m m -h --cbr -b 64 - \%s"
							},
							{
								from	=> { qw( ogg 1 ) },
								cmd		=> "echo y | ffmpeg -f ogg -i \%s \%s &>/dev/null"
							}
						],
						
			g722	=> [ 	
							{
								from 	=> { qw( wav 1 wav16 1) },
								cmd		=> "echo y | ffmpeg -f wav -i \%s -ac 1 -ar 16000 \%s &>/dev/null"
							},
							{
								from 	=> { qw( mp3 1 ) },
								cmd		=> "echo y | ffmpeg -f mp3 -i \%s -ac 1 -ar 16000 \%s &>/dev/null"
							},
							{
								from 	=> { qw( ogg 1 ) },
								cmd		=> "echo y | ffmpeg -f ogg -i \%s -ac 1 -ar 16000 \%s &>/dev/null"
							},
							{
								from 	=> { qw( al 1 ) },
								cmd		=> "echo y | ffmpeg -ac 1 -ar 8000 -f alaw -i \%s -ac 1 -ar 16000 \%s &>/dev/null"
							},
							{
								from 	=> { qw( ul 1 ) },
								cmd		=> "echo y | ffmpeg -ac 1 -ar 8000 -f mulaw -i \%s -ac 1 -ar 16000 \%s &>/dev/null"
							},
							{
								from 	=> { qw( gsm 1 ) },
								cmd		=> "echo y | ffmpeg -f gsm -i \%s -ac 1 -ar 16000 \%s &>/dev/null"
							},
						],
						
			ul		=> [ 	{
								from 	=> { qw( wav 1 ul 1 al 1 gsm 1 wav16 1), @sox4mp3 },
								cmd		=> 'sox %s -r 8000 -c 1 %s'
							},
							{
								from	=> { qw( g722 1 ) },
								cmd		=> "echo y | ffmpeg -f g722 -i \%s -ac 1 -ar 8000 \%s &>/dev/null"
							},
							{
								from 	=> { qw( ogg 1 ) },
								cmd		=> "echo y | ffmpeg -f ogg -i \%s -ac 1 -ar 8000 \%s &>/dev/null"
							},
							{
								from	=> { qw( dumbdumb 1 ), @ffmpeg4mp3 },
								cmd		=> "echo y | ffmpeg -f mp3 -i \%s -ac 1 -ar 8000 \%s &>/dev/null"
							}
						],
							
			gsm		=> [ 	{
								from 	=> { qw( wav 1 ul 1 al 1 ogg 1 gsm 1 wav16 1), @sox4mp3 },
								cmd		=> 'sox %s -r 8000 -c 1 %s'
							},
							{
								from	=> { qw( g722 1 ) },
								cmd		=> "echo y | ffmpeg -f g722 -i \%s -ac 1 -ar 8000 -f wav - | sox -t wav -r 8000 -c 1 - \%s &>/dev/null"
							},
							{
								from 	=> { qw( ogg 1 ) },
								cmd		=> "echo y | ffmpeg -f ogg -i \%s -ac 1 -ar 8000 -f wav - | sox -t wav -r 8000 -c 1 - \%s &>/dev/null"
							},
							{
								from	=> { qw( dumbdumb 1 ), @ffmpeg4mp3 },
								cmd		=> "echo y | ffmpeg -f mp3 -i \%s -ac 1 -ar 8000 -f wav - | sox -t wav -r 8000 -c 1 - \%s &>/dev/null"
							}
						],
	
			wav		=> [ 	{
								from 	=> { qw( wav 1 ul 1 al 1 gsm 1 wav16 1), @sox4mp3 },
								cmd		=> 'sox %s -r 8000 -c 1 %s'
							},
							{
								from	=> { qw( g722 1 ) },
								cmd		=> "echo y | ffmpeg -f g722 -i \%s -ac 1 -ar 8000 \%s &>/dev/null"
							},
							{
								from 	=> { qw( ogg 1 ) },
								cmd		=> "echo y | ffmpeg -f ogg -i \%s -ac 1 -ar 8000 \%s &>/dev/null"
							},
							{
								from	=> { qw( dumbdumb 1 ), @ffmpeg4mp3 },
								cmd		=> "echo y | ffmpeg -f mp3 -i \%s -ac 1 -ar 8000 \%s &>/dev/null"
							}
						],
			
			ogg		=> [ 	{
								from 	=> { qw( wav 1 ul 1 al 1 ogg 1 gsm 1 wav16 1), @sox4mp3 },
								cmd		=> 'sox %s %s'
							},
							{
								from	=> { qw( g722 1 ) },
								cmd		=> "echo y | ffmpeg -f g722 -i \%s -ac 1 -ar 16000 \%s &>/dev/null"
							},
							{
								from	=> { qw( dumbdumb 1 ), @ffmpeg4mp3 },
								cmd		=> "echo y | ffmpeg -f mp3 -i \%s -ac 1 -ar 16000 \%s &>/dev/null"
							}
						],

			wav16	=> [ 	{
								from 	=> { qw( wav 1 ul 1 al 1 gsm 1 wav16 1), @sox4mp3 },
								cmd		=> 'sox %s -r 16000 -c 1 -t wav %s'
							},
							{
								from	=> { qw( g722 1 ) },
								cmd		=> "echo y | ffmpeg -f g722 -i \%s -ac 1 -ar 16000 -f wav \%s &>/dev/null"
							},
							{
								from 	=> { qw( ogg 1 ) },
								cmd		=> "echo y | ffmpeg -f ogg -i \%s -ac 1 -ar 16000 \%s &>/dev/null"
							},
							{
								from	=> { qw( dumbdumb 1 ), @ffmpeg4mp3 },
								cmd		=> "echo y | ffmpeg -f mp3 -i \%s -ac 1 -ar 16000 \%s &>/dev/null"
							}
						],
			};
			#
			# clone ul,al,ogg,gsm,wav
			#
			$obj->{'_MEDIA_EXT'}->{'al'}  = $obj->{'_MEDIA_EXT'}->{ 'ul' };
		}
		
		$obj->{'_MEDIA_EXT'}->{'tif'} = [ 	{ 	
												from 	=> { qw( tif 1 ) },
												cmd		=> 'cp -f %s %s' 
											},
											{
												from	=> { qw(jpg 1 jpeg 1 png 1 tiff 1 txt 1) },
												cmd		=> "convert -define quantum:polarity=min-is-white -rotate '90>' -density 204x196 -resize 1728x -compress Group4 -type bilevel -monochrome \%s \%s"
											},
										];

		if ( -e '/usr/bin/convert' ) {
			push @{ $obj->{'_MEDIA_EXT'}->{'tif'} }, {
														from	=> { qw(pdf 1) },
														cmd		=> "( cat \%s | gs -q -sDEVICE=tiffg3 -sPAPERSIZE=a4 -r204x196 -dNOPAUSE -sOutputFile=/tmp/dec_$$.tif - >/dev/null && convert -define quantum:polarity=min-is-white -rotate '90>' -density 204x196 -resize 1728x -compress Group4 -type bilevel -monochrome /tmp/dec_$$.tif \%s ) && rm -f /tmp/dec_$$.tif || ( rm -f /tmp/dec_$$.tif; false )"
													};
		} else {
			push @{ $obj->{'_MEDIA_EXT'}->{'tif'} }, {
														from	=> { qw(pdf 1) },
														cmd		=> 'cat %s | gs -q -sDEVICE=tiffg3 -sPAPERSIZE=a4 -r204x196 -dNOPAUSE -sOutputFile=%s - >/dev/null'
													};
		}
	
		$obj->{'_MEDIA_EXT'}->{'pdf'} = [	{ 	
												from 	=> { qw( tif 1 ) },
												cmd		=> 'tiff2pdf %s > %s' 
											} 
										];

		$obj->{'_MEDIA_EXT'}->{'txt'} = [ 	{ 	
												from 	=> { qw( dat 1 ) },
												cmd		=> 'cp -f %s %s' 
											} 
										];
		
		$obj->{'_MEDIA_EXT'}->{'csv'} = [ 	{
												from 	=> { qw( xls 1 xlsx 1 ) },
												cmd		=> '/opt/VirtualPBX/contrib/utils/csv24xls %s %s' 
											},
										];
		$obj->{'_MEDIA_EXT'}->{'xls'} = [ 	{
												from 	=> { qw( csv 1 ) },
												cmd		=> '/opt/VirtualPBX/contrib/utils/csv24xls %s %s' 
											},
										];
		$obj->{'_MEDIA_EXT'}->{'xlsx'} = [ 	{
												from 	=> { qw( csv 1 ) },
												cmd		=> '/opt/VirtualPBX/contrib/utils/csv24xls %s %s' 
											},
										];
}

########################################################################
#
# core HUP Recv
#
sub core_hup_recv {
	my ( $obj, $old_handler ) = @_;

	my $hup_recv = $obj->core_session()->{'_HUP_RECV'};
	
	unless ( $old_handler ) {
		unless ( $hup_recv ) {
			$old_handler = $SIG{'HUP'};
			$SIG{'HUP'} = sub { local $SIG{__DIE__} = 'DEFAULT'; $obj->core_session()->{'_HUP_RECV'} = -1 };
			$obj->core_session()->{'_HUP_RECV'} = 1;
			return $old_handler;
		}
	} else {
		$SIG{'HUP'} = $old_handler;
		if ( $hup_recv == -1 ) {
			$obj->core_log( 'HUP RECV' ) if $obj->core_log_level(1);
			kill 1, $$;
			sleep 1;
		}
	}
	return undef;
}

####################################################
#
# extract ranges
#
sub core_extract_range {
	my ( $obj, $str ) = @_;
	
	my @out_numbers;

	foreach my $f_num ( split(/\s*,\s*/,$str) ) {
		unless ( $f_num =~ s#^(\d+)-(\d+)$#$1# ) {
			push @out_numbers, $f_num;
		} else {
			my $l_num = $2;
			if ( $l_num < $f_num ) {
				$l_num = $f_num;
			}
			for ( my $i = $f_num; $i <= $l_num; $i++ ) {
				push @out_numbers, $i;
			}
		}
	}

	return \@out_numbers;
}

########################################################################
#
# core get prefered codec
#
sub core_prefered_codec {
	my $obj = shift;

	return lc( $obj->core_creds()->{'PREF_CODEC'} || $obj->core_cfg_get('FILE_AST_SOUND_FORMAT') );
}

#
# read config
#
sub _core_cfg_file_read {
	my ( $obj, $config_file, $conf_key ) = @_;

	unless ( -e $config_file ) {
		die 'Bad configuration file: ' . $config_file;
	} else {
		my $fh	= new IO::File;

		my $section_name = 'COMMON';

		unless ( $fh->open('<' . $config_file ) ) {
			die "CRIT : Can not open file $config_file [ $! ]";
		} else {
			flock( $fh, LOCK_SH );

			while ( my $str = <$fh> ) {
				chomp $str;

				if ( $str =~ /^\s*#\!INCLUDE\s+(\S+)/ ) {
					_core_cfg_file_read( $obj, $1, $conf_key );
					next;
				}

				next if $str =~ /^\s*#/;
				next if $str =~ /^\s*$/;

				$str =~ s/^\s+//; 
				$str =~ s/\s+$//;

				if ( $str =~ /\[\s*(\S+)\s*\]/ ) {
					$section_name = $1;
					$section_name =~ s#_##g;
				} else {
					my ( $key, $val ) = split(/\s*=\s*/,$str,2);
					$val =~ s#^([\x22\x27])(.*)\1#$2#s;

					unless ( length $val ) {
						undef $obj->{$conf_key}->{lc($section_name.'_'.$key)};
					} else {
						$obj->{$conf_key}->{lc($section_name.'_'.$key)} = $val;
					}
				}
			}
			flock( $fh, LOCK_UN );
			close $fh;
		}
	}
}

1;
