# include in perl scripts for RCS use

=pod

	$Author: jkstill $
	$Date: 2010/04/30 18:09:53 $
	$Revision: 1.3 $
	$Source: /home/jkstill/oracle/dba/tns_parser/RCS/TNSParser.pm,v $
   $Id: TNSParser.pm,v 1.3 2010/04/30 18:09:53 jkstill Exp $
   $Log: TNSParser.pm,v $
   Revision 1.3  2010/04/30 18:09:53  jkstill
   added RCS docs


=cut

=head1 TNSParser.pm - Parse host and connect info from tnsnames.ora

Pass a tnsnames.ora file to the new constructor

  use lib qw(./); # if TNSParser is in current directory

  use TNSParser;
  my $tnsfile=shift;
  my $tnsdata  = new TNSParser($tnsfile);

=cut

package TNSParser;

use Data::Dumper;
our $debug = 0;

# flatten out tnsnames.ora to one line per entry
sub _getRawTNS {
	my ($tnsFile) = @_;

	-r $tnsFile || die "cannot read $tnsFile - $!\n";
	open TNS, $tnsFile || die "cannot open $tnsFile - $1\n";
	my @rawtns;

	my $tnsLines;
	my $leftCount=0;
	my $rightCount=0;

	while(<TNS>) {
		chomp;
		# skip comments
		next if /^#/;
		# remove all spaces
		s/\s+//g;
		#skip blank lines
		next if /^$/;

		# trim trailing comments
		s/^(.+)(#.*)$/$1/;

		my $line=lc($_);

		foreach my $c ( split('',$line)) {
			#print "$c\n";
			if ($c eq '(') {$leftCount++}
			if ($c eq ')') {$rightCount++}
			$tnsLine .= $c;
		}

		#print '=' x 50, "\n";
		#print "leftcount: $leftCount\n";
		#print "rightcount: $rightCount\n";

		if ( ($leftCount > 0) && ($leftCount == $rightCount) ) {
			push @{$tnsLines},$tnsLine;
			$tnsLine='';
			$leftCount=0;
			$rightCount=0;
		}

	}

	return $tnsLines;
}

sub _parseTNS {

my ($tnsLines) = @_;
	my $searchStr = q{(connect_data=(};
	my $reverseSearchStr = scalar reverse $searchStr;
	my $revSearchLen = length($reverseSearchStr);

	print "rev: $reverseSearchStr\n" if $debug;

	foreach my $tnsLine ( @{$tnsLines} ) {

		print '=' x 50, "\n" if $debug;

		my $addresses=();
		my $addressData=();
		my %connectData=();
		my @tnsNames=split(',',substr($tnsLine,0,index(($tnsLine,'='))));
		print "ALIASES: ", join (' - ',@tnsNames),"\n" if $debug;

		# get connect_data
		# there may be multiple 'connect_data' sections in the tns entry
		# we are using only the last one
		# need to verify that with Oracle Net Manual
		my $reverseTnsLine = scalar reverse $tnsLine;
		#print "TNSLINE: $tnsLine\n";
		my $rawConnectStr = scalar reverse substr($reverseTnsLine,0,index($reverseTnsLine,$reverseSearchStr)+$revSearchLen);

		my $leftCount=0;
		my $rightCount=0;
		my $connectStr;
		foreach my $c ( split('',$rawConnectStr)) {
			if ($c eq '(') {$leftCount++}
			if ($c eq ')') {$rightCount++}
			$connectStr .= $c;
			if ( ($leftCount > 0) && ($leftCount == $rightCount) ) {
				last;
			}
		}

		# skip if invalid format
		next unless $connectStr =~ /^\(connect_data=/;

		# strip beginning and end of 'connect_data' and ()
		# then split on literal )(
		$connectStr =~ s/^\(connect_data=\((.+?)\)+$/$1/;
		print "CONNECT_DATA: $connectStr\n" if $debug;
		foreach my $pair (split(/\)\(/,$connectStr)) {
			my ($key,$value) = split(/=/,$pair);
			$connectData{$key} = $value;
		}

		print "CONNECT DATA: ", Dumper(\%connectData) if $debug;

		# get address lists
		$searchStr = '(address=';
		my $addrPos = index($tnsLine,$searchStr);
		$leftCount=0;
		$rightCount=0;
		my $rawAddressStr = substr($tnsLine,$addrPos);

		while ($addrPos != -1) {
			#print "RAW ADDRESS STR: $rawAddressStr\n";
			#print "addrPos: $addrPos\n";

			my $chrPos=0;
			foreach my $c ( split('',$rawAddressStr)) {
				if ($c eq '(') {$leftCount++}
				if ($c eq ')') {$rightCount++}
				$connectStr .= $c;
				if ( ($leftCount > 0) && ($leftCount == $rightCount) ) {
					$leftCount=0;
					$rightCount=0;
					last;
				} else { $chrPos++ }
			}
	
			my $address=substr($rawAddressStr,0,$chrPos+1);
			if ( ($chrPos+1) < length($rawAddressStr) ) {
				$rawAddressStr = substr($rawAddressStr,$chrPos+1);
				$addrPos = index($rawAddressStr,$searchStr);
				$rawAddressStr = substr($rawAddressStr,$addrPos);
			} else { $addrPos = -1 }

			# strip beginning and end of 'connect_data' and ()
			# then split on literal )(
			$address =~ s/^\(address=\((.+?)\)+$/$1/;
			print "ADDRESS: $address\n" if $debug;
			$addressData=();
			foreach my $pair (split(/\)\(/,$address)) {
				my ($key,$value) = split(/=/,$pair);
				$addressData->{$key} = $value;
			}

			print "ADDRESS DATA: ", Dumper($addressData) if $debug;
			push @{$addresses}, $addressData;

		}

		print "ADDRESSES DUMPER: ", Dumper($addresses) if $debug;

		foreach my $alias ( @tnsNames ) {
			$TNSDATA{$alias}->{connect}=\%connectData;
			$TNSDATA{$alias}->{addresses}=$addresses;
		}
	}
}

sub new {

	my ($pkg) = shift;
	my $class = ref($pkg) || $pkg;

	my $self={};
	my ($tnsFile) = @_;

	my $tnsLines = _getRawTNS($tnsFile);
	my $TNSDATA= _parseTNS($tnsLines);


	$self->{TNSDATA} = \%TNSDATA;
	bless $self, $class;
	return $self;

}

=head2 next method

use the next method to walk through the data

  while ( my $tns = $tnsdata->next  ) {
    print Dumper($tns);
  }

each entry is returned as a hash ref with the tnsname as the only 
top level key

  'sample1' => {
    'addresses' => [
        {
          'protocol' => 'tcp',
          'port' => '1630',
          'host' => 'host1'
        },
        {
          'protocol' => 'tcp',
          'port' => '1630',
          'host' => 'host2'
        },
	  ],
     'connect' => {
          'service_name' => 'sales.us.acme.com'
      }
   }


=cut

{
	local $lastKey=0;
	local @keys=();

	sub next {
		my $self = shift;
		if ( $lastKey ) { 
			print "LAST KEY\n" if $debug;
			return undef ;
		} else {
			@keys = keys %{$self->{TNSDATA}} unless @keys;
			print join(' - ', @keys),"\n" if $debug;
			my $tnsName = pop @keys;
			my $hash;
			$hash->{$tnsName} = $self->{TNSDATA}{$tnsName};
			$lastKey = 1 unless @keys;
			return $hash;
		}
	}
}

=head2 getTnsname method

use the getTnsname method to get an individual tns entry
returns undef if it does not exist

  foreach my $testTNS ( qw( orcl testfail ) ) {
     my $tnsConnectInfo = $tnsdata->getTnsname($testTNS);
     print Dumper($tnsConnectInfo) if defined $tnsConnectInfo->{$testTNS};
  }  

data is returned as a hash ref, without the tnsname as a key

	{
    'addresses' => [
        {
          'protocol' => 'tcp',
          'port' => '1630',
          'host' => 'host1'
        },
        {
          'protocol' => 'tcp',
          'port' => '1630',
          'host' => 'host2'
        },
	  ],
     'connect' => {
          'service_name' => 'sales.us.acme.com'
      }
	}


=cut

sub getTnsname {
		my $self = shift;
		my $name2chk = shift;
		print "name2chk: $name2chk\n" if $debug;
		my $hash;
		#$hash->{$name2chk} = $self->{TNSDATA}{$name2chk};
		$hash = $self->{TNSDATA}{$name2chk};
		return $hash;
}


1;