#!/usr/bin/perl -w
#
# ================================================== #
#            Contact Center CG-Card Helper           #
#                   Version 2.2.7b                   #
#                                                    #
# ---------- (c) AO StalkerSoft 2015-2022 ---------- #
# ================================================== #
#

use strict;
use warnings;
use DBI;
use CLI;
use JSON;
use Data::Dumper;

my $VERSION = "2.2.7b";

$| = 1;
my $dirdel;
if($^O =~ m/win/i) {
  open(STDERR, ">nul");
  $dirdel = '\\';
} else {
  open(STDERR, ">/dev/null");
  $dirdel = '/';
}

#my $baseDir = 'C:\\ProgramData\\CommuniGate Files\\'; # for windows
my $baseDir = '/var/CommuniGate/'; # for unix
my $login = 'postmaster';
my $password = '';
my $host = 'localhost';
my $port = 106;
my $cc_account = 'pbx';
#my $cc_location = 'account.web\\private\\contactcenter'; # for windows
my $cc_location = 'account.web/private/contactcenter'; # for unix
my $dbname = 'cc.db';
my ($prefix, $command);

package main;

my $RESULT_LIMIT = 20;
my $tbl_card = 'cg_card';
my $tbl_tel = 'cg_tel';
my $tbl_email = 'cg_email';
my $tbl_call = 'cg_call';
my @cf = qw/uid fn ln title org street city state pc country web twitter facebook desc/;
my @sf = qw/date callType callFrom lastQueue qLength peers callID tWait tAlert tConnect status pathToRecord tEnqueue tDequeue qLengthDequeue/;

print "* ccdb.pl started, version " . $VERSION . "\n";

while(<STDIN>) {
  chomp;
  next if($_ eq '');
  unless(/^(\S+) (.*)/) {
    print "* bad command: $_\n";
    next;
  }
  $prefix=$1;
  my $cmd=$2;
  my $args;
  if($cmd=~/^(\S+) (.*)/) {
    $command=$1;
    $args=$2;
  } else {
    $command=$cmd;
  }    
  if($command eq 'INTF') {
    print "$prefix INTF 1\n";
  } elsif($command eq 'QUIT') {
    print "$prefix OK\n";
    last;
  } elsif($command eq 'BANNER') {
    handleBanner($args);
  } else {
    print "$prefix FAILURE \"unexpected command: $command\"\n";
  }
}

print "* ccdb.pl stopped\n";
exit(0);

sub getCardByNum {
  my $qParam = shift;
  my $dbh = shift;
  my $sth;
  my $error;
  unless($qParam) {
    $error = "Bad params: getCardByNum";
    return { error => $error };
  }
  eval {
    $sth = $dbh->prepare("SELECT * FROM $tbl_tel WHERE num='$qParam'");
    $sth->execute();
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  my ($num, $card_uid, $comment, $routing) = $sth->fetchrow_array();
  $sth->finish();
  unless($num && defined($card_uid)) {
    return { result => {} };
  }
  return getCardByUid($card_uid, $dbh);
}

sub getCardByEmail {
  my $qParam = shift;
  my $dbh = shift;
  my $sth;
  my $error;
  unless($qParam) {
    $error = "Bad params: getCardByEmail";
    return { error => $error };
  }
  eval {
    $sth = $dbh->prepare("SELECT * FROM $tbl_email WHERE email='$qParam'");
    $sth->execute();
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  my ($email, $card_uid, $comment) = $sth->fetchrow_array();
  $sth->finish();
  unless($email && defined($card_uid)) {
    return { result => {} };
  }
  return getCardByUid($card_uid, $dbh);
}

sub getCardByUid {
  my $qParam = shift;
  my $dbh = shift;
  my $sth;
  my $error;
  unless(defined($qParam)) {
    $error = "Bad params: getCardByUid";
    return { error => $error };
  }
  eval {
    $sth = $dbh->prepare("SELECT * FROM $tbl_card WHERE uid=$qParam");
    $sth->execute();
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  my @fields = $sth->fetchrow_array();
  $sth->finish();
  my $result = {};
  for(my $i = 0; $i < scalar(@fields); $i++) {
    $result->{$cf[$i]} = $fields[$i];
  }
  return { result => {} } unless(defined($result->{uid}));
  my $tel = getTelsByCardUid($result->{uid}, $dbh);
  unless($tel->{error}) {
    $result->{tel} = $tel->{result};
  } else {
    $result->{tel} = [];
  }
  my $email = getEmailsByCardUid($result->{uid}, $dbh);
  unless($email->{error}) {
    $result->{email} = $email->{result};
  } else {
    $result->{email} = [];
  }
  return { result => $result };
}

sub getTelsByCardUid {
  my $qParam = shift;
  my $dbh = shift;
  my $sth;
  my $error;
  unless(defined($qParam)) {
    $error = "Bad params: getTelsByCardUid";
    return { error => $error };
  }
  eval {
    $sth = $dbh->prepare("SELECT * FROM $tbl_tel WHERE card_uid=$qParam");
    $sth->execute();
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  my $result = [];
  while(my ($num, $card_uid, $comment, $routing) = $sth->fetchrow_array()) {
    push @{$result}, {
      num => $num,
      comment => $comment,
      routing => $routing,
    };
  }
  return { result => $result };
}

sub getEmailsByCardUid {
  my $qParam = shift;
  my $dbh = shift;
  my $sth;
  my $error;
  unless(defined($qParam)) {
    $error = "Bad params: getEmailsByCardUid";
    return { error => $error };
  }
  eval {
    $sth = $dbh->prepare("SELECT * FROM $tbl_email WHERE card_uid=$qParam");
    $sth->execute();
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  my $result = [];
  while(my ($email, $card_uid, $comment) = $sth->fetchrow_array()) {
    push @{$result}, {
      email => $email,
      comment => $comment,
    };
  }
  return { result => $result };
}

sub getCardsByName {
  my $qParam = shift;
  my $dbh = shift;
  my $sth;
  my $error;
  unless($qParam) {
    $error = "Bad params: getCardsByName";
    return { error => $error };
  }
  my ($first_name, $last_name) = split(/ /, $qParam);
  eval {
    if($qParam eq '*') {
      $sth = $dbh->prepare("SELECT * FROM $tbl_card");
    } else {
      $sth = $dbh->prepare("SELECT * FROM $tbl_card WHERE fn='$first_name' AND ln='$last_name'");
    }
    $sth->execute();
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  my $result = [];
  while(my @fields = $sth->fetchrow_array()) {
    my $card = {};
    for(my $i = 0; $i < scalar(@fields); $i++) {
      $card->{$cf[$i]} = $fields[$i];
    }
    next unless($card->{uid});
    my $tel = getTelsByCardUid($card->{uid}, $dbh);
    unless($tel->{error}) {
      $card->{tel} = $tel->{result};
    } else {
      $card->{tel} = [];
    }
    my $email = getEmailsByCardUid($card->{uid}, $dbh);
    unless($email->{error}) {
      $card->{email} = $email->{result};
    } else {
      $card->{email} = [];
    }
    push @{$result}, $card;
    if(scalar(@{$result}) == $RESULT_LIMIT) {
      last;
    }
  }
  $sth->finish();
  return { result => $result };
}

sub getTel {
  my $qParam = shift;
  my $dbh = shift;
  my $sth;
  my $error;
  unless($qParam) {
    $error = "Bad params: getTel";
    return { error => $error };
  }
  eval {
    $sth = $dbh->prepare("SELECT * FROM $tbl_tel WHERE num='$qParam'");
    $sth->execute();
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  my ($num, $card_uid, $comment, $routing) = $sth->fetchrow_array();
  $sth->finish();
  unless($num) {
    return { result => {} };
  } else {
    return { result => {
      num => $num,
      card_uid => $card_uid,
      comment => $comment,
      routing => $routing,
    }};
  }
}

sub getEmail {
  my $qParam = shift;
  my $dbh = shift;
  my $sth;
  my $error;
  unless($qParam) {
    $error = "Bad params: getEmail";
    return { error => $error };
  }
  eval {
    $sth = $dbh->prepare("SELECT * FROM $tbl_email WHERE email='$qParam'");
    $sth->execute();
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  my ($email, $card_uid, $comment) = $sth->fetchrow_array();
  $sth->finish();
  unless($email) {
    return { result => {} };
  } else {
    return { result => {
      email => $email,
      card_uid => $card_uid,
      comment => $comment,
    }};
  }
}

sub addTel {
  my $param = shift;
  my $dbh = shift;
  my $error;
  unless($param->{num}) {
    $error = "Bad params: addTel";
    return { error => $error };
  }
  $param->{card_uid} = 'NULL' unless(defined($param->{card_uid}));
  $param->{comment} = '' unless($param->{comment});
  $param->{routing} = '' unless($param->{routing});
  eval {
    $dbh->do("INSERT INTO $tbl_tel VALUES('$param->{num}', $param->{card_uid}, '$param->{comment}', '$param->{routing}')");
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  return getTel($param->{num}, $dbh);
}

sub addEmail {
  my $param = shift;
  my $dbh = shift;
  my $error;
  unless($param->{email}) {
    $error = "Bad params: addEmail";
    return { error => $error };
  }
  $param->{card_uid} = 'NULL' unless(defined($param->{card_uid}));
  $param->{comment} = '' unless($param->{comment});
  eval {
    $dbh->do("INSERT INTO $tbl_email VALUES('$param->{email}', $param->{card_uid}, '$param->{comment}')");
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  return getEmail($param->{email}, $dbh);
}

sub addCard {
  my $param = shift;
  my $dbh = shift;
  my $error;
  unless($param->{fn} && $param->{ln}) {
    $error = "Bad params: addCard";
    return { error => $error };
  }
  my $query = "INSERT INTO $tbl_card VALUES(NULL,";
  for(my $i = 1; $i < scalar(@cf); $i++) {
    $param->{$cf[$i]} = '' unless($param->{$cf[$i]});
    $query .= "'$param->{$cf[$i]}',";
  }
  chop($query);
  $query .= ")";
  print "* $query\n";
  eval {
    $dbh->do($query);
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  my $uid = $dbh->func('last_insert_rowid');
  return getCardByUid($uid, $dbh);
}

sub updateCard {
  my $param = shift;
  my $dbh = shift;
  my $error;
  unless(defined($param->{uid})) {
    $error = "Bad params: updateCard";
    return { error => $error };
  }
  my $query = "UPDATE $tbl_card SET ";
  for(my $i = 1; $i < scalar(@cf); $i++) {
    $query .= "$cf[$i]='$param->{$cf[$i]}'," if(defined($param->{$cf[$i]}));
  }
  chop($query);
  $query .= " WHERE uid=$param->{uid}";
  print "* $query\n";
  eval {
    $dbh->do($query);
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  return getCardByUid($param->{uid}, $dbh);
}

sub deleteCard {
  my $qParam = shift;
  my $dbh = shift;
  my $error;
  unless(defined($qParam)) {
    $error = "Bad params: deleteCard";
    return { error => $error };
  }
  my $query = "DELETE FROM $tbl_card WHERE uid=$qParam";
  print "* $query\n";
  eval {
    $dbh->do($query);
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  $query = "DELETE FROM $tbl_tel WHERE card_uid=$qParam";
  print "* $query\n";
  eval {
    $dbh->do($query);
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  $query = "DELETE FROM $tbl_email WHERE card_uid=$qParam";
  print "* $query\n";
  eval {
    $dbh->do($query);
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  return getCardByUid($qParam, $dbh);
}

sub deleteTel {
  my $qParam = shift;
  my $dbh = shift;
  my $error;
  unless(defined($qParam)) {
    $error = "Bad params: deleteTel";
    return { error => $error };
  }
  my $query = "DELETE FROM $tbl_tel WHERE num='$qParam'";
  print "* $query\n";
  eval {
    $dbh->do($query);
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  return getTel($qParam, $dbh);
}

sub deleteEmail {
  my $qParam = shift;
  my $dbh = shift;
  my $error;
  unless(defined($qParam)) {
    $error = "Bad params: deleteEmail";
    return { error => $error };
  }
  my $query = "DELETE FROM $tbl_email WHERE email='$qParam'";
  print "* $query\n";
  eval {
    $dbh->do($query);
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  return getEmail($qParam, $dbh);
}

sub updateEmail {
  my $param = shift;
  my $dbh = shift;
  my $error;
  unless($param->{email}) {
    $error = "Bad params: updateEmail";
    return { error => $error};
  }
  my $query = "UPDATE $tbl_email SET ";
  $query .= "card_uid=$param->{card_uid}," if(defined($param->{card_uid}));
  $query .= "comment='$param->{comment}'," if(defined($param->{comment}));
  chop($query);
  $query .= " WHERE email='$param->{email}'";
  print "* $query\n";
  eval {
    $dbh->do($query);
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "* SQLite error: $@";
    return { error => $error };
  }
  return getEmail($param->{email}, $dbh);
}

sub updateTel {
  my $param = shift;
  my $dbh = shift;
  my $error;
  unless($param->{num}) {
    $error = "Bad params: updateTel";
    return { error => $error };
  }
  my $query = "UPDATE $tbl_tel SET ";
  $query .= "card_uid=$param->{card_uid}," if(defined($param->{card_uid}));
  $query .= "comment='$param->{comment}'," if(defined($param->{comment}));
  $query .= "routing='$param->{routing}'," if(defined($param->{routing}));
  chop($query);
  $query .= " WHERE num='$param->{num}'";
  print "* $query\n";
  eval {
    $dbh->do($query);
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "* SQLite error: $@";
    return { error => $error };
  }
  return getTel($param->{num}, $dbh);
}

sub storeCall {
  my $param = shift;
  my $dbh = shift;
  my $error;
  unless($param->{date}) {
    $error = "Bad params: storeCall";
    return { error => $error };
  }
  my $query = "INSERT INTO $tbl_call VALUES($param->{date},";
  if(ref($param->{peers}) eq 'ARRAY') {
    $param->{peers} = join(',', @{$param->{peers}});
  }
  for(my $i = 1; $i < scalar(@sf); $i++) {
    unless($param->{$sf[$i]}) {
      $param->{$sf[$i]} = 'NULL';
    } else {
      $param->{$sf[$i]} = "'$param->{$sf[$i]}'";
    }
    $query .= "$param->{$sf[$i]},";
  }
  chop($query);
  $query .= ")";
  print "* $query\n";
  eval {
    $dbh->do($query);
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  my $id = $dbh->func('last_insert_rowid');
  return { result => $id };
}

sub getCallsByCardUid {
  my $param = shift;
  my $dbh = shift;
  my $sth;
  my $error;
  unless($param->{uid}) {
    $error = "Bad params: getCallsByCardUid";
    return { error => $error };
  }
  my $result = [];
  my $tels = getTelsByCardUid($param->{uid}, $dbh);
  unless($tels->{result} && scalar(@{$tels->{result}})) {
    return { result => $result };
  }
  my $query = "SELECT * FROM $tbl_call WHERE (";
  foreach my $tel (@{$tels->{result}}) {
    $query .= "callFrom='$tel->{num}' OR peers='$tel->{num}' OR ";
  }
  for(my $i = 0; $i < length(" OR "); $i++) {
    chop($query);
  }
  $query .= ") LIMIT ";
  if($param->{limit}) {
    $query .= "$param->{limit}";
  } else {
    $query .= "10";
  }
  print "* $query\n";
  eval {
    $sth = $dbh->prepare($query);
    $sth->execute();
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  while(my @fields = $sth->fetchrow_array()) {
    my $call = {};
    for(my $i = 0; $i < scalar(@fields); $i++) {
      $call->{$sf[$i]} = $fields[$i];
    }
    next unless($call->{date});
    push @{$result}, $call;
  }
  $sth->finish();
  return { result => $result };
}

sub handleContact {
  my $param = shift;
  my $dbh = shift;
  my $error;
  unless(ref($param) eq 'HASH' && $param->{op} && $dbh) {
    $error = "Bad params: handleContact";
    return { error => $error };
  }
  eval {
    $dbh->do("CREATE TABLE IF NOT EXISTS $tbl_card (uid INTEGER PRIMARY KEY AUTOINCREMENT, fn TEXT, ln TEXT, title TEXT, org TEXT, street TEXT, city TEXT, state TEXT, pc TEXT, country TEXT, web TEXT, twitter TEXT, facebook TEXT, desc TEXT)");
    $dbh->do("CREATE TABLE IF NOT EXISTS $tbl_tel (num TEXT PRIMARY KEY, card_uid INTEGER, comment TEXT, routing TEXT)");
    $dbh->do("CREATE TABLE IF NOT EXISTS $tbl_email (email TEXT PRIMARY KEY, card_uid INTEGER, comment TEXT)");
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  if(my $func = main->can($param->{op})) {
    my $result = $func->($param->{param}, $dbh);
    $result->{op} = $param->{op};
    return $result;
  } else {
    $error = "Operation $param->{op} is not supported";
    return { error => $error };
  }
}

sub handleStats {
  my $param = shift;
  my $dbh = shift;
  my $error;
  unless(ref($param) eq 'HASH' && $param->{op} && $dbh) {
    $error = "Bad params: handleStats";
    return { error => $error };
  }
  eval {
    $dbh->do("CREATE TABLE IF NOT EXISTS $tbl_call (date INTEGER, callType TEXT, callFrom TEXT, lastQueue TEXT, qLength INTEGER, peers TEXT, callID TEXT, tWait INTEGER, tAlert INTEGER, tConnect INTEGER, status TEXT, pathToRecord TEXT, tEnqueue INTEGER, tDequeue INTEGER, qLengthDequeue INTEGER)");
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $error = "SQLite error: $@";
    return { error => $error };
  }
  if(my $func = main->can($param->{op})) {
    my $result = $func->($param->{param}, $dbh);
    $result->{op} = $param->{op};
    return $result;
  } else {
    $error = "Operation $param->{op} is not supported";
    return { error => $error };
  }
}

sub handleBanner {
  my $args = shift;
  print "* args $args\n";
  my $result;

  my $bannerType;
  my $user;
  my $info;
  my $param;
  if($args =~ m/^\"(.*)\"\ USER\ (.*)\ INFO\ \"(.*)\"\ PARAM\ \"(.*)\"$/) {
    $bannerType = $1;
    $user = $2;
    $info = $3;
    $param = $4;
  } elsif($args =~ m/^\"(.*)\"\ USER\ (.*)\ PARAM\ \"(.*)\"$/) {
    $bannerType = $1;
    $user = $2;
    $info = '';
    $param = $3;
  }
  $param =~ s/\\"/"/g;
  print "* banner type $bannerType\n";
  print "* user $user\n";
  print "* info $info\n";
  print "* param $param\n";
  eval {
    $param = decode_json($param);
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $result = { error => "Could not decode JSON param: $@"};
    print "$prefix RESULT \"" . toJson($result) . "\"\n";
    return;
  }

  my $cli = new CGP::CLI({
    PeerAddr => $host,
    PeerPort => $port,
    login => $login,
    password => $password,
  });
  unless($cli) {
    $result = { error => "Could not connect to CGP PWD" };
    print "$prefix RESULT \"" . toJson($result) . "\"\n";
    return;
  }

  my $domainName;
  if($user =~ m/^(.*)@(.*)$/) {
    $domainName = $2;
  } else {
    $cli->SendCommand("GETSYSTEMINFO mainDomainName");
    $domainName = $cli->GetResponseData();
    unless($domainName) {
      $result = { error => "Could not retrieve main domain name" };
      print "$prefix RESULT \"" . toJson($result) . "\"\n";
      return;
    }
  }
  my $dl = $cli->GetDomainLocation($domainName);
  my $al = $cli->GetAccountLocation($cc_account . "@" . $domainName);
  unless($dl && $al) {
    $result = { error => "Could not retrieve CC location" };
    print "$prefix RESULT \"" . toJson($result) . "\"\n";
    return;
  }
  $cli->Logout();
  my $location = $baseDir . $dl . $dirdel . $al . $dirdel . $cc_location;
  unless(-d $location) {
    $result = { error => "Could not find CC location" };
    print "$prefix RESULT \"" . toJson($result) . "\"\n";
    return;
  }

  my $dbh;
  eval {
    $dbh = DBI->connect(
      'dbi:SQLite:dbname=' . $location . $dirdel . $dbname,
      '',
      '',
      {
        RaiseError => 1,
      },
    );
  };
  if($@) {
    $@ =~ s/\n/ /g;
    $@ =~ s/\\/\\\\/g;
    $result = { error => "Could not connect to DB: $@" };
    print "$prefix RESULT \"" . toJson($result) . "\"\n";
    return;
  }

  if($bannerType eq 'contact') {
    $result = handleContact($param, $dbh);
  } elsif($bannerType eq 'stats') {
    $result = handleStats($param, $dbh);
  } else {
    $result = { error => "Unknown banner type" };
  }
  print "$prefix RESULT \"" . toJson($result) . "\"\n";
  $dbh->disconnect();
}

sub toJson {
  my $param = shift;
  my $str = to_json($param);
  $str =~ s/([^\\+]?)"/$1\\"/g;
  #$str =~ s/\\\\/\\/g;
  return $str;
}

__END__