Gheek.net

October 3, 2011

REDCOM DCT Translation Tester using net.db (100% offline)

Filed under: perl, REDCOM — lancevermilion @ 2:23 pm

The other day I shared my script on how to parse Dial Code Tables (DCT) if took the time to convert them to CSV. Well after thinking about it this morning I made a quick change to my code to read in the net.db file (ascii copy of the database) and process routing that way.

Update: I found some coding errors, removed the utilization of external shell commands, and added strict usage.

Redcom version 4.0 R1P1

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:    10/4/2011
# Rev:     0.4
# Syntax:  dct.pl
# Example: dct.pl dct0 4352348763
#################################################################

#################################################################
# Instructions:
# Downlaod the binary configuration to a ascii format on the
# Redcom.
# rsh /tmp> xld downl;over=yes;downl;exit;log
# Cat the net.db and copy/paste this in a local net.db file in the
# same folder as dct.pl
# cat /sys/net.db
# dct.pl will parse net.db and preform all the work needed just
# as if it was being processed through the Redcom.
#################################################################

#################################################################
# 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
#################################################################

use strict;
use Carp;
use Data::Dumper;

my $dctnumber = "$ARGV[0]";
my $dialeddigits = "$ARGV[1]";
my $file = "net.db";

# DCT to be used that is passed by commandline
my $hash_ref = {};
print "Reading \"$file\" file: ";
if ( -f "$file" )
{
  print "[OK]\n";
}
else
{
  print "[FAILED]\n";
  croak "File: \"$file\" does not exist. :: $!\n";
}

# File net.db exists slurp it to an array
open(FH, "$file" ) or die "Could not open $file\n";
my @netdbarr = ;

sub help()
{
  print "Syntax:  dct.pl  \n";
  print "Example: dct.pl dct0 4352348763\n";
  exit;
}

if ( scalar(@ARGV) ne 2 )
{
  print "You didn't provide enough variables\n"
  &help();
}

&buildDCThash();
&processDCThash($dctnumber,$dialeddigits,0,0,0);

# 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; } # Sub-routine to build our hash sub buildDCThash() {   my $curdct = '';   my $curgrp = '';   my $currte = '';   for my $netdbline (@netdbarr)   {     if ( $netdbline =~ /^_dcta\[ (\d+) \] = (.*)/ )     {       $curdct = "dct$1";       my ($dctname, $dctqty, undef, undef, undef, undef, $dcttoneable, undef, $dctdialtimer) = split(/,/, $2);       $hash_ref->{'dct'}->{$curdct}->{'name'} = $dctname;
      $hash_ref->{'dct'}->{$curdct}->{'qty'} = $dctqty;
      $hash_ref->{'dct'}->{$curdct}->{'tonable'} = $dcttoneable;
      $hash_ref->{'dct'}->{$curdct}->{'dtimer'} = $dctdialtimer;
    }

    $netdbline =~ s/,252,/,,/g if $netdbline =~ /^_dctm/; #252 equals blank
    $netdbline =~ s/220/ac/g if $netdbline =~ /^_dctm/;   #220 equals ac
    if ( $netdbline =~ /^_dctm\[ (\d+) \] = (.*)/ )
    {
      my $ent=$1;
      my ($patt, $type, $val, $next, $sc, $pre, $pos, $mark, $sb, undef, $sst, undef, $tid) = split(/,/, $2);
      $patt = '-default-' if $ent eq 0;  # net.db stored a blank entry for entry 0 aka -default- so we hard set the value.
      $hash_ref->{'dct'}->{$curdct}->{'entries'}->{$ent}->{'origpatt'} = $patt;
      $patt = 'NULL_PATTERN' if $patt eq '';
      $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;
      $hash_ref->{'dct'}->{$curdct}->{'entries'}->{$ent}->{'patt'} = $patt;
      $hash_ref->{'dct'}->{$curdct}->{'entries'}->{$ent}->{'sc'}   = $sc;
      $hash_ref->{'dct'}->{$curdct}->{'entries'}->{$ent}->{'type'} = $type;
      $hash_ref->{'dct'}->{$curdct}->{'entries'}->{$ent}->{'val'}  = $val;
      $hash_ref->{'dct'}->{$curdct}->{'entries'}->{$ent}->{'pre'}  = $pre;
      $hash_ref->{'dct'}->{$curdct}->{'entries'}->{$ent}->{'pos'}  = $pos;
      $hash_ref->{'dct'}->{$curdct}->{'entries'}->{$ent}->{'mark'} = $mark;
      $hash_ref->{'dct'}->{$curdct}->{'entries'}->{$ent}->{'next'} = $next;
      $hash_ref->{'dct'}->{$curdct}->{'entries'}->{$ent}->{'sb'} = $sb;
      $hash_ref->{'dct'}->{$curdct}->{'entries'}->{$ent}->{'sst'} = $sst;
      $tid =~ s/65535//;   # similar to VAL, except that the final value 65535 would be reserved for the "blank" case)
      $hash_ref->{'dct'}->{$curdct}->{'entries'}->{$ent}->{'tid'} = $tid;
    }

    #
    # INCLUDE ROUTE AND GROUP INFORMATION
    #
    if ( $netdbline =~ /^_grpatt\[ (\d+), 1 \] = (.*)/ )
    {
      $curgrp = $1;
      my ( $type1,undef,undef,$grpname,undef,undef,undef ) = split(/,/, $2);
      #print "$group $type1 $grpname\n";
      $hash_ref->{'grp'}->{$curgrp}->{'group'} = $curgrp;
      $hash_ref->{'grp'}->{$curgrp}->{'type1'} = $type1;
      $hash_ref->{'grp'}->{$curgrp}->{'grpname'} = $grpname;
    }

    if ( $netdbline =~ /^_grpatt\[ (\d+), 3 \] = (.*)/ )
    {
      if ( $curgrp eq $1 )
     {
        my ( $type3,$grptype,undef,undef,undef,undef,undef,undef,undef) = split(/,/, $2);
        #print "$group,$type3,$grptype\n";
        $hash_ref->{'grp'}->{$curgrp}->{'type3'} = $type3;
        $hash_ref->{'grp'}->{$curgrp}->{'grptype'} = $grptype;
      }
    }

    my $currte = '';
    if ( $netdbline =~ /^route\[ (\d+), 1 \] = (.*)/ )
    {
      $currte = "rte$1";
      my ( $prefix_digits,undef,undef,undef,$rtename,$alt1,$alt2,$alt3,undef,undef,undef,undef,$catid,undef,undef,undef,undef,undef,undef,undef,$comp,undef,undef,undef,undef,$groupnum,undef,undef,undef,undef,undef,undef,undef ) = split(/,/, $2);
      $comp =~ s/0x0/off/g;
      $comp =~ s/0x40/on/g;
      #print "$route,$prefix_digits,$rtename,$alt1,$alt2,$alt3,$comp,$groupnum\n";
      $hash_ref->{'rte'}->{$currte}->{'prefix_digits'} = $prefix_digits;
      $hash_ref->{'rte'}->{$currte}->{'rtename'} = $rtename;
      $hash_ref->{'rte'}->{$currte}->{'alt1'} = $alt1;
      $hash_ref->{'rte'}->{$currte}->{'alt2'} = $alt2;
      $hash_ref->{'rte'}->{$currte}->{'alt3'} = $alt3;
      $hash_ref->{'rte'}->{$currte}->{'comp'} = $comp;
      $hash_ref->{'rte'}->{$currte}->{'groupnum'} = $groupnum;
    }
  }
}

# Sub-routine to process the hash
sub processDCThash($$$$$)
{
# TYPE (DCT type and val (ie. dct6)
# Digits (digits to be processed)
# Pre (digits to delete from begining of the digit string)
# Pos (digits to delete from end of the digit string)
# Mark (pass all digits, but read from n place in the digit string)

  # TYPE from DCT
  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";
    print "#" x 73 . "\n";
    exit;
  }
  elsif ( $TYPE =~ /^(rte|rte\d+)/ )
  {
    my $tempTYPE = $TYPE;
    $tempTYPE =~ s/rte//g;
    print "Digits will be sent to:\n";
    print "  Primary Route: Route $tempTYPE $hash_ref->{'rte'}->{$TYPE}->{'rtename'}\n";
    print "    Group $hash_ref->{'rte'}->{$TYPE}->{'groupnum'} $hash_ref->{'grp'}->{$hash_ref->{'rte'}->{$TYPE}->{'groupnum'}}->{'grpname'} Type: $hash_ref->{'grp'}->{$hash_ref->{'rte'}->{$TYPE}->{'groupnum'}}->{'type1'},$hash_ref->{'grp'}->{$hash_ref->{'rte'}->{$TYPE}->{'groupnum'}}->{'type3'}\n";
    print "    Inserted Prefix Digits: $hash_ref->{'rte'}->{$TYPE}->{'prefix_digits'}\n" if $hash_ref->{'rte'}->{$TYPE}->{'prefix_digits'} ne '';
    if ( $hash_ref->{'rte'}->{$TYPE}->{'alt1'} ne 0 )
    {
      my $tmpalt1rte = "rte" . $hash_ref->{'rte'}->{$TYPE}->{'alt1'};
      my $tmpalt1grp = $hash_ref->{'rte'}->{$tmpalt1rte}->{'groupnum'};
      print "  Alternate Route #1: Route $hash_ref->{'rte'}->{$TYPE}->{'alt1'} $hash_ref->{'rte'}->{$tmpalt1rte}->{'rtename'}\n";
      print "    Group $tmpalt1grp $hash_ref->{'grp'}->{$tmpalt1grp}->{'grpname'} Type: $hash_ref->{'grp'}->{$tmpalt1grp}->{'type1'},$hash_ref->{'grp'}->{$tmpalt1grp}->{'type3'}\n";
      print "    Inserted Prefix Digits: $hash_ref->{'rte'}->{$tmpalt1rte}->{'prefix_digits'}\n" if $hash_ref->{'rte'}->{$tmpalt1rte}->{'prefix_digits'} ne '';
    }
    if ( $hash_ref->{'rte'}->{$TYPE}->{'alt2'} ne 0 )
    {
      my $tmpalt2rte = "rte" . $hash_ref->{'rte'}->{$TYPE}->{'alt2'};
      my $tmpalt2grp = $hash_ref->{'rte'}->{$tmpalt2rte}->{'groupnum'};
      print "  Alternate Route #2: Route $hash_ref->{'rte'}->{$TYPE}->{'alt2'} $hash_ref->{'rte'}->{$tmpalt2rte}->{'rtename'}\n";
      print "    Group $tmpalt2grp $hash_ref->{'grp'}->{$tmpalt2grp}->{'grpname'} Type: $hash_ref->{'grp'}->{$tmpalt2grp}->{'type1'},$hash_ref->{'grp'}->{$tmpalt2grp}->{'type3'}\n";
      print "    Inserted Prefix Digits: $hash_ref->{'rte'}->{$tmpalt2rte}->{'prefix_digits'}\n" if $hash_ref->{'rte'}->{$tmpalt2rte}->{'prefix_digits'} ne '';
    }
    if ( $hash_ref->{'rte'}->{$TYPE}->{'alt3'} ne 0 )
    {
      my $tmpalt3rte = "rte" . $hash_ref->{'rte'}->{$TYPE}->{'alt3'};
      my $tmpalt3grp = $hash_ref->{'rte'}->{$tmpalt3rte}->{'groupnum'};
      print "  Alternate Route #3: Route $hash_ref->{'rte'}->{$TYPE}->{'alt3'} $hash_ref->{'rte'}->{$tmpalt3rte}->{'rtename'}\n";
      print "    Group $tmpalt3grp $hash_ref->{'grp'}->{$tmpalt3grp}->{'grpname'} Type: $hash_ref->{'grp'}->{$tmpalt3grp}->{'type1'},$hash_ref->{'grp'}->{$tmpalt3grp}->{'type3'}\n";
      print "    Inserted Prefix Digits: $hash_ref->{'rte'}->{$tmpalt3rte}->{'prefix_digits'}\n" if $hash_ref->{'rte'}->{$tmpalt3rte}->{'prefix_digits'} ne '';
    }
    print "#" x 73 . "\n";
    exit;
  }
  elsif ( $TYPE =~ /^(stn|stn\d+)/ )
  {
    print "Digits will be sent to a local station.\n";
    print "#" x 73 . "\n";
    exit;
  }

  # Account for the fact the user may not provide dct6 and may provide something else.
  if ( $TYPE !~ /^dct\d+$/ )
  {
    print "Error: The Dial Code Table (DCT) you want to start at must be in this format.\n";
    print "       dct\n";
    print "       Example: dct0\n";
    my $loop = 0;
    until ( $TYPE =~ /^dct\d+$/ )
    {
      print "Re-Enter your DCT: ";
      chomp($TYPE = );
      $loop++;
      if ($loop >= 3)
      {
        print "Exiting!!! You failed to enter the DCT correctly 3 times.\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 );

  my $curdct = '';

  # Create a pattern hash keyed by pattern with entry and value
  my $patt_ref = {};
  for my $key ( sort keys %{$hash_ref->{'dct'}->{$TYPE}->{'entries'}} )
  {
    $patt_ref->{$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$key}->{'origpatt'}} = $key;
  }

  print "\n" . "#" x 73 . "\n";
  print "Processing " . length($digits) . " Digit Dialed Number \"$digits\"\n";

  my $charcnt = 0;

  # Print DCT in really short form
  my $tmpTYPE = $TYPE;
  $tmpTYPE =~ s/dct//g;
  print "DCT Number = $tmpTYPE\n";
  print "DCT Name = $hash_ref->{'dct'}->{$TYPE}->{'name'}\n";
  print "DCT Entry Quantity = $hash_ref->{'dct'}->{$TYPE}->{'qty'}\n";
  print "DCT Toneable = $hash_ref->{'dct'}->{$TYPE}->{'tonable'}\n";
  print "DCT Dial Timer = " . $hash_ref->{'dct'}->{$TYPE}->{'dtimer'}/100 . " seconds\n";
  print "=" x 73 . "\n";
  print "ENTRY PATTERN        PATTERN (as seen by Perl)\n";
  for my $key ( sort { $a  $b } keys %{$hash_ref->{'dct'}->{$TYPE}->{'entries'}} )
  {
    printf ("%-5s %-14s %s\n", $key,$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$key}->{'origpatt'},($hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$key}->{'patt'}));
  }
  print "=" x 73 . "\n";

  # Check for an exact match first
  for my $patt_orig (sort keys %$patt_ref)
  {
    my $dctentry = $patt_ref->{$patt_orig};
    my $patt = $hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'patt'};
    if ( $dctentry eq 0 )
    {
      next;
    }
    if ( $digits =~ /^$patt$/ )
    {
      print " * Found exact match!\n";
      &printdct($dctentry,$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'origpatt'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'sc'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'type'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'val'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'pre'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'pos'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'mark'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'next'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'sb'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'sst'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'tid'});
      print "#" x 73 . "\n";
      if ( $hash_ref->{'dct'}->{$dctentry}->{'type'} eq 'sup' )
      {
        print "User will be sent to a DCT equal to the Next field with Supervision\n";
        print "#" x 73 . "\n";
        $hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'type'} = 'dct';
        $hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'val'} = $hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'next'}
      }
      &processDCThash("$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'type'}$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'val'}",$digits,$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'pre'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'pos'},length($patt));
    }
    else
    {
      if ( substr($digits, 0, length($hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'origpatt'})) =~ /^$patt$/ )
      {
        print " * Found DbyD exact match!\n";
        &printdct($dctentry,$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'origpatt'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'sc'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'type'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'val'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'pre'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'pos'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'mark'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'next'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'sb'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'sst'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'tid'});
        print "#" x 73 . "\n";
        if ( $hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'type'} eq 'sup' )
        {
          print "User will be sent to a DCT equal to the Next field with Supervision\n";
          print "#" x 73 . "\n";
          $hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'type'} = 'dct';
          $hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'val'} = $hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'next'}
        }
        &processDCThash("$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'type'}$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'val'}",$digits,$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'pre'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{$dctentry}->{'pos'},length($patt));
      }
    }
  }

  print " * No match using Default.\n";
  &printdct(0,$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'origpatt'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'sc'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'type'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'val'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'pre'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'pos'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'mark'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'next'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'sb'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'sst'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'tid'});
  print "#" x 73 . "\n";
  if ( $hash_ref->{'dct'}->{'0'}->{'type'} eq 'sup' )
  {
    print "User will be sent to a DCT equal to the Next field with Supervision\n";
    print "#" x 73 . "\n";
    $hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'type'} = 'dct';
    $hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'val'} = $hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'next'}
  }
  &processDCThash("$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'type'}$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'val'}",$digits,$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'pre'},$hash_ref->{'dct'}->{$TYPE}->{'entries'}->{'0'}->{'pos'},0);
}

# make sure we exit incase we don't make it into the subroutines
exit;

Sample output: Traffic routes to a local station.

Reading "net.db" file: [OK]

#########################################################################
Processing 10 Digit Dialed Number "6235951206"
DCT Number = 0
DCT Name = "Loop Originate"
DCT Entry Quantity = 10
DCT Toneable = dial
DCT Dial Timer = 7 seconds
=========================================================================
ENTRY PATTERN        PATTERN (as seen by Perl)
0     -default-      -default-
1     *              \*
2     #              \#
3     911            911
4     zxxxx          z[0-9][0-9][0-9][0-9]
5     1nxxnxxxxxx    1[2-9][0-9][0-9][2-9][0-9][0-9][0-9][0-9][0-9][0-9]
6     011~w          011\d+
7     011~#          011\d+\#
8     1800nxxxxxx    1800[2-9][0-9][0-9][0-9][0-9][0-9][0-9]
9                    NULL_PATTERN
=========================================================================
 * No match using Default.
ENTRY PATTERN         SC TYPE VAL PRE POS MARK NEXT SB/SNU  SST/NST  TID
0     -default-       0  dct  6   0   0   0         0       0
#########################################################################

#########################################################################
Processing 10 Digit Dialed Number "6235951206"
DCT Number = 6
DCT Name = "NPA Check"
DCT Entry Quantity = 10
DCT Toneable = sil
DCT Dial Timer = 7 seconds
=========================================================================
ENTRY PATTERN        PATTERN (as seen by Perl)
0     -default-      -default-
1     623            623
2     480            480
3     xxx            [0-9][0-9][0-9]
4                    NULL_PATTERN
5                    NULL_PATTERN
6                    NULL_PATTERN
7                    NULL_PATTERN
=========================================================================
 * Found DbyD exact match!
ENTRY PATTERN         SC TYPE VAL PRE POS MARK NEXT SB/SNU  SST/NST  TID
1     623             0  dct  7   0   0   ac        0       0
#########################################################################

#########################################################################
Processing 7 Digit Dialed Number "5951206"
DCT Number = 7
DCT Name = "Switch Code Check"
DCT Entry Quantity = 7
DCT Toneable = sil
DCT Dial Timer = 7 seconds
=========================================================================
ENTRY PATTERN        PATTERN (as seen by Perl)
0     -default-      -default-
1     959            959
2     595            432
3     738            738
4     525            525
5     nxxxxxx        [2-9][0-9][0-9][0-9][0-9][0-9][0-9]
=========================================================================
 * Found DbyD exact match!
ENTRY PATTERN         SC TYPE VAL PRE POS MARK NEXT SB/SNU  SST/NST  TID
2     595             0  dct  8   0   0   ac        0       0
#########################################################################

#########################################################################
Processing 4 Digit Dialed Number "1206"
DCT Number = 8
DCT Name = "Local Numbers"
DCT Entry Quantity = 20
DCT Toneable = sil
DCT Dial Timer = 7 seconds
=========================================================================
ENTRY PATTERN        PATTERN (as seen by Perl)
0     -default-      -default-
1     1155           1155
2     11xx           11[0-9][0-9]
3     12xx           12[0-9][0-9]
4     25xx           25[0-9][0-9]
5     26xx           26[0-9][0-9]
6     93xx           93[0-9][0-9]
7     94xx           94[0-9][0-9]
8     95xx           95[0-9][0-9]
9     xxxx           [0-9][0-9][0-9][0-9]
=========================================================================
 * Found exact match!
ENTRY PATTERN         SC TYPE VAL PRE POS MARK NEXT SB/SNU  SST/NST  TID
3     12xx            0  stn  0   0   0   ac        0       0
#########################################################################
Digits will be sent to a local station.
#########################################################################

Sample Output: Traffic goes out a Trunk to PSTN

Reading "net.db" file: [OK]

#########################################################################
Processing 11 Digit Dialed Number "16134321209"
DCT Number = 0
DCT Name = "Loop Originate"
DCT Entry Quantity = 15
DCT Toneable = dial
DCT Dial Timer = 7 seconds
=========================================================================
ENTRY PATTERN        PATTERN (as seen by Perl)
0     -default-      -default-
1     *              \*
2     #              \#
3     911            911
4     zxxxx          z[0-9][0-9][0-9][0-9]
5     1480nxxxxxx    1480[2-9][0-9][0-9][0-9][0-9][0-9][0-9]
6     1602nxxxxxx    1602[2-9][0-9][0-9][0-9][0-9][0-9][0-9]
7     1623nxxxxxx    1623[2-9][0-9][0-9][0-9][0-9][0-9][0-9]
8     1nxxnxxxxxx    1[2-9][0-9][0-9][2-9][0-9][0-9][0-9][0-9][0-9][0-9]
9     011~w          011\d+
10    011~#          011\d+\#
11    1800nxxxxxx    1800[2-9][0-9][0-9][0-9][0-9][0-9][0-9]
12                   NULL_PATTERN
=========================================================================
 * Found exact match!
ENTRY PATTERN         SC TYPE VAL PRE POS MARK NEXT SB/SNU  SST/NST  TID
8     1nxxnxxxxxx     0  rte  1   0   0   0         0       0
#########################################################################
Digits will be sent to:
  Primary Route: Route 1 "Primary PSTN"
    Group 8 "PRI Span 1/0" Type: trk,trk
  Alternate Route #1: Route 7 "Secondary PSTN"
    Group 6 "PRI Span 1/1" Type: trk,trk
#########################################################################
Advertisements

September 30, 2011

REDCOM DCT Translation Tester (100% offline)

Filed under: perl, REDCOM — lancevermilion @ 5:45 pm

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,,

Blog at WordPress.com.