Compare List of IP Addresses With Perl and Tk

If you happen to have a list of IPs and you want to compare to another list IPs, you can use Perl and Tk to automate the process.

When preparing networking reports it is common to have a list of IP addresses and you might need to compare to another list as you research. If your have more than just a handful of IP addresses, you will easily break concentration when comparing them by hand. Broken concentration can easily lead to errors. Compare a List of IP Addresses Using Perl and Tk!

#!/usr/bin/perl

# List Compare was written to help prevent errors when looking at
# firewall requests that have potentially, but not guaranteed similar lists.
# for example, one combo might have 18 IPs in it's source, and then another combo
# might have 17 IPs that are the same, but 1 is different.
# By pasting both lists, you can know automatically if they are the same
# useful in creating object groups
# useful in pasting the results of juniper scripts to verify it matches the FAF
# also, removes duplicates from both lists while checking
# also, extracts x.x.x.x format from any pasted text, it doesn't have to be a clean list of ip address
# resets so you can keep testing repeatedly in the case of multiple combos

# note that this is not a valid IP checker!
# ips can be in the form of a, a.b, a.b.c, or a.b.c.d
# ips are 32 bit binary numbers!
# this is just for sorting strings that look like IPs
# there is NO error checking

# KNOWN ISSUE:
# 1.1.1.1-1.1.1.10 only gets 2 ip addresses, not the range

# call this from a batch file if you want to hide the window:
# notepad tk.thisfile.bat

# @ECHO off
# start /min perl tk.thisfile.pl

# Tk, List::Utils, and List::AllUtils are not standard

use warnings;
use strict;
use Tk;
use constant VERSION => '1.0';

# globals:
my @list1;  # entire list of left panel
my @list2;	# entire list of right panel

my  $g = MainWindow->new;
	$g->title("IP List Compare " . VERSION);  # title bar of main window
	$g->geometry("320x950"); # define window size (resizable later via mouse, w x h)

# setup some frames in the main window
# the main frame
my $mF		= $g->Frame(-background => "red")->pack(-side => 'top', -fill => 'x');
# Frame 1
my $f1		= $mF->Frame(-background => "grey")->pack(-side => 'left', -fill => 'y');
# Frame 2
my $f2		= $mF->Frame(-background => "grey")->pack(-side => 'right', -fill => 'y');

# Setup T1 Frame
my $inLabel1  	= $f1->Label(-text => "1. Paste List 1 and List 2")->pack(-side => "top");
my $input1		= $f1->Text(-background => 'white', -foreground => 'black', -height=> '65', -width=>'22')->pack(-side => "bottom");

# Setup T2 Frame and Command Button + Options
my $inLabel2    = $f2->Button(-text => "2. Compare IP Lists ",-command =>\&process;)->pack(-side=>"top");
my $input2		= $f2->Text(-background => 'white', -foreground => 'black', -height=> '65', -width=>'22')->pack(-side => "bottom");

# stop building TK widgets, the rest is subroutines
MainLoop;

# wrapped for easier maintenance
sub process {
	list1();
	list2();

	# todo: let user know what is missing/same or provide more detail
	compareLists();
}

sub list1 {

	my %data;
	my $found 	= 0;
	my $unique 	= 0;
	my $lines 	= 0;

	# get text block from input
	my $text = $input1->get('1.0','end');
	   $text =~ s/\"//g;

	# process the text field into an array of lines
	my @data = split /\n/,$text;

	# count how many elements are in raw data
	$lines = @data;

	while (<@data>) {
		# grabbing ip via regex is a recipe for disaster... I know, but this works for it's intended purpose and data set
		# if it's a cidr/xx | cidr-xx | xx.x.x.x
		# the /g allows us to keep finding them if they are on the same line for some reason
		# TODO: add the case for x.x.x.x-x.x.x.y to at least warn.
		if (m/([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}[\/-][0-9]{1,2}|[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})/g) {

			# it's easier to cut and paste when searching if we follow object name standards
			my $ip = $1;

			# I'm replacing the / with  a - to match my specific needs, yours probably won't need this
			$ip =~ s#\/#-#;

			# load the index of the hash
			$data{$ip} = 1;

			# count it as a found IP
			$found++;
		}
	}

	# keys are always unique in a hash,
	# print them out in the text box
	foreach my $u (sort keys %data) {

		# 1.2.3.4  if it's not in this format, I don't want it, even though
		# it could be a valid IP, I don't care - this is all we work with
		# $u must be longer than 6 characters
		if (length($u) > 6) {
			push @list1, $u;
		}
	}
}

sub list2 {

	my %data;
	my $found 	= 0;
	my $unique 	= 0;
	my $lines 	= 0;

	# get text block from input
	my $text = $input2->get('1.0','end');
	   $text =~ s/\"//g;

	# process the text field into an array of lines
	my @data = split /\n/,$text;

	# count how many elements are in raw data
	$lines = @data;

	while (<@data>) {
		# grabbing ip via regex is a recipe for disaster... I know, but this works for it's intended purpose and data set, so shut up.
		# if it's a cidr/xx | cidr-xx | xx.x.x.x
		# the /g allows us to keep finding them if they are on the same line for some reason
		# TODO: add the case for x.x.x.x-x.x.x.y to at least warn.
		if (m/([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}[\/-][0-9]{1,2}|[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})/g) {

			# it's easier to cut and paste when searching if we follow object name standards
			my $ip = $1;

			# so I'm replacing the / with  a -
			$ip =~ s#\/#-#;

			# load the index of the hash
			$data{$ip} = 1;

			# count it as a found IP
			$found++;
		}
	}

	# keys are always unique in a hash,
	# print them out in the text box
	foreach my $u (sort keys %data) {

		# 1.2.3.4  if it's not in this format, I don't want it, even though
		# it could be a valid IP, I don't care - this is all we work with
		# $u must be longer than 6 characters
		if (length($u) > 6) {
			push @list2, $u;
		}
	}
}

sub compareLists {
	use Array::Utils qw(:all);

	if ( !array_diff(@list1, @list2) ) {
		# tell user they are the same
		$g->messageBox(-message => "SAME", -type => "OK");
	} else {
		#http://my.safaribooksonline.com/book/programming/perl/1565922433/arrays/ch04-29725
		my %seen1 = (); 	# lookup table
		my @aonly = ();		# answer
		my %seen2 = (); 	# lookup table
		my @bonly = ();		# answer

		# build lookup table
		foreach my $item (@list2) { $seen1{$item} = 1 }

		# find only elements in @A and not in @B
		foreach my $item (@list1) {
			unless ($seen1{$item}) {
				# it's not in %seen, so add to @aonly
				push(@aonly, $item);
			}
		}

		# build lookup table
		foreach my $item (@list1) { $seen2{$item} = 1 }

		# find only elements in @A and not in @B
		foreach my $item (@list2) {
			unless ($seen2{$item}) {
				# it's not in %seen, so add to @aonly
				push(@bonly, $item);
			}
		}

		# clear the list for writing
		$input1->delete( '1.0', 'end');

		# show us all that are different
		my $count1 = @aonly;
		if ($count1) {
			$input1->insert( 'end', "ONLY in LIST1\n" );
			foreach my $item (@aonly) {	$input1->insert( 'end', "$item\n" );}
		}

		# clear the list for writing
		$input2->delete( '1.0', 'end');

		# show us all that are different
		my $count2 = @bonly;
		if ($count2) {
			$input2->insert( 'end', "ONLY in LIST2\n" );
			foreach my $item (@bonly) {	$input2->insert( 'end', "$item\n" );}
		}

		# tell user what is going on
		$g->messageBox(-message => "DIFFERENT!!", -type=> "OK");
	}

	# don't close the program, but instead, reset globals
	# we might have many combos to test
	@list1 = (); @list2 = ();

}