Script for parsing *.ora files

The script below is able to parse *.ora files - mainly tnsnames.ora or listener.ora, though it should properly deal with other files with this Oracle syntax (complex values build by nested brackets, simple ones as pairs of key and value).

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};
}