I took some time today to write a fairly simple Perl script to walking through REDCOM Dial Code Tables(DCT) and preform the translations in a 100% offline mode. You will need to get a copy of each of your DCTs and make them a CSV format.
The script works for basic stuff, but it does not evaluate the SC, NEXT (except when used with TYPE=sup), SB/SNU, SST/NST, TID fields because I don’t see a need for them in my testing. The script does not handle using ac-x, ac+x, etc in the PRE, POS, or MARK fields. There is no support for patterns that contain # symbols (again no need for me to figure out why my script doesn’t like them).
I need to do some cleanup, more inline comments, add strict usage, and some other things. This is a functional script. If you do use it then please let me know what you think of it and also if you make changes to it that are for the positive please let me know of those since I shared this with you.
The Code:
#!/usr/bin/perl
# Author: Lance Vermilion
# Purpose: Walk through Redcom Dial Code Tables and determine
# what entry the digits would hit if it was ran
# through a Redcom.
# Script: dct.pl
# Date: 9/30/2011
# Rev: 0.1
# Syntax: dct.pl <starting dct> <digits dialed>
# Example: dct.pl dct0 4352348763
#################################################################
#################################################################
# Instructions:
# Copy the all each entry (row) in the DCT to a CSV file named dct[n].csv.
# Do not copy the headers, footers, other data, etc.
# All possible dial code tables should be in one directory.
# Sample Output
# [root@localhost dct]$ ls -als
# total 60
# 8 drwxrwxr-x 2 root root 4096 Sep 30 16:48 .
# 8 drwx------ 33 root root 4096 Sep 30 16:48 ..
# 8 -rw-rw-r-- 1 root root 260 Sep 30 15:38 dct0.csv
# 8 -rw-rw-r-- 1 root root 92 Sep 30 15:11 dct6.csv
# 8 -rw-rw-r-- 1 root root 202 Sep 30 15:16 dct7.csv
# 8 -rw-rw-r-- 1 root root 285 Sep 30 15:14 dct8.csv
#12 -rw-rw-r-- 1 root root 6410 Sep 30 16:44 dct.pl
#################################################################
#################################################################
# Not supported yet
# TYPE (other than dct, rte, int, stn, sup)
# SC
# PRE (does support any variation of ac- ac+)
# POS (does support any variation of ac- ac+)
# MARK (does support any variation of ac- ac+)
# Next (Only jumps to that dct)
# SB
# SST
# TID
#
# Pattern that uses a # in the pattern
#################################################################
my $inputfile = "$ARGV[0]";
my $dialeddigits = $ARGV[1];
sub help()
{
print "Syntax: dct.pl <starting dct> <digits dialed>\n";
print "Example: dct.pl dct0 4352348763\n";
exit;
}
if ( scalar(@ARGV) ne 2 )
{
print "You didn't provide enough variables\n"
&help();
}
&work($inputfile,$dialeddigits,0,0,0);
sub work($$$$$)
{
# DCT file in csv format or type
my $type = shift;
# Since we wrap back on our self to walk DCTs we need to make sure we exit on types of int,etc
if ( $type =~ /^(int|int\d+)/ )
{
print "User will be sent to an intercept message\n";
exit;
}
elsif ( $type =~ /^(rte|rte?\d+)/ )
{
print "Digits will be sent to Route: $type\n";
exit;
}
elsif ( $type =~ /^(stn|stn?\d+)/ )
{
print "Digits will be sent to a local station.\n";
exit;
}
# numbers dialed
my $digits = shift;
chomp($digits);
# Adjust digits based on pre, pos, and mark
my $pre = shift;
my $pos = shift;
my $mark = shift;
$digits = substr($digits, $pre) if ( $pre > 0 );
$digits = substr($digits, -$pos) if ( $pos > 0 );
$digits = substr($digits, $mark) if ( $mark > 0 );
# DCT to be used that is passed by commandline
my $dct = {};
if ( -f "$type.csv" )
{
print "Reading DCT file: \"$type.csv\"\n";
}
else
{
print "File: \"$type.csv\" does not exist. :: $!\n";
exit;
}
my @dctarr = `cat "$type.csv"`;
for my $dctentry (@dctarr)
{
my ($ent, $patt, $sc, $type, $val, $pre, $pos, $mark, $next, $sb, $sst, $tid);
($ent, $patt, $sc, $type, $val, $pre, $pos, $mark, $next, $sb, $sst, $tid) = split(/,/, $dctentry);
$dct->{$ent}->{'origpatt'} = $patt;
$patt =~ s/n/[2-9]/g;
$patt =~ s/x/[0-9]/g;
$patt =~ s/q/[0-4]/g;
$patt =~ s/Q/[5-9]/g;
$patt =~ s/X/[2-8]/g;
$patt =~ s/\~/\\d+/g;
$patt =~ s/\*/\\*/g;
$patt =~ s/\#/\\#/g;
$patt =~ s/\?/[0-9]/g;
$patt =~ s/w//g;
$dct->{$ent}->{'patt'} = $patt;
$dct->{$ent}->{'sc'} = $sc;
$dct->{$ent}->{'type'} = $type;
$dct->{$ent}->{'val'} = $val;
$dct->{$ent}->{'pre'} = $pre;
$dct->{$ent}->{'pos'} = $pos;
$dct->{$ent}->{'mark'} = $mark;
$dct->{$ent}->{'next'} = $next;
$dct->{$ent}->{'sb'} = $sb;
$dct->{$ent}->{'sst'} = $sst;
$dct->{$ent}->{'tid'} = $tid;
}
# Create a pattern hash keyed by pattern with entry and value
my $patt_ref = {};
for my $key ( sort keys %$dct )
{
$patt_ref->{$dct->{$key}->{'origpatt'}} = $key;
}
print "Proccessing " . length($digits) . " Digit Dialed Number \"$digits\"\n";
my $charcnt = 0;
# Print DCT in really short form
print "DCT = $type\n";
print "ENTRY PATTERN PATTERN (as seen by Perl)\n";
for my $key ( sort { $a <=> $b } keys %$dct )
{
printf ("%-5s %-14s %s\n", $key,$dct->{$key}->{'origpatt'},($dct->{$key}->{'patt'}));
}
# Sub-routine to print DCT
sub printdct ($$$$$$$$)
{
my $printent = shift;
my $printpatt = shift;
my $printsc = shift;
my $printtype = shift;
my $printval = shift;
my $printpre = shift;
my $printpos = shift;
my $printmark = shift;
my $printnext = shift;
my $printsb = shift;
my $printsst = shift;
my $printtid = shift;
print "ENTRY PATTERN SC TYPE VAL PRE POS MARK NEXT SB/SNU SST/NST TID \n";
format DCTREPORT =
@<<<< @<<<<<<<<<<<<<< @< @<<< @<< @<< @<< @<<< @<<< @<<<<< @<<<<<< @<<
$printent $printpatt $printsc $printtype $printval $printpre $printpos $printmark $printnext $printsb $printsst $printtid
.
$~ = 'DCTREPORT';
write;
}
# Check for an exact match first
for my $patt_orig (sort keys %$patt_ref)
{
my $dctentry = $patt_ref->{$patt_orig};
my $patt = $dct->{$dctentry}->{'patt'};
if ( $dctentry eq 0 )
{
next;
}
if ( $digits =~ /^$patt$/ )
{
print "\nFound exact match!\n";
&printdct($dctentry,$dct->{$dctentry}->{'origpatt'},$dct->{$dctentry}->{'sc'},$dct->{$dctentry}->{'type'},$dct->{$dctentry}->{'val'},$dct->{$dctentry}->{'pre'},$dct->{$dctentry}->{'pos'},$dct->{$dctentry}->{'mark'},$dct->{$dctentry}->{'next'},$dct->{$dctentry}->{'sb'},$dct->{$dctentry}->{'sst'},$dct->{$dctentry}->{'tid'});
if ( $dct->{$dctentry}->{'type'} eq 'sup' )
{
print "User will be sent to a DCT equal to the Next field with Supervision\n";
$dct->{$dctentry}->{'type'} = 'dct';
$dct->{$dctentry}->{'val'} = $dct->{$dctentry}->{'next'}
}
&work("$dct->{$dctentry}->{'type'}$dct->{$dctentry}->{'val'}",$digits,$dct->{$dctentry}->{'pre'},$dct->{$dctentry}->{'pos'},length($patt));
}
else
{
if ( substr($digits, 0, length($dct->{$dctentry}->{'origpatt'})) =~ /^$patt$/ )
{
print "\nFound DbyD exact match!\n";
&printdct($dctentry,$dct->{$dctentry}->{'origpatt'},$dct->{$dctentry}->{'sc'},$dct->{$dctentry}->{'type'},$dct->{$dctentry}->{'val'},$dct->{$dctentry}->{'pre'},$dct->{$dctentry}->{'pos'},$dct->{$dctentry}->{'mark'},$dct->{$dctentry}->{'next'},$dct->{$dctentry}->{'sb'},$dct->{$dctentry}->{'sst'},$dct->{$dctentry}->{'tid'});
if ( $dct->{$dctentry}->{'type'} eq 'sup' )
{
print "User will be sent to a DCT equal to the Next field with Supervision\n";
$dct->{$dctentry}->{'type'} = 'dct';
$dct->{$dctentry}->{'val'} = $dct->{$dctentry}->{'next'}
}
&work("$dct->{$dctentry}->{'type'}$dct->{$dctentry}->{'val'}",$digits,$dct->{$dctentry}->{'pre'},$dct->{$dctentry}->{'pos'},length($patt));
}
}
}
print "\nNo match using Default.\n";
&printdct(0,$dct->{'0'}->{'origpatt'},$dct->{'0'}->{'sc'},$dct->{'0'}->{'type'},$dct->{'0'}->{'val'},$dct->{'0'}->{'pre'},$dct->{'0'}->{'pos'},$dct->{'0'}->{'mark'},$dct->{'0'}->{'next'},$dct->{'0'}->{'sb'},$dct->{'0'}->{'sst'},$dct->{'0'}->{'tid'});
if ( $dct->{'0'}->{'type'} eq 'sup' )
{
print "User will be sent to a DCT equal to the Next field with Supervision\n";
$dct->{'0'}->{'type'} = 'dct';
$dct->{'0'}->{'val'} = $dct->{$dctentry}->{'next'}
}
&work("$dct->{'0'}->{'type'}$dct->{'0'}->{'val'}",$digits,$dct->{'0'}->{'pre'},$dct->{'0'}->{'pos'},0);
}
# make sure we exit incase we don't make it into the subroutines
exit;
Here are my sample Dial Code Table files.
::::::::::::::
dct0.csv
::::::::::::::
0,-default-,0,dct,6,0,0,0, 1,*,0,dct,1,0,0,ac, 2,#,0,dct,2,0,0,ac, 3,?111,0,rte,1,0,0,0, 4,zxxxx,0,rte,3,0,0,0, 5,1nxxnxxxxxx,0,rte,1,0,0,0, 6,011~w,0,rte,1,0,0,0, 7,011~#,0,rte,1,0,0,0, 8,1800nxxxxxx,0,rte,1,0,0,0, 9,911,0,rte,1,0,0,0, 10,011~,0,rte,1,0,0,0,
::::::::::::::
dct6.csv
::::::::::::::
0,-default-,0,dct,7,0,0,0, 1,623,0,dct,7,0,0,ac, 2,480,0,dct,7,0,0,ac, 3,xxx,0,rte,1,0,0,0,
::::::::::::::
dct7.csv
::::::::::::::
0,-default-,0,int,0,0,ac,,,0,, 1,959,0,dct,8,0,0,ac,,,0,, 2,4x21207,0,dct,8,0,0,ac,,,0,, 3,738,0,dct,8,0,0,ac,,,0,, 4,525,0,dct,8,0,0,ac,,,0,, 5,4x21206,0,dct,8,0,0,ac,,,0,, 6,4x21,0,dct,8,0,0,ac,,,0,,
::::::::::::::
dct8.csv
::::::::::::::
0,-default-,0,int,,0,0,ac,,,0,, 1,1155,0,sup,,ac,0,ac,17,,0,, 2,11xx,0,stn,0,0,0,ac,,,0,, 3,12xx,0,stn,0,0,0,ac,,,0,, 4,25xx,0,stn,0,0,0,ac,,,0,, 5,26xx,0,stn,0,0,0,ac,,,0,, 6,93xx,0,stn,0,0,0,ac,,,0,, 7,94xx,0,stn,0,0,0,ac,,,0,, 8,95xx,0,stn,0,0,0,ac,,,0,, 9,xxxx,0,rte,1,0,0,0,,,0,,
::::::::::::::
dct17.csv
::::::::::::::
0,-default-,0,int,,0,0,ac,,,0,, 1,1155,0,sup,,ac,0,ac,17,,0,, 2,11xx,0,stn,0,0,0,ac,,,0,, 3,12xx,0,stn,0,0,0,ac,,,0,, 4,25xx,0,stn,0,0,0,ac,,,0,, 5,26xx,0,stn,0,0,0,ac,,,0,, 6,93xx,0,stn,0,0,0,ac,,,0,, 7,94xx,0,stn,0,0,0,ac,,,0,, 8,95xx,0,stn,0,0,0,ac,,,0,, 9,xxxx,0,rte,1,0,0,0,,,0,,
Gheek.net 