Super CallerID

# supercallerid.pl – by natas
# uses modified bm.pl code by dual
# and contributed code from strom carlson
# http://www.oldskoolphreak.com

# —- STEP BY STEP INSTRUCTIONS —- #

# Remove .txt file extension and change to .pl
# Copy file to your desired directory
# chmod +x supercallerid.pl
# Add this command to your incoming line in extensions.conf
# before your answer statement and point it to the correct location
# exten => your-number,1,System(/yourdirectory/./supercallerid.pl ${CALLERIDNUM} ${CALLERIDNUM} ${CALLERIDNAME} > /yourdirectory/super_callerid_output.txt)
# This will pass the arguments to supercallerid.pl and output the info to the super_callerid_screen.txt file
# Create the file super_callerid_output.txt or call your incoming number
# In a new terminal screen execute watch cat /yourdirectory/super_callerid_output.txt
# If you need the perl modules below do
# perl -MCPAN -e "install WWW::Mechanize" and/or
# perl -MCPAN -e "install HTML::TokeParser::Simple"
# ENJOY!

use strict;
use LWP;
use HTML::TokeParser::Simple;
use WWW::Mechanize;

my $input;
my $callerid;
my $calleridname;
my $calleridnum;

# $ARGV[0] is coverted from the npanxxxxxx format callerid
# Asterisk passes to the npa-nxx-xxx format needed by bellsmind
#~np~ $ARGV[1] is here so it gets printed neatly in the output

if ($ARGV[0] =~ /^(\d\d\d)(\d\d\d)(\d\d\d\d)$/)
{
$input = "$1-$2";
}
if ($ARGV[1] =~ /^(\d\d\d)(\d\d\d)(\d\d\d\d)$/)
{
$callerid = "$1-$2-$3";
}

# WWWW::Mechanize code by strom carlson
# uses whitepages.com to gather added info

my $mech = WWW::Mechanize->new();
$mech->get("http://www.whitepages.com/10001/reverse_phone");

$mech->submit_form(
form_number => 2,
fields => {
phone => $ARGV[0],
}
);

my $content = $mech->content();

my $firstname;
my $lastname;
my $address;
my $city;
my $state;
my $zip;

if ($content =~
/.*oas_query.+_RM_HTML_FIRST_ESC_=(.*)&_RM_HTML_LAST_ESC_=(.*)&_RM_HTML_ADDRESS_ESC_=(.*)&_RM_HTML_STREET_ESC_=(.*)&_RM_HTML_HOUSE_ESC_=(.*)&_RM_HTML_CITY_ESC_=(.*)&_RM_HTML_STATE_ESC_=(.*)&_RM_HTML_ZIP_ESC_=(.*)&_RM_HTML_PHONE_ESC_=.*/)
{
$firstname = $1;
$lastname = $2;
$address = $3;
$city = $6;
$state = $7;
$zip = $8;
}

foreach ($firstname,$lastname,$address,$city,$state,$zip)
{
$_ =~ s/%20/ /g;
}

# $callername has so many unused $ARGV’s in case the
# CNAM asterisk is passing has lots of spaces
# CNAM is up to 15 characters long

$calleridnum = "$callerid";
$calleridname = "$ARGV[2]"." "."$ARGV[3]"." "."$ARGV[4]"." "."$ARGV[5]"." "."$ARGV[6]"." "."$ARGV[7]"." "."$ARGV[8]"." "."$ARGV[9]"." "."$ARGV[10]";

print " Caller ID\t"."$calleridnum\n";
print " CNAM\t\t"."$calleridname\n";
print " First Name\t"."$firstname\n";
print " Last Name\t"."$lastname\n";
print " Address\t"."$address\n";
print " City\t\t"."$city\n";
print " State\t\t"."$state\n";
print " Zip Code\t"."$zip\n";
print "\n";

my($npa, $nxx) = split(/-/, $input);

my $browser = LWP::UserAgent->new;
$browser->env_proxy();
my $response = $browser->get(
"http://bellsmind.net/Engine/legacy/BellsMindParseExtended.php?SearchType=NPANXX&NPA=$npa&NXX=$nxx"
~np~);
die "Error: ", $response->status_line
unless $response->is_success;

my $output = $response->content;

my $stream = HTML::TokeParser::Simple->new(\$output);

my $count1 = 0;
my $count2 = 0;
my $spltrcs;

while (my $token = $stream->get_token) {
if ($token->is_text) {
my $text = $token->as_is;
if ($text =~ /Location/) {print "$text\t";}
elsif ($text =~ /Address/) {print "$text\t";}
elsif ($text =~ /Use code/) {print "$text\t";}
elsif ($text =~ /OCN/) {print "$text\t\t";}
elsif ($text =~ /Company/) {print "$text\t";}
elsif ($text =~ /Local RC/) {print "$text\t";}
elsif ($text =~ /Switch RCs/) {print "$text\t";}
elsif ($text =~ /CLLI/) {print "$text\t\t";}
elsif ($text =~ /IG/) {print "$text\t\t";}
elsif ($text =~ /Switch type/) {print "$text\t";}
elsif ($text =~ /Also serves/) {print "$text\t";}
elsif ($text =~ /Scanned/) {last;}
elsif ($text =~ /\[.+\]/) {
my @rcs = split(/\]\s\[/, $text);
for $spltrcs(@rcs) {
print "$spltrcs ";
$count1++;
if ($count1 == 5) {
print "\n\t\t";
$count1 = 0;
}
}
}
elsif ($text =~ /\d{3}-\d{3}/) {
print $text;
$count2++;
if ($count2 == 7) {
print "\n\t\t\b";
$count2 = 1;
}
}
else {print $text;}
}
}