#!/usr/bin/perl
#
# tnsnames.pl -- reads tnsnames.ora, sorts by host name
#
#  jw - May 2005

use warnings;
use strict;

my $host;
my $name;
my %tns;
my @sortKeys;
my $key;
my $val;
my $para;
my $matchNbr;

$/ = '';

# problem: tns entries with no line break are not distiquished

my $tnsEntry = << 'EOF';
    ^
    \s*\w+\s*=\s*
    \s+\(DESCRIPTION\s*=
    \s+\(ADDRESS_LIST\s*=\s*
    \s+\(ADDRESS\s*=\s*\(PROTOCOL\s*=\s*TCP\)\(HOST\s*=\s*(\w+)\)\(PORT\s*=\s*\d+\)\)
    \s+\)\s*
    \s+\(CONNECT_DATA\s*=\s*
    \s+\(SERVER\s*=\s*\w+\)
    \s+\(SERVICE_NAME\s*=\s*(\w+)\)
 #   \s+\)\s*
 #   \s+\)
    $
EOF

die "ORACLE_HOME is not defined!\n" unless (defined($ENV{ORACLE_HOME} ));

my $tnsFile = "./tnsnames.ora";

open(F, "< $tnsFile") or die "Could not open file $tnsFile: $!\n";

while (chomp($para = <F>)) {

    undef($host);
    undef($name);

    if ($para =~ m[$tnsEntry]msxo) {
        $matchNbr++;
        print "-"x80, "\n";
        print "*** match #$matchNbr : $para\n";
        $host = $1;
        $name = $2;
        print "*** RESULT : host= $host, service= $name\n";

        if ((defined($host)) && (defined($name))) {
            $tns{$host} = $name;
        }
    }

    last if eof(F);
}

close(F);

@sortKeys = sort keys(%tns);

foreach (@sortKeys) {
    printf "%-8s = $tns{$_}\n", $_;
}