Something

#!/usr/bin/perl

# Standard Macros For Stirling and BTEL VOX/Net VoIP Networks
# Version: 1.0.0 7/11/2005.  Requires: Asterisk 1.0.1 (later versions may
# work) and asterisk-perl 0.08.

# If this example is useful to you, estimate how much time it has saved you,
# then send a donation via Paypal to eric@fnords.org

# Copyright (c) 2005 Eric Wieling <eric@fnords.org>
# This example is licensed under the GPL.  http://www.gnu.org/licenses/gpl.txt

# Contact eric@fnords.org if you want a non-GPL license.

# This script requires asterisk-perl.  It takes three arguments.  CallerID of
# the caller, dialed number, and override number, seperated by the & character.
# Example: AGI(/path/to/callerid-fixup.ago,1234&5045551212&9855554444)

# This script is designed to modify the Caller*ID information for a call in an
# intellegent way.  It assumes a couple of things.  It assumes that all
# devices that have a DID, have that DID set in their Caller*ID information.
# It assumes that extensions are less than 10 digits long, and that all DIDs
# are 10 or more digits long

# The dialplan variable DID_PREFIX should be set before calling this script.
# The script only supports 1 DID prefix.  I set it in the [general] section
# of extensions.conf.

# Here are the call cases that this script handles.  (Ext - Extension)
# Ext to Ext: Do nothing
# Ext to DID: Do nothing
# Ext to PSTN: Set Caller*ID number to override number
# PSTN to Ext: Add "1" to Caller*ID
# PSTN to DID: Add "1" to Caller*ID
# PSTN to PSTN: Do nothing
# DID to Ext: Set Caller*ID to last 4 digits of Caller*ID
# DID to DID: Set Caller*ID to last 4 digits of Caller*ID
# DID to PSTN: Do nothing

use Asterisk::AGI;

# Set verbosity level required, comment out to have no console messages.
$verbose=3;

my %input;
$AGI = new Asterisk::AGI;
%input = $AGI->ReadParse();
$AGI->setcallback(\&mycallback);

$did_prefix = $AGI->get_variable("DID_PREFIX");
if (length($did_prefix) == 0) {
	$did_prefix="X";
}

($source, $destination, $override) = $ARGV[0] =~ m/(\d+)\&(\d+)\&(\d+)/;
$source_original = $source;

verbose("source=$source, destination=$destination, override=$override");

if (length($source) >= 10) { # PSTN|DID to ??
	if ($source !~ m/^$did_prefix/) { # PSTN to ??
		if (length($destination) >= 10) { # PSTN to PSTN|DID
			if ($destination !~ m/^$did_prefix/) { # PSTN to PSTN
				verbose("(PSTN->PSTN) Orig CLID: $source_original, New CLID: $source");
			} else { # PSTN to DID
				$source = "1" . $source;
				$AGI->exec("SetCIDNum $source");
				verbose("(PSTN->DID) Orig CLID: $source_original, New CLID: $source");
			}
		} else { # PSTN to Extension
			$source = "1" . $source;
			$AGI->exec("SetCIDNum $source");
			verbose("(PSTN->Exten) Orig CLID: $source_original, New CLID: $source");
		}
	} else { # DID to ??
		if (length($destination) >= 10) { # DID to PSTN|DID
			if ($destination !~ m/^$did_prefix/) { # DID to PSTN
				verbose("(DID->PSTN) Orig CLID: $source_original, New CLID: $source");
			} else { # DID to DID
				$source = substr($source, -4, 4);
				$AGI->exec("SetCIDNum $source");
				verbose("(DID->DID) Orig CLID: $source_original, New CLID: $source");
			}
		} else { # DID to Extension
			$source = substr($source, -4, 4);
			$AGI->exec("SetCIDNum $source");
			verbose("(DID->Exten) Orig CLID: $source_original, New CLID: $source");
		}
	}
} else { # Extension to ??
	if (length($destination) >= 10) { # Extension to PSTN|DID
		if ($destination !~ m/^$did_prefix/) { # Extension to PSTN
			$source = $override;
			$AGI->exec("SetCIDNum $source");
			verbose("(Exten->PSTN) Orig CLID: $source_original, New CLID: $source");
		} else { # Extension to DID
			verbose("(Exten->DID) Orig CLID: $source_original, New CLID: $source");
		}
	} else { # Extension to Extension
		verbose("(Exten->Exten) Orig CLID: $source_original, New CLID: $source");
	}
}

sub mycallback {
	my ($returncode) = @_;
	print STDERR "MYCALLBACK: User Hungup ($returncode)\n";
	exit($returncode);
}

sub verbose {
	if (defined($verbose)) {
		$AGI->verbose("@_", $verbose);
		return(0);
	}
}