package App::POS::Utils;

use App::POS::Config;
use File::Path qw( make_path );
use Data::Dumper;
use Number::Format;
use File::Slurp qw( read_file write_file read_dir );
use Date::Calc qw( Date_to_Time Delta_Days Add_Delta_Days Today Delta_DHMS );
use Digest::MD5 qw( md5_hex );
use Encode qw( decode encode is_utf8 );
use LWP::UserAgent qw( post );
use HTTP::Request::Common qw( POST PUT GET );
use JSON::XS qw( encode_json decode_json );
use POSIX qw( strftime );
use Cache::Memcached::Fast;
use Net::FTP;
use DateTime;
use IO::Socket::INET;

use Exporter::Easy (
  EXPORT => [qw(
    translate my_round my_conv fix_encoding date_based_on_closing_hour
    md5_from_file chars send_mail biz_name_dns dns_update public_ip
    hardlock_id execution_dates post stations_software_restart
    software_restart machine_ips post_json post_json2 log
    random_sleep emails_validate sales memcache
    read_translation_file date_is_bigger_or_equal date_is_bigger
    date_is_smaller date_is_smaller_or_equal trim ftp_put
    between_dates area_nextid is_date is_hour is_number has_numbers
    file_modif_secs url_encode url_decode tables_refresh
    db_table_fix_dup_ids send_alert_to_ui safe_string my_split
  )]
);

my %TRANSLATION_CACHE = ();
my $NFORMATER = Number::Format->new();

# if the string end with the delimiter and no value for the last field,
# this function counts the last field anyway. Perl split doesn't do that
sub my_split {
  my( $str, $char ) = @_;
  # my @fields = $str =~ /([^$char]*)/g;
  my @fields = split /$char/, $str, -1;
  return wantarray? @fields : \@fields;
}

sub safe_string {
  my ($string) = @_;
  return "" unless defined $string;

  # List of common encodings to try
  my @encodings = qw(utf-8 latin1 iso-8859-1 cp1252);

  # Attempt to decode the string from each encoding
  my $decoded_string;
  foreach my $encoding (@encodings) {
    # print STDERR "safe_string() - will try encoding - $encoding\n";
    $decoded_string = eval { decode($encoding, $string, Encode::FB_CROAK) };
    # # Exit loop if decoding successful
    if (defined $decoded_string) {
      # print STDERR "success on $encoding!\n";
      last;
    }
  }

  # If decoding fails, replace problematic characters with underscores
  unless (defined $decoded_string) {
    $decoded_string = $string;
    $decoded_string =~ s/[^\x00-\x7F]/_/g; # Replace non-ASCII characters with underscores
  }

  # If decoding succeeded
  unless (! defined $decoded_string) {
    $decoded_string = decode("utf8", encode("utf8", $decoded_string));
  }

  return $decoded_string;
}

# this function was created because we caught situations where the same db table
# had dupplicate ids (maybe from restores)
sub db_table_fix_dup_ids {
  my $db = shift;
  my $table = shift;

  my $recs = $db->select(qq{
    SELECT id, COUNT(*)
    FROM $table
    GROUP BY id
    HAVING COUNT(*) > 1
  });

  # no need to fix
  return unless scalar @$recs;

  print STDERR "Need to fix dupplicate ids in table $table...\n";

  my $serial_field = 'f'.$$;

  $db->do("ALTER TABLE $table ADD $serial_field SERIAL");

  foreach my $r (@$recs) {
    my $recs2 = $db->select("SELECT id, $serial_field FROM $table WHERE id = ? ORDER BY $serial_field", $r->{id});

    for (my $i=0; $i < scalar @$recs2; $i++) {
      next if $i == 0;
      $db->do("DELETE FROM $table WHERE $serial_field = ?", $recs2->[$i]->{$serial_field});
    }

  }

  $db->do("ALTER TABLE groups DROP $serial_field");

  print STDERR "Done...\n";
}

sub url_decode {
  my ($s) = @_;
  $s ||= "";
  return unless $s;
  #utf8::downgrade($s, 1)
  #  or Carp::croak(q/Wide character in octet string/);
  my %dec_map;
  for my $ord (0..255) {
    my $chr = pack 'C', $ord;
    my $hex = sprintf '%.2X', $ord;
    $dec_map{lc $hex} = $chr;
    $dec_map{uc $hex} = $chr;
    $dec_map{sprintf '%X%x', $ord >> 4, $ord & 15} = $chr;
    $dec_map{sprintf '%x%X', $ord >> 4, $ord & 15} = $chr;
  }
  $s =~ y/+/\x20/;
  $s =~ s/%([0-9A-Za-z]{2})/$dec_map{$1}/gs;
  return $s;
}

sub url_encode {
  my ($s) = @_;
  $s ||= "";
  return unless $s;
  #utf8::downgrade($s, 1)
  #  or Carp::croak(q/Wide character in octet string/);
  my %enc_map;
  for my $ord (0..255) {
    my $chr = pack 'C', $ord;
    my $hex = sprintf '%.2X', $ord;
    $enc_map{$chr} = '%' . $hex;
  }
  $enc_map{"\x20"} = '+';
  $s =~ s/([^0-9A-Za-z_.~-])/$enc_map{$1}/gs;
  return $s;
}


sub file_modif_secs {
  my $f = shift;
  return 0 unless -f $f;
  return 86400 * -M $f;
}

# fix string encoding
sub fix_encoding {
  my $str = shift;
  my $codepage = shift || "utf8";

  my $str_orig = $str;
  eval { $str = decode($codepage, $str, Encode::FB_CROAK); };

  if ($@) {
    #print STDERR "$@\n";
    # if error on decode, replace all non ascii chars by space
    #$str_orig =~ s/[[:^ascii:]]/ /g;
    return $str_orig;
  } else {
    return $str;
  }

=pod
  my $bck = $w;

  my $str = "";

  eval {
    $str = encode("utf8", $w);
  };

  if ($@) {
    eval { decode( 'utf8', $bck, Encode::FB_CROAK ) };

    if ($@) {
      $w =~ s/[^\w ]//g;
      return $w;
    }
    else {
      return $w;
    }
  }
  else {
    return $str;
  }
=cut
}

# check if a string is a date
sub is_date {
  my $str = shift;

  if ($str =~ /^\d\d\d\d\-\d\d\-\d\d$/) {
    return 1;
  } else {
    return 0;
  }
}

# check if a string is an hour
sub is_hour {
  my $str = shift;

  if ($str =~ /^\d\d\:\d\d$/) {
    return 1;
  } else {
    return 0;
  }
}

# check if a string is a number
sub is_number {
  my $str = shift;

  if ($str =~ /^-?(0|([1-9][0-9]*))(\.[0-9]+)?([eE][-+]?[0-9]+)?$/) {
    return 1;
  } else {
    return 0;
  }
}

# check if a string has numbers
sub has_numbers {
  my $str = shift;

  if ($str =~ /-?(0|([1-9][0-9]*))(\.[0-9]+)?([eE][-+]?[0-9]+)?/) {
    return 1;
  } else {
    return 0;
  }
}

# returns the number of minutes / days / etc between dates
# dates need to be in "YYYY-mm-dd HH:MM:SS" format
sub between_dates {
  my( $dt1, $dt2 ) = @_;

  my( $y1, $m1, $d1, $H1, $M1, $S1 ) = $dt1 =~ /^(\d+)\-(\d+)\-(\d+) (\d+):(\d+):(\d+)$/;
  my( $y2, $m2, $d2, $H2, $M2, $S2 ) = $dt2 =~ /^(\d+)\-(\d+)\-(\d+) (\d+):(\d+):(\d+)$/;

  my $date1 =  DateTime->new(
    year       => $y1,
    month      => $m1,
    day        => $d1,
    hour       => $H1,
    minute     => $M1,
    second     => $S1,
    time_zone  => 'UTC',
  );

  my $date2 =  DateTime->new(
    year       => $y2,
    month      => $m2,
    day        => $d2,
    hour       => $H2,
    minute     => $M2,
    second     => $S2,
    time_zone  => 'UTC',
  );

  my $secs = $date1->epoch - $date2->epoch;
  my $minutes = $secs / 60;
  my $hours = $secs / 60 / 60;
  my $days = $secs / 60 / 60 / 24;

  return(
    sprintf("%.2f", $days),
    sprintf("%.2f", $hours),
    sprintf("%.2f", $minutes),
    sprintf("%.2f", $secs),
  );
}

# from an area dir wo tables, returns the next id
sub area_nextid {
  my $dir = shift;
  my $id = 1;

  my $f = $dir."/nextid";

  if (-e $f) {
    my $tmpid = read_file($dir."/nextid");
    $tmpid =~ s/\n//g;
    $tmpid =~ s/\r//g;
    $tmpid ||= 1;
    $tmpid++;
    $id = $tmpid;
  }

  write_file($f, "$id\n");

  return $id;
}

sub ftp_put {
  my( $server, $port, $login, $pass, $folder, $file ) = @_;

  die "Missing param...\n" unless
    defined $server && defined $port && defined $login && defined $pass &&
    defined $folder && defined $file;

  die "Can't find file - $file\n" unless -f $file;

  eval {
    my $ftp = Net::FTP->new(
      $server,
      Port => $port,
      Debug => 1,
      Passive => 1,
      Timeout => 5,
    ) or die "Cannot connect: $@";

    $ftp->login($login, $pass);

    my $st = $ftp->cwd($folder);

    if (! $st) {
      $ftp->mkdir($folder);
      $ftp->cwd($folder);
    }

    $ftp->binary();
    $ftp->put($file);
    $ftp->quit();
  };

  if ($@) {
    die "FTP ERROR - $@\n";
  }

  return 1;
}

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

sub log {
  my $file = shift;
  my $m = shift;
  my $dont_cleanup = shift || 0;

  return unless defined $file && defined $m;

  my $now = &strftime("%Y%m%d_%H%M%S", localtime);

  if (! $dont_cleanup) {
    my $size = -s $file;
    $size ||= 0;

    if ($size > 2000000) {
      unlink $file;
    }
  }

  print STDERR "$now> $m\n";

  if (open(F, ">> $file")) {
    print F "$now> $m\n";
    close(F);
  }
}

sub date_is_bigger_or_equal {
  my( $date1, $date2 ) = @_;
  $date1 ||= "";
  $date2 ||= "";

  return undef unless $date1 && $date2;

  my( $to_y, $to_m, $to_d ) = $date1 =~ /^(\d+)\-(\d+)\-(\d+)$/;
  my( $now_y, $now_m, $now_d ) = $date2 =~ /^(\d+)\-(\d+)\-(\d+)$/;

  my $to_tmp = $to_y.$to_m.$to_d;
  my $now_tmp = $now_y.$now_m.$now_d;

  if ($to_tmp >= $now_tmp) {
    return 1;
  }

  return 0;
}

sub date_is_bigger {
  my( $date1, $date2 ) = @_;
  $date1 ||= "";
  $date2 ||= "";

  return undef unless $date1 && $date2;

  my( $to_y, $to_m, $to_d ) = $date1 =~ /^(\d+)\-(\d+)\-(\d+)$/;
  my( $now_y, $now_m, $now_d ) = $date2 =~ /^(\d+)\-(\d+)\-(\d+)$/;

  my $to_tmp = $to_y.$to_m.$to_d;
  my $now_tmp = $now_y.$now_m.$now_d;

  if ($to_tmp > $now_tmp) {
    return 1;
  }

  return 0;
}


sub date_is_smaller_or_equal {
  my( $date1, $date2 ) = @_;
  $date1 ||= "";
  $date2 ||= "";

  return undef unless $date1 && $date2;

  my( $to_y, $to_m, $to_d ) = $date1 =~ /^(\d+)\-(\d+)\-(\d+)$/;
  my( $now_y, $now_m, $now_d ) = $date2 =~ /^(\d+)\-(\d+)\-(\d+)$/;

  my $to_tmp = $to_y.$to_m.$to_d;
  my $now_tmp = $now_y.$now_m.$now_d;

  if ($to_tmp <= $now_tmp) {
    return 1;
  }

  return 0;
}

sub date_is_smaller {
  my( $date1, $date2 ) = @_;
  $date1 ||= "";
  $date2 ||= "";

  return undef unless $date1 && $date2;

  my( $to_y, $to_m, $to_d ) = $date1 =~ /^(\d+)\-(\d+)\-(\d+)$/;
  my( $now_y, $now_m, $now_d ) = $date2 =~ /^(\d+)\-(\d+)\-(\d+)$/;

  my $to_tmp = $to_y.$to_m.$to_d;
  my $now_tmp = $now_y.$now_m.$now_d;

  if ($to_tmp < $now_tmp) {
    return 1;
  }

  return 0;
}

sub my_round {
  my $scalar = shift;
  my $decimals = shift || 2;
  $decimals = $DECIMAL_PLACES unless defined $decimals;
  my $tmp = $NFORMATER->round($scalar, $decimals);
  return sprintf("%.".$decimals."f", $tmp);
=pod
  my $d = shift;
  my $r = shift || 2;

  my $r_first = $r+1;
  my $round1 = sprintf("%.".$r_first."f", $d);
  my $round2 = sprintf("%.".$r."f", $round1);
  return $round2;
=cut
}

sub my_conv {
  my $w = shift;
  return "" unless defined $w && $w ne '';

  # gambas3
  if (-e "/opt/pos/common/bin/pos.2") {
    my $is_utf8 = is_utf8($w);

    if ($is_utf8) {
      my $conv = encode("utf8", $w);
      return $conv;
    }
    else {
      return $w;
    }
  }
  # gambas2
  else {
    my $bck = $w;

    eval { decode( 'utf8', $bck, Encode::FB_CROAK ) };

    if ($@) {
      $w =~ s/[^\w ]//g;
      return $w;
    }
    else {
      return $w;
    }
  }
}

sub translate {
  my( $machine, $term ) = @_;

  my $ucterm = uc($term);

  my $dict = 'general';
  my $info = {};

  if (! exists $TRANSLATION_CACHE{$dict}) {
    my $cfg = $machine->config()->load_fixed();
    $cfg->{LANG_TRANSLATION} ||= 'PT';

    my $f = "/opt/pos/etc/i18n/".$cfg->{LANG_TRANSLATION}.".lang";

    if (open(F, "< $f")) {
      while (<F>) {
        s/\n//g;
        s/\r//g;
        next unless $_;
        my @a = split /§/;
        $a[0] =~ s/^\s+//;
        $a[0] =~ s/\s+$//;
        next if $a[0] =~ /^#/;
        $a[1] =~ s/^\s+//;
        $a[1] =~ s/\s+$//;
        $info->{uc($a[0])} = $a[1];
      }
      close(F);
    }

    $TRANSLATION_CACHE{$dict} = $info;
  }
  else {
    $info = $TRANSLATION_CACHE{$dict};
  }

  return exists $info->{$ucterm} ? $info->{$ucterm} : $term;
}

sub date_based_on_closing_hour {
  my $sale_date = shift;
  my $closing   = shift;

  $closing = $closing->[0] if ref($closing);

  my( $y, $m, $d, $h, $mi, $s ) = $sale_date =~ /^(\d+)\-(\d+)\-(\d+) (\d+):(\d+):(\d+)$/;

  my $close = "$y-$m-$d $closing";
  my( $y2, $m2, $d2, $h2, $mi2, $s2 ) = $close =~ /^(\d+)\-(\d+)\-(\d+) (\d+):(\d+):(\d+)$/;

  my $sale_time  = &Date_to_Time( $y, $m, $d, $h, $mi, $s );
  my $close_time = &Date_to_Time( $y2, $m2, $d2, $h2, $mi2, $s2 );

  my $diff = $sale_time - $close_time;

  if ($h2 >= 12) {
    if ($diff > 0) {
      $sale_date =~ s/\s+.*?$//;
      return $sale_date;
    } else {
      #my( $year, $month, $day ) = $sale_date =~ /^(\d+)\-(\d+)\-(\d+)/;
      my ($fy, $fm, $fd) = Add_Delta_Days($y, $m, $d, -1);
      return "$fy-".sprintf("%02d", $fm)."-".sprintf("%02d", $fd);
    }
  } else {
    if ($diff > 0) {
      $sale_date =~ s/\s+.*?$//;
      return $sale_date;
    } else {
      my ($fy, $fm, $fd) = Add_Delta_Days($y, $m, $d, -1);
      return "$fy-".sprintf("%02d", $fm)."-".sprintf("%02d", $fd);
    }
  }

  $sale_date =~ s/\s+.*?$//;
  return $sale_date;
}

sub md5_from_file {
  my $file = shift;

  if (open(F, "< $file")) {
    local $/ = undef;
    my $cnt = <F>;
    close(F);
    return md5_hex($cnt);
  }

  return "";
}

sub chars {
  my $scalar = shift;
  my $num = shift;
  return $scalar unless defined $num;

  my $decoded = decode("utf8", $scalar);

  if (length($decoded) > $num) {
    $decoded = substr($decoded, 0, $num);
  }
  elsif (length($decoded) < $num) {
    my $spaces = $num - length($decoded);
    $decoded .= " " x $spaces;
  }

  $decoded = encode("utf8", $decoded);

  return $decoded;
}

=pod
send_mail(
  to => 'mmanso@gmail.com',
  subject => 'assunto2222 - com',
  content => 'ola 123...',
  attachment => [ '/etc/passwd' ],
);
=cut

sub post {
  my $url = shift;
  my $data = shift;
  my $timeout = shift || 10;
  return unless defined $url;

  $data ||= {};

  my $ua = LWP::UserAgent->new();
  $ua->timeout($timeout);

  my $req = POST(
    $url,
    Content_Type => 'form-data',
    Content => [ %$data ],
  );

  my $r = $ua->request($req);

  #print STDERR "#### $a{to} > ".$r->code()." - ".$r->content()."\n";
  return $r->code() == 200 ? $r->content() : undef;
}

# post json using form field
sub post_json2 {
  my $url = shift;
  my $ref = shift;
  return unless defined $url;

  $ref ||= {};

  my $ua = LWP::UserAgent->new();
  $ua->timeout(10);

  my $req = POST(
    $url,
    Content_Type => 'form-data',
    Content => [ data => encode("utf8", encode_json($ref)) ],
  );

  my $r = $ua->request($req);

  if ($r->code() != 200) {
    print STDERR "Error posting... " . $r->content()."\n";
    return undef;
  }
  else {
    return decode_json($r->content());
  }
}

# post json using json content
sub post_json {
  my $url = shift;
  my $ref = shift;
  my $method = shift;
  return unless defined $url;

  $method = 'POST' unless defined $method;

  my $ua = LWP::UserAgent->new();
  $ua->timeout(5);

  my $req = HTTP::Request->new($method => $url);
  $req->header('content-type' => 'application/json');

  $req->content(encode_json($ref));

  my $r = $ua->request($req);

  if ($r->code() != 200) {
    print STDERR "Error posting... " . $r->content()."\n";
    return undef;
  }
  else {
    return decode_json($r->content());
  }
}

sub send_mail {
  my %a = (
    to => "",
    subject => "",
    content => "",
    attachment => [],
    @_,
  );

  my $cfg_o = App::POS::Config->new( file => "/opt/pos/etc/config.ini" );
  my $cfg = $cfg_o->load_fixed();

  $a{skin} = $cfg->{LANG};
  $a{hardlock} = `/opt/pos/common/bin/machine_id`;
  $a{hardlock} =~ s/[\r\n]+$//;

  my $cmd = "";

  if (scalar @{$a{attachment}}) {
    $cmd = "curl --connect-timeout 30 --max-time 900 -F \"to=$a{to}\" " .
      "-F \"subject=$a{subject}\" -F \"hardlock=$a{hardlock}\" -F \"content=$a{content}\" -F \"skin=$a{skin}\" -F \"attachment=\@".$a{attachment}->[0]."\" " .
      "http://www.ptcert.com/send_mail";
  }
  else {
    $cmd = "curl --connect-timeout 30 --max-time 900 -F \"to=$a{to}\" " .
      "-F \"subject=$a{subject}\" -F \"content=$a{content}\" -F \"skin=$a{skin}\" -F \"hardlock=$a{hardlock}\" " .
      "http://www.ptcert.com/send_mail";
  }

  $cmd =~ s/\n//g;
  $cmd =~ s/\r//g;

  my $now = &strftime("%Y-%m-%d %H:%M:%S", localtime);

  my $is_utf8 = is_utf8($cmd);
  $cmd = decode("utf8", $cmd) if $is_utf8;

  my $out = `$cmd`;
  $out ||= "";
  $out =~ s/\n//g;
  $out =~ s/\r//g;

  # success
  #if ($? == 0 || $? == -1) {
  if ($out eq 'OK') {
    open(F, ">> /opt/pos/emails.log");
    print F "$now> OK / $a{to} / $a{subject}\n";
    close(F);

    return 1;
  }
  # error sending
  else {
    open(F, ">> /opt/pos/emails.log");
    print F "$now> ERROR / $a{to} / $a{subject}\n";
    close(F);

    return 0;
  }

=pod
  my $ua = LWP::UserAgent->new();
  $ua->timeout(900);

  print STDERR "##### $? - #$out#\n";

  # print STDERR Dumper(\%a);

  my $req = POST(
    'http://www.ptcert.com/send_mail',
    Content_Type => 'form-data',
    Content => [ %a ],
  );

  my $r = $ua->request($req);

  #print STDERR "#### $a{to} > ".$r->code()." - ".$r->content()."\n";

  my $now = &strftime("%Y-%m-%d %H:%M:%S", localtime);

  if ($r->code() == 200) {
    open(F, ">> /opt/pos/emails.log");
    print F "$now> OK / $a{to} / $a{subject}\n";
    close(F);

    return 1;
  }
  else {
    open(F, ">> /opt/pos/emails.log");
    print F "$now> ERROR / $a{to} / $a{subject} - ".$r->content()."\n";
    close(F);

    return 0;
  }
=cut

}

=pod
sub send_mail {
  my %a = (
    to => "",
    subject => "",
    content => "",
    attachment => [],
    @_,
  );

  my $ua = LWP::UserAgent->new();
  $ua->timeout(900);

  my $cfg_o = App::POS::Config->new( file => "/opt/pos/etc/config.ini" );
  my $cfg = $cfg_o->load_fixed();

  $a{skin} = $cfg->{LANG};
  $a{hardlock} = `/opt/pos/common/bin/machine_id`;
  $a{hardlock} =~ s/[\r\n]+$//;

  # print STDERR Dumper(\%a);

  my $req = POST(
    'http://www.ptcert.com/send_mail',
    Content_Type => 'form-data',
    Content => [ %a ],
  );

  my $r = $ua->request($req);

  #print STDERR "#### $a{to} > ".$r->code()." - ".$r->content()."\n";

  my $now = &strftime("%Y-%m-%d %H:%M:%S", localtime);

  if ($r->code() == 200) {
    open(F, ">> /opt/pos/emails.log");
    print F "$now> OK / $a{to} / $a{subject}\n";
    close(F);

    return 1;
  }
  else {
    open(F, ">> /opt/pos/emails.log");
    print F "$now> ERROR / $a{to} / $a{subject} - ".$r->content()."\n";
    close(F);

    return 0;
  }
}
=cut

sub biz_name_dns {
  my $cfg_file = "/opt/pos/etc/config.ini";
  my $cfg_o = App::POS::Config->new( file => $cfg_file );
  my $cfg = $cfg_o->load_fixed();
  my $str = $cfg->{SAFT_BusinessName} || "";
  $str =~ s/\s//g;
  $str = lc($str);
  $str =~ tr/àèìòùáéíóúç#,.@$%<>*+-/aeiouaeiouc___________/;
  $str =~ s/[^!-~\s]//g;
  $str =~ s/_//g;
  return $str;
}

sub hardlock_id {
  if (-e "/opt/pos/.machine_id") {
    return read_file("/opt/pos/.machine_id");
  } else {
    return `/opt/pos/common/bin/machine_id`;
  }
}

sub dns_update {
  if (! -e "/opt/pos/.hardlock") {
    die "Machine can't be in DEMO...\n";
  }

  my $cfg_file = "/opt/pos/etc/config.ini";
  my $cfg_o = App::POS::Config->new( file => $cfg_file );
  my $cfg = $cfg_o->load_fixed();

  if ($cfg->{INTERNET_DYN_DNS} ne '1') {
    die "INTERNET_DYN_DNS is not enabled... aborting...\n";
  }

  my $url = "http://www.ptcert.com/dns_update";
  my $skin = $cfg->{LANG};
  my $hardlock = hardlock_id();

  my $biz_name = biz_name_dns();
  my $ip = public_ip();

  die "Can't get public ip address...\n" unless $ip;
  die "Can't get business name...\n" unless $biz_name;
  die "Can't get hardlock...\n" unless $hardlock;

  my $cache_file = "/tmp/public_ip.txt";

  if (-e $cache_file) {
    my $cached_ip = read_file($cache_file);

    if ($cached_ip eq $ip) {
      die "DNS Update - Ip didn't change ($ip)... aborting...\n";
    }
  }

  if ($biz_name && $ip && $skin && $hardlock) {
    my $cmd = "curl --connect-timeout 3 --max-time 3 -F \"skin=$skin\" " .
      "-F \"name=$biz_name\" -F \"hardlock=$hardlock\" -F \"ip=$ip\" " .
      "$url 2> /dev/null";

    #print $cmd;

    my $out = `$cmd`;
    #print "### #".$out."#\n";

    if ($out !~ /^OK/) {
      print STDERR "Error updating DNS record...\n";
    }
    else {
      write_file($cache_file, $ip);
      print STDERR "DNS Update Success. $biz_name -> $ip\n";
    }
  }
  else {
    die "Missing information...\n";
  }
}

sub public_ip {
  my $ip = `wget --timeout=3 http://ipinfo.io/ip -qO -`;
  $ip ||= "";
  chop($ip) if $ip;
  return $ip;
}

sub execution_dates {
  my( $db, $prefix, $date, $include_today ) = @_;
  die "Missing parameter with db connection..." unless defined $db;
  die "Missing parameter with prefix for execution name..." unless defined $prefix;

  my $dir = "/opt/pos/common/data/execution_control/$prefix";
  make_path($dir) unless -d $dir;

  # if the date parameter is set, we're defining a particular date is marked as done
  if (defined $date) {
    my $dtmp = $date;
    $dtmp =~ s/\-/\//g;
    $dtmp = $dir . "/$dtmp";
    make_path($dtmp);
    return;
  }

  my @r = ();

  $include_today //= "";

  if (! $include_today) {
    $sql_aux = "- interval '1 day'";
  }

  my $dates = $db->select(qq{
    SELECT DISTINCT(business_date)
    FROM sales_hashes
    WHERE business_date <= NOW() $sql_aux
    ORDER BY business_date DESC LIMIT 20
  });

  foreach my $date (@$dates) {
    my $dtmp = $date->{business_date};
    $dtmp =~ s/\-/\//g;
    $dtmp = $dir . "/" . $dtmp;
    push @r, $date->{business_date} unless -d $dtmp;
  }

  return \@r;
}

sub tables_refresh {
  my $stations_dir = '/opt/pos/server/data/registered_stations';
  my @stations = read_dir($stations_dir);

  foreach my $st (@stations) {
    next unless -f $stations_dir."/".$st;
    my $f = "/opt/pos/server/data/tmp/tables_refresh#$st.txt";
    write_file($f, $st);
  }

  my $f = "/opt/pos/server/data/tmp/tables_refresh#0.txt";
  write_file($f, "0");
}

sub stations_software_restart {
  my $stations_dir = '/opt/pos/server/data/registered_stations';
  my @stations = read_dir($stations_dir);

  foreach my $st (@stations) {
    next unless -f $stations_dir."/".$st;

    my $f = "/opt/pos/server/data/tmp/restart_software#$st.txt";
    write_file($f, $st);
  }
}

sub software_restart {
  if (-e "/opt/bin/kill_pos.sh") {
    system("/opt/bin/kill_pos.sh");
  }
  else {
    system("ps -eo pid,args | grep \"gbr2 /opt/pos/common/bin/pos\" | grep -v grep | awk '{ print \$1 }' | xargs kill -9 2> /dev/null");
  }
}

sub machine_ips {
  my @devs = `ls /sys/class/net`;
  my @ips = ();

  foreach my $dev (@devs) {
    chop($dev);
    next if $dev eq '' || $dev eq 'lo';
    my $ip = `ip addr show $dev | awk '/inet/ {print \$2}' | cut -d/ -f1 | head -1`;
    chop($ip);
    $ip ||= "";
    push @ips, $ip if $ip;
  }

  return wantarray? @ips : \@ips;
}

#
# Usage:
#
#   my $sleep = random_sleep([ 30 .. 60 ]);
#
sub random_sleep {
  my $range = shift;
  my @population = @$range;
  my $n = 1; # desired selection size
  my @selection; # result appears here
  while (@selection < $n) {
    my $swapper = int rand @population;
    push @selection, $population[$swapper];
    if ($swapper < $#population) {
      $population[$swapper] = $population[-1];
    }
    pop @population;
  }

  return $selection[0];
}

# used to validate one or a list of emails (separated by ; or ,)
sub emails_validate {
  my $str = shift || "";
  return 0 unless $str;

  $str =~ s/;/,/g;
  my @emails = split /,/, $str;

  foreach my $addr (@emails) {
    $addr =~ s/\s+//g; # remove spaces from emails

    if ($addr !~ /^[a-zA-Z0-9]+(\.?[\*\+\-\_\=\^\$\#\!\~\?a-zA-Z0-9])*\.?\@([a-zA-Z0-9]+[a-zA-Z0-9\-]*[a-zA-Z0-9]+)(\.[a-zA-Z0-9]+[a-zA-Z0-9\-]*[a-zA-Z0-9]+)*\.(?:([a-zA-Z0-9]+)|([a-zA-Z0-9]+[a-zA-Z0-9\-]*[a-zA-Z0-9]+))$/) {
      return 0;
    }
  }

  return 1;
}

sub sales {
  my( $db, $date_from, $date_to, $product_id, $stock_use ) = @_;

  $db ||= "";
  $date_from ||= "";
  $date_to ||= "";
  $product_id ||= "";
  $stock_use ||= 0; # only get sales if it's a stock product

  die "Required params are: db, date_from, date_to"
    unless $db && $date_from && $date_to;

  my $where_str = $product_id ? " AND sd.product = $product_id" : "";
  $where_str .= " AND p.stock_use = 1" if $stock_use;

  my $sales_query = qq{
    SELECT sh.business_date, sd.price, sd.price_wo_vat,
      sd.quantity, sd.discount, sd.offer, sd.vat, sh.doc_type,
      sh.station_close, sh.clerk_close_name, sh.clerk_open_name, sh.clerk_open_name,
      sd.price_used, sh.cashier, sh.area, sh.tip, sh.service_charge,
      sd.header, p.id AS product_id, p.cost_price, sh.customer,
      extract(dow from sh.business_date) AS dow, sh.hour AS sale_hour,
      sh.persons_number, sd.clerk_name, sha3.key_value AS doc_canceled,
      sh.value AS doc_value, sh.fo_doc_number, sd.inside_menu, p.is_menu,
      sha4.key_value AS kept_in_source, sha5.key_value AS is_consumption,
      sh.id AS doc_id, sd.gb_identifier, sh.discount AS doc_discount,
      sh.table_num, sh.customer_nif, sd.product_name, sd.free_text,
      sd.department, sha6.key_value AS invoice_is_payed, sh.customer_id,
      sd.station, sha7.key_value AS override_customer_id, sh.serie,
      sh.date_closed, sh.date AS date_opened,
      sha9.key_value AS service_charge_remove, p.stock_use, p.stock_min,
      p.stock_current, sf.id AS subfamily_id,
    CASE
      WHEN f.id IS NOT NULL THEN COALESCE(f.name,'----------')
      ELSE COALESCE(sf.name,'----------')
    END as family_name,
    CASE
      WHEN sf.id IS NOT NULL THEN COALESCE(sf.name,'----------')
      ELSE '----------'
    END as subfamily_name
    FROM sales_details sd
    LEFT JOIN sales_details_extra_data sde ON (sde.detail_gbi = sd.gb_identifier)
    LEFT JOIN sales_headers sh ON (sh.id = sd.header)
    LEFT JOIN sales_headers_aux sha3 ON (sh.id = sha3.header AND sha3.key_name = 'canceled')
    LEFT JOIN sales_headers_aux sha4 ON (sh.id = sha4.header AND sha4.key_name = 'kept_in_source')
    LEFT JOIN sales_headers_aux sha5 ON (sh.id = sha5.header AND sha5.key_name = 'is_consumption')
    LEFT JOIN sales_headers_aux sha6 ON (sh.id = sha6.header AND sha6.key_name = 'invoice_is_payed')
    LEFT JOIN sales_headers_aux sha7 ON (sh.id = sha7.header AND sha7.key_name = 'override_customer_id')
    LEFT JOIN sales_headers_aux sha8 ON (sh.id = sha8.header AND sha8.key_name = 'manualdoc_serie')
    LEFT JOIN sales_headers_aux sha9 ON (sh.id = sha9.header AND sha9.key_name = 'service_charge_remove')
    LEFT JOIN products p ON (sd.product = p.id)
    LEFT JOIN (
      SELECT product_id, MAX(group_id) as group_id
      FROM product_groups
      GROUP BY product_id
    ) pg ON (p.id = pg.product_id)
    LEFT JOIN groups sf ON (pg.group_id = sf.id)
    LEFT JOIN groups f ON (sf.parent = f.id)
    WHERE sd.operation_type = 1
    AND sh.business_date >= ? AND sh.business_date <= ?
    AND sd.business_date >= ? AND sd.business_date <= ?
    AND sha8.key_value IS NULL
    $where_str
    ORDER BY sh.id, sd.gb_identifier
  };

  my $sth = $db->dbh()->prepare($sales_query);
  $sth->execute($date_from, $date_to, $date_from, $date_to);

  my @fields_tmp = @{$sth->{NAME}};
  my %rec_tmp = ();
  $sth->bind_columns(map {\$rec_tmp{$_}} @fields_tmp);

  my %data = ();

  while ($sth->fetch) {
    my $rec = \%rec_tmp;

    if ($rec->{doc_type} == 1 || $rec->{doc_type} == 5 || $rec->{doc_type} == 90 ||$rec->{doc_type} == 7) {
      if ($rec->{doc_type} != 7) {
        $rec->{invoice_is_payed} = 1;
      }
    }

    $rec->{doc_canceled} ||= 0;
    $rec->{kept_in_source} ||= 0;
    $rec->{is_consumption} ||= 0;

    if ($rec->{doc_type} == 7) {
      $rec->{invoice_is_payed} ||= 0;
    }
    else {
      $rec->{invoice_is_payed} = 1;
    }

    next if $rec->{doc_canceled};

    $rec->{price} ||= 0;
    $rec->{discount} ||= 0;

    my $discount_w_vat = $rec->{discount} * (1 + $rec->{vat}/100);
    my $price = $rec->{price}-$discount_w_vat;
    my $line_total = sprintf("%.2f", $rec->{quantity}*$price);
    my $line_total_wo_vat = ($rec->{quantity}*$price)/(1+$rec->{vat}/100);
    my $fam_name = &my_conv($rec->{family_name});
    my $sub_fam_name = &my_conv($rec->{subfamily_name});
    my $prod_name = &my_conv($rec->{product_name});
    my $line_dept = my_conv($rec->{department});
    my $serie = $rec->{serie};

    $data{products}->{ $prod_name }->{total} += $line_total;
    $data{products}->{ $prod_name }->{total_wo_vat} += $line_total_wo_vat;
    $data{products}->{ $prod_name }->{total_qttys} += $rec->{quantity};

    $data{dates}->{$rec->{business_date}}->{ $prod_name }->{total} += $line_total;
    $data{dates}->{$rec->{business_date}}->{ $prod_name }->{total_wo_vat} += $line_total_wo_vat;
    $data{dates}->{$rec->{business_date}}->{ $prod_name }->{total_qttys} += $rec->{quantity};

    $data{groups}->{ $fam_name }->{total} += $line_total;
    $data{groups}->{ $fam_name }->{total_wo_vat} += $line_total_wo_vat;
    $data{groups}->{ $fam_name }->{total_qttys} += $rec->{quantity};

    $data{groups}->{ $fam_name }->{departments}->{$sub_fam_name}->{total} += $line_total;
    $data{groups}->{ $fam_name }->{departments}->{$sub_fam_name}->{total_wo_vat} += $line_total_wo_vat;
    $data{groups}->{ $fam_name }->{departments}->{$sub_fam_name}->{total_qttys} += $rec->{quantity};

    $data{total} += $line_total;
    $data{total_wo_vat} += $line_total_wo_vat;
    $data{total_qttys} += $rec->{quantity};
  }

  return \%data;
}

sub memcache {
  my $ip = shift;
  my $namespace = shift;
  my $connections_cache = shift;

  # dont use connections cache
  $connections_cache = undef;

  if (! defined $connections_cache) {
    #print STDERR "WILL CONNECT TO MEMCACHE1\n";
    return Cache::Memcached::Fast->new({
      servers => [ { address => $ip.':11211', weight => 1 }, ],
      namespace => $namespace.':',
      connect_timeout => 0.1,
      io_timeout => 0.1,
      close_on_error => 1,
      #compress_threshold => 100_000,
      #compress_ratio => 0.9,
      compress_threshold => -1,
      compress_ratio => 0,
      max_failures => 3,
      failure_timeout => 1,
      nowait => 1,
      hash_namespace => 1,
      serialize_methods => [ \&JSON::XS::encode_json, \&JSON::XS::decode_json ],
    });
  }

  if (exists $connections_cache->{$namespace}) {
    return $connections_cache->{$namespace};
  }
  else {
    #print STDERR "WILL CONNECT TO MEMCACHE2\n";

    my $con = Cache::Memcached::Fast->new({
      servers => [ { address => $ip.':11211', weight => 1 }, ],
      namespace => $namespace.':',
      connect_timeout => 0.1,
      io_timeout => 0.1,
      close_on_error => 1,
      #compress_threshold => 100_000,
      #compress_ratio => 0.9,
      compress_threshold => -1,
      compress_ratio => 0,
      max_failures => 3,
      failure_timeout => 1,
      nowait => 1,
      hash_namespace => 1,
      serialize_methods => [ \&JSON::XS::encode_json, \&JSON::XS::decode_json ],
    });

    $connections_cache->{$namespace} = $con;

    return $con;
  }
}

sub read_translation_file {
  my $file = shift;
  my $data = shift;

  if (open(F, "< $file")) {
    while(<F>) {
      s/\n//g;
      s/\r//g;
      next unless $_;
      s/^\s+//;
      next if /^#/;

      my @toks = split /=/;
      $toks[1] = "" unless defined $toks[1];

      $toks[0] =~ s/^\s+//;
      $toks[0] =~ s/\s+$//;
      $toks[1] =~ s/^\s+//;
      $toks[1] =~ s/\s+$//;

      if (ref($data) eq 'ARRAY') {
        push @$data, { $toks[0] => $toks[1] };
      }
      elsif (ref($data) eq 'HASH') {
        $toks[2] =~ s/^\s+//;
        $toks[2] =~ s/\s+$//;
        push @{ $data->{$toks[0]} }, { $toks[1] => $toks[2] };
      }
      else {
        print STDERR "Invalid ref type...\n";
      }
    }
    close(F);
  }
  else {
    print STDERR "Can't open file for reading - $file\n";
  }
}

sub send_alert_to_ui {
  my $msg = shift;

  my $sock = IO::Socket::INET->new(
    PeerAddr => '127.0.0.1',
    PeerPort => '8088',
    Proto => 'tcp',
    Timeout => 5,
  );

  print $sock "#ALERT#$msg\n";

  $sock->close();
}

1;

