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/${destn...@$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-boun...@lists.freeswitch.org [mailto:freeswitch-users-boun...@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 <maili...@kh-dev.de<mailto:maili...@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-boun...@lists.freeswitch.org<mailto:freeswitch-users-boun...@lists.freeswitch.org> [mailto:freeswitch-users-boun...@lists.freeswitch.org<mailto:freeswitch-users-boun...@lists.freeswitch.org>] On Behalf Of Brian West Sent: Friday, June 26, 2009 10:28 PM To: freeswitch-users@lists.freeswitch.org<mailto: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<mailto: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
_______________________________________________ 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