I have written a TNSNAMES.ORA parser using Parse::Recdescent. It works mostly but I have encountered a couple of problems with it. I am hoping that once it is complete, others will find the script useful.

Here is the source code

#!/usr/bin/perl

use Parse::RecDescent;
my $debug = 0;

$::RD_HINT = 1;
$::RD_WARN = 1;
$::RD_TRACE = 1 if $debug;

my $tnsGrammar = q{

startrule : Comment | SkipLine | TNSEntry

Comment  : /\#.*$/ 
SkipLine : /^(\s*)$/

TNSEntry : NetServiceName '=' Description
TNSEntry : NetServiceName '=' DescriptionList

DescriptionList : '(' /description_list/i '=' Description(s) Failover(
+?) LoadBalance(?) SourceRoute(?) ')'
Description :     '(' /description/i      '=' AddressList ConnectData(
+?) Failover(?) LoadBalance(?) SourceRoute(?) TypeService(?) HS(?) ')'
Description :     '(' /description/i      '=' Address     ConnectData(
+?) Failover(?) LoadBalance(?) SessionData(?) TransData(?) TypeService
+(?) HS(?) ')'


# Various Types of Addresses
AddressList : '(' /address_list/i '=' Address(s) Failover(?) LoadBalan
+ce(?) SourceRoute(?) ')'
Address : '(' /address/i '=' AddressTCP ')'
Address : '(' /address/i '=' AddressIPC ')'
Address : '(' /address/i '=' AddressSPX ')'
Address : '(' /address/i '=' AddressPipe ')'

# TCP Protocol
AddressTCP : Community(?) ProtocolTCP Host Port

Community  : '(' /community/i '=' DomainName(?) ')'
Host       : '(' /host/i      '=' Hostname ')'
Hostname   : DomainName | IP
IP         : /[0-9]+.[0-9]+.[0-9]+.[0-9]/
Port       : '(' /port/i      '=' /\d+/ ')'

# IPC Protocol
AddressIPC : ProtocolIPC Key
Key        : '(' /key/i '=' /\w+/ ')'

# SPX Protocol
AddressSPX : ProtocolSPX Service
Service    : '(' /service/i '=' /\w+/ ')'

# Pipe Protocol
AddressPipe : ProtocolPipe Server Pipe
Server      :  '(' /service/i  '=' /\w+/ ')'
Pipe        :  '(' /pipe/i     '=' /\w+/ ')'

ProtocolTCP  : '(' /protocol/i '=' /tcp/i ')'
ProtocolIPC  : '(' /protocol/i '=' /ipc/i ')'
ProtocolSPX  : '(' /protocol/i '=' /spx/i ')'
ProtocolPipe : '(' /protocol/i '=' /pipe/i ')'

# Connect Data Information
ConnectData:    '(' /connect_data/i '=' SID(?) Serve(?) FailoverMode(?
+) GlobalDBName(?) HS(?) InstanceName(?) RDBDatabase(?) ServiceName(?)
+ Presentation(?) ')'
ConnectData:    '(' /connect_data/i '=' SID(?) ServiceName(?) Serve(?)
+ FailoverMode(?) GlobalDBName(?) HS(?) InstanceName(?) RDBDatabase(?)
+ Presentation(?) ')'
ConnectData:    '(' /connect_data/i '=' FailoverMode(?) GlobalDBName(?
+) HS(?) InstanceName(?) RDBDatabase(?) Serve(?) ServiceName(?) SID(?)
+ Presentation(?) ')'

FailoverMode:   Backup(?) Type Method Retries(?) Delay(?)
Backup:         '(' /backup/i  '=' /\w+/ ')'
Type:           '(' /type/i    '=' /session|select|none/i ')'
Method:         '(' /method/i  '=' /basic|preconnect/i ')'
Retries:        '(' /retries/i '=' /\d+/ ')'
Delay:          '(' /delay/i   '=' /\d+/ ')'

GlobalDBName:   '(' /global_name/i   '=' Hostname ')'
HS:             '(' /hs/i            '=' /(ok)*/i ')'
InstanceName:   '(' /instance_name/i '=' /\w+/ ')'
RDBDatabase:    '(' /rdb_database/i  '=' /\w+/ ')'
Serve:          '(' /server/i        '=' /dedicated|shared/i ')'
ServiceName:    '(' /service_name/i  '=' Hostname ')'
SID:            '(' /sid/i           '=' /[a-z0-9\-\_]+/i ')'
Presentation:   '(' /presentation/i  '=' /\w+/ ')'

Failover:       '(' /failover/i     '=' /on|off|yes|no|true|false/i ')
+'
LoadBalance:    '(' /load_balance/i '=' /on|off|yes|no|true|false/i ')
+'
SourceRoute:    '(' /source_route/i '=' /on|off|yes|no/i ')'

SessionData:    '(' /sdu/i '=' /\d+/ ')'
TransData:      '(' /tdu/i '=' /\d+/ ')'
TypeService:    '(' /type_of_service/i '=' /rdb_database|oracle8_datab
+ase/i ')'

NetServiceName: DomainName
DomainName:     /([a-z0-9\_\-.]+)/i

};

my $tnsParser = Parse::RecDescent->new( $tnsGrammar );

my $entry = "";
my $lineCount = 0;
my $startLine = 1;
while (my $inputLine = <>)
{
  $lineCount++;
  next if ($inputLine =~ /^#.*$/);
  next if ($inputLine =~ /^\s*$/);
  
  if (($inputLine =~ /^[a-z0-9]/i) and ($entry ne ""))
  {
    testEntry( $entry );
    $entry = "";    
    $startLine = $lineCount;
  }
  
  $entry .= $inputLine;
      
}
testEntry( $entry) if ($entry ne "");


sub testEntry
{
  my $entry = shift;
  
  if (! $tnsParser->startrule( $entry ))
  {
    print "Invalid Entry on Lines [ $startLine - $lineCount ]\n" if ! 
+$debug;
    print "$entry\n";    
  }
}

[download]

I have found two problems which I am not sure how to handle.

Thanks for any help.

In reply to TNSNAMES.ORA and Recdescent by jmr4096

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.