It is not complete (probably list of keywords in @keywords does not exhaust all possibilities, but it is enough to rebuild it with new entries).
Data::Dumper module is not a must - it is used only for debugging purposes and can be removed.
Lately I have got a question what licensing I would apply to this script and here some rules:
- the script is free of charge
- I would like to be still presented as an author ;-)
- one can not distribute and charge for it (which does not mean it can not be added as a kind of "free" bonus to something commercial, but it must be stated so somewhere)
- one may modify the script along to the needs - it would be nice to return changes to me assuming they have a general character (so are not bound to some local environment)
The script in more edible form
#!/usr/bin/perl -w
## ----------------------------------------------------------------
## $Id: ora_tns_parser.pl,v 1.2 2012/11/22 23:16:00 rems Exp $
## @action: parses *.ora files
## $Author: Remigiusz Sokolowski <rems@wp.pl> $
## $Date: 2007/10/15 10:50:15 $
## $Revision: 1.2 $
##
## Opis
## $Log: ora_tns_parser.pl,v $
## Revision 1.1 2007/10/15 10:50:15 rems
## tool for parsing *.ora files (mainly tnsnames or listener)
##
## parses provided *.ora file and returns pairs in the form
## key:value
## ALL - default; all pairs
## CUSTOM - alias/listener pairs (i.e. no parameters)
## LISTENERS_AND_PASSWORDS - pairs listener:encoded password (relevant only for listener.ora)
## NAMES - only keys - alias/listener names
##
## Usage
## ===================
## ./ora_tns_parser.pl <format> <path>
##
## Revision 1.2 2012/11/22 23:16:00 rems
## fix for bugged behavior when specific *.ora format in use (one line entry)
## not tested yet completely
## ----------------------------------------------------------------
## arguments
my $fmt = shift;
my $fname = shift;
## modules and constant variables
my %formats = (
'ALL' => 1, #default
'CUSTOM' => 1,
'LISTENERS_AND_PASSWORDS' => 1,
'NAMES' => 1
);
my @keywords = (
'INBOUND_CONNECT_TIMEOUT',
'LOG_DIRECTORY',
'LOG_FILE',
'LOGGING',
'PASSWORDS',
'SAVE_CONFIG_ON_STOP',
'SID_LIST',
'TRACE_DIRECTORY',
'TRACE_FILE',
'TRACE_LEVEL'
);
use strict;
use warnings;
use Data::Dumper;
## functions
sub trim {
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}
## counting instances of the provided x char in string tval
sub _count_chars {
my $x = shift;
my $tval = shift;
my @chars = split(//, $tval);
my $ch;
my $counter = 0;
foreach $ch (@chars) {
if ($ch eq $x) {
$counter++;
}
}
return $counter;
}
## whole algorithm depends on counting brackets
sub parse_tns_addr {
my $lines = shift;
my $i = shift;
my $tval = shift;
my $level = shift;
my $numL = _count_chars('(', $lines->[$i]);
my $numP = _count_chars(')', $lines->[$i]);
$level = $level + $numL - $numP;
if ($level <= 0) {
return ($i, $tval, 0);
} else {
$tval = $tval . trim($lines->[++$i]);
($i, $tval) = parse_tns_addr($lines, $i, $tval, $level);
}
}
## execution
my @lines;
my $line;
open(FH, "< $fname");
while (<FH>) {
chomp;
$line = trim($_);
if ($line !~ m/^#/ && $line !~ m/^\s*$/) {
push(@lines, $_);
}
}
close FH;
my $i=0;
my $pname = '';
my $pval = '';
my %params;
my @tmp;
my $trimmed = '';
for ($i=0; $i<@lines; $i++) {
## if sign '=' is not in line, it must be in the next one
if ($lines[$i] !~ m/=/) {
$lines[$i+1] = $lines[$i].$lines[$i+1];
$i++;
}
if ($lines[$i] =~ m/=/) {
## if in line there is '=', we split at first equality sign
if ((my $pos = index($lines[$i], "=")) >= 0) {
$tmp[0] = substr($lines[$i], 0, $pos);
$tmp[1] = substr($lines[$i], $pos+1);
} else {
$tmp[0] = $lines[$i];
}
$pname = trim($tmp[0]);
$trimmed = defined $tmp[1] ? trim($tmp[1]) : undef;
## if first char is '(', complex entry
if (@tmp>1 && substr($trimmed,0,1) eq '(') {
($i, $pval) = parse_tns_addr(\@lines, $i, $trimmed, 0);
## if not and entry has some not empty value, simple entry
} elsif (@tmp>1 && $trimmed ne '') {
$pval = $trimmed;
## it is possible, that value is in next line/s
} else {
$i++;
$trimmed = trim($lines[$i]);
if (substr($trimmed,0,1) ne '(') {
$pval = $trimmed;
} else {
my $level;
($i, $pval) = parse_tns_addr(\@lines, $i, $trimmed, 0);
}
}
$params{$pname} = $pval;
} else {
## if not, and we have no empty lines, probably wrong syntax in file
die "probably wrong syntax at line $i!"
}
@tmp = ();
$pname = '';
$pval = '';
}
## for debugging purposes
#print "++++++++++++++++++++++++++\n";
#print Dumper(%params);
#print "++++++++++++++++++++++++++\n";
## we parse our list to throw away not needed entries
my $keyword;
## trimming output according to format
my $flg_del = 0;
if (defined $formats{$fmt} && $fmt ne 'ALL') {
foreach $pname (keys %params) {
foreach $keyword (@keywords) {
if (substr($pname, 0, length $keyword) eq $keyword) {
$flg_del = 1;
if ($fmt eq 'LISTENERS_AND_PASSWORDS' && $keyword eq 'PASSWORDS') {
$params{substr($pname, 1 + length 'PASSWORDS')} = $params{$pname};
}
}
}
if ($flg_del == 1) {
delete($params{$pname});
$flg_del = 0;
} elsif ($fmt eq 'LISTENERS_AND_PASSWORDS' && substr($params{$pname}, 0, 1) eq '(') {
## a little ugly hack, assuming that entries without keywords
## with values starting with "(" are certainly custom names
## i.e. listener names
$params{$pname} = '';
}
}
}
## output
my $format = (defined $formats{$fmt} && $fmt eq 'NAMES') ? "%s\n" : "%s:%s\n";
foreach $pname (keys %params) {
printf $format, $pname, $params{$pname};
}
