Brian told me to open a jira, what I did now.

But here’s the script.

It basically writes incoming calls to a database and removes them after hangup.

When intercepting it also rewrites the destination of the call.

Thanks, Klaus

#!/usr/bin/perl

use strict;

use DBI;

use POSIX qw(strftime);

our $session;

use constant {

  false => 0,

  true => 1,

};

my $EmptyString = "                                        ";  # Used to delete regexp catches

my $dbargs = {AutoCommit => 0,

              PrintError => 1};

my $dbh = DBI->connect("dbi:SQLite:dbname=/opt/freeswitch/db/dialplan_call_info.db", "", "", $dbargs);

$session->setHangupHook('on_hangup');

logInfo("Hook set");

sub logString {

  my ($Level, $Msg) = @_;

  freeswitch::consoleLog("$Level", "$Msg\n");

}

sub logDebug { my ($Msg) = @_; logString("DEBUG", ">>>>> $Msg"); }

sub logInfo { my ($Msg) = @_; logString("INFO", ">>>>> $Msg"); }

sub logNotice { my ($Msg) = @_; logString("NOTICE", ">>>>> $Msg"); }

sub logWarning { my ($Msg) = @_; logString("WARNING", ">>>>> $Msg"); }

sub logError { my ($Msg) = @_; logString("ERR", ">>>>> $Msg"); }

sub logCritical { my ($Msg) = @_; logString("CRIT", ">>>>> $Msg"); }

sub logAlert { my ($Msg) = @_; logString("ALERT", ">>>>> $Msg"); }

# The idea of these functions is to allow for easy pull in of variables and then

# automatically export any ones that have been changed when UPDATEV.

# It will ensure you don't write to any non-imported variables, but as we are

# using a hash we cannot prevent invalid reads. If you are really concerned about

# this then you could use a specific read function which first checks to make sure

# its defined in CLEAN_VARS before returning.

my %VARS;

my %CLEAN_VARS;

# Takes one or more variables names to import in

sub GETV {

  my @Arr = @_;

  foreach my $Var (@Arr) {

    $VARS{$Var} = $session->getVariable("$Var");

    $CLEAN_VARS{$Var} = $VARS{$Var};

    if (! defined $CLEAN_VARS{$Var}) {

      $CLEAN_VARS{$Var} = "";

    }

  }

}

# Generally not called directly, but will set the variable to the value requested right away

sub SETV {

  my ($Var, $Value) = @_;

  $session->setVariable("$Var", "$Value");

  $VARS{$Var} = "$Value";

  $CLEAN_VARS{$Var} = "$Value";

}

# If we don't care about a variables value, but wan't to override it this will add it to the hash

# so that when we write to it, we don't consider it a typo

sub ADDV {

  my @Arr = @_;

  foreach my $Var(@Arr) {

    $CLEAN_VARS{$Var} = "123zzzzzZnzZZzz"; # Something definitely won't match

    $VARS{$Var} = "";

  }

}

# Updates any changed variables

sub UPDATEV {

  foreach my $Var (keys %VARS) {

    # Make sure there were no typos

    if (! defined $CLEAN_VARS{$Var}) {

      die "Warning a variable of: '$Var' was not found in CLEAN_VARS, did you forget to GET/ADD it first?";

    }

    if ($VARS{$Var} ne $CLEAN_VARS{$Var}) {

      SETV($Var, $VARS{$Var});

    }

  }

}

# Dump all variables

sub DUMPV {

  foreach my $Var (sort keys %VARS) {

    logInfo("$Var = '" . $VARS{$Var} . "'");

  }

}

sub CAN_ACCESS {

  my ($Req) = @_;

  if ($VARS{app_rights} eq "ALL" || $VARS{app_rights} =~ /#$Req#/) {

    return true;

  } else {

    return false;

  }

}

# Fetch some generic variables

GETV("uuid", "base_dir", "domain", "app_rights", "de-ring", "outgoing_soundtouch_profile", "hold_music", "continue_on_fail");

GETV("destination_number", "caller_id_name", "caller_id_number", "effective_caller_id_name", "effective_caller_id_number");

GETV("network_addr", "hangup_after_bridge", "called_party_callgroup", "ringback", "transfer_ringback", "sip_exclude_contact");

GETV("call_timeout", "source", "sip_to_params", "presence_id", "dialed_user", "dialed_domain");

GETV("voicemail_authorized", "sip_authorized", "username", "accountcode", "sip_from_user", "sip_to_user");

# Set some defaults

$VARS{hangup_after_bridge} = "true";

$VARS{ringback} = $VARS{'de-ring'};

$VARS{transfer_ringback} = $VARS{hold_music};

$VARS{sip_exclude_contact} = $VARS{network_addr};

$VARS{call_timeout} = "60";

$VARS{continue_on_fail} = "true";  # NORMAL_TEMPORARY_FAILURE,USER_BUSY,NO_ANSWER,TIMEOUT,NO_ROUTE_DESTINATION

UPDATEV();

sub bridgeCallInternally {

  my ($DestNr) = @_;

  if ("${DestNr}" == "21") {

    $VARS{call_timeout} = "15";

  }

  UPDATEV();

  $dbh->do("insert into current_calls (extension, uuid) values ('$DestNr', '$VARS{uuid}')");

  $dbh->commit();

  $session->execute("record_session","\${base_dir}/recordings/\${strftime(%Y-%m-%d-%H-%M-%S)}_\${destination_number}_\${caller_id_number}.wav");

  $session->execute("bridge","user/${DestNr}\@$VARS{domain}");

}

sub on_hangup {

  my $hup_session = shift;

  my $hup_cause = shift;

  logInfo("Hangup uuid: '" . $hup_session->{uuid} . "'");

  logInfo("Hangup cause: '$hup_cause'");

  $dbh->do("delete from current_calls where uuid = '" . $hup_session->{uuid} . "'");

  $dbh->commit();

}

# Internal numbers

if ($VARS{destination_number} =~ /^(2[0-2])$/) {

  UPDATEV();

  bridgeCallInternally($VARS{destination_number});

}

# Intercept call

if ($VARS{destination_number} =~ /^\*8(\d+)$/) {

  my $intercept_extension = "";

  my $intercept_uuid = "";

  my $sth = $dbh->prepare("select * from current_calls where extension = ?");

  $sth->execute($1);

  while (my @data = $sth->fetchrow_array()) {

    $intercept_extension = $data[0];

    $intercept_uuid = $data[1];

  }

  logInfo("Intercept call from '$intercept_extension' - '$intercept_uuid'");

  GETV("caller_id_number");

  $dbh->do("update current_calls set extension = '$VARS{caller_id_number}' where uuid = '$intercept_uuid'");

  $dbh->commit();

  $session->answer();

  $session->execute("intercept", "$intercept_uuid");

  $session->execute("sleep", "1000");

}

$dbh->disconnect();

return 1;

From: freeswitch-users-bounces@lists.freeswitch.org [mailto:freeswitch-users-bounces@lists.freeswitch.org] On Behalf Of Michael Collins
Sent: Friday, June 26, 2009 10:57 PM
To: freeswitch-users@lists.freeswitch.org
Subject: Re: [Freeswitch-users] hangup hook after intercept doesn't get triggered...

Can you paste in your script so we can see what is going on?
-MC

On Fri, Jun 26, 2009 at 1:39 PM, Klaus Hochlehnert <Mailings@kh-dev.de> wrote:

Ok, and how can I ask the hook to come with me?

If I understand this right...

When a call comes in the hook is set on the a-leg and it rings on the b-leg.

When I do an intercept I kill the ringing b-leg and the interceptor is now the “new” b-leg, right?

I would assume that the “old” a-leg still has the hook on it or this wrong.

Thanks, Klaus

From: freeswitch-users-bounces@lists.freeswitch.org [mailto:freeswitch-users-bounces@lists.freeswitch.org] On Behalf Of Brian West
Sent: Friday, June 26, 2009 10:28 PM

To: freeswitch-users@lists.freeswitch.org
Subject: Re: [Freeswitch-users] hangup hook after intercept doesn't get triggered...

well in your case I suspect your intercepting the leg of the call without the hook on it.

/b

On Jun 26, 2009, at 3:22 PM, Klaus Hochlehnert wrote:

Actually one of my first actions in the script is

  $session->setHangupHook('on_hangup');

When a call comes in the hook is set and working.

The second time the script is called when I try to intercept. As it’s the same script there’s also the function setHangupHook called.

That’s what I’ve currently done.

How can I set up the hook for the “new” bridge?

Or is there a possibility to set a global hook?

Thanks, Klaus

_______________________________________________
Freeswitch-users mailing list
Freeswitch-users@lists.freeswitch.org
http://lists.freeswitch.org/mailman/listinfo/freeswitch-users
UNSUBSCRIBE:http://lists.freeswitch.org/mailman/options/freeswitch-users
http://www.freeswitch.org