#! /usr/bin/perl -w
use strict ;
use warnings ;
use diagnostics ;
use Data::Dumper ;
$|++ ;
my $sql_query = q(
/**/
SELECT
/**/ ASSET_ID /**/ ,
/**/ ASSET_DESC /**/ ,
/**/ ASSET_COST /**/
FROM
/**/
SYNERGEN.SA_ASSET@/**/SGENQA/**/
/**/,
/**/
SYNERGEN.SA_WORK_ORDER@/**/SGENTEST/**/
/**/
WHERE
/**/ ASSET_ID IS NOT NULL /**/ AND
/**/ ASSET_DESC IS NOT NULL /**/ AND
/**/ ASSET_COST > 100 /**/
/**/
) ;
my @type_list = qw( FIELD DATABASE CONDITION FULL_TBL QUERY ) ;
foreach my $type ( @type_list )
{
my @list = &get_match_list( $type, $sql_query ) ;
print Dumper( \@list ), "\n" ;
}
exit( 0 ) ;
#----- F U N C T I O N S ----------------------------------------
sub start_tag
{
my $tag = shift ;
my $start = "\\/\\*\\s*<$tag>\\s*\\*\\/" ;
return $start ;
}
sub end_tag
{
my $tag = shift ;
my $end = "\\/\\*\\s*<\\/$tag>\\s*\\*\\/" ;
return $end ;
}
sub get_match_list
{
my ( $tag, $text ) = @_ ;
my @match_list = () ;
# create the start & end tags
my ( $start, $end ) = ( &start_tag( $tag ), &end_tag( $tag ) ) ;
# as long as you're finding tag pairs...
while ( $text =~ m/$start\s*(.*?)\s*$end/gi )
{
my $new_match = $1 ;
# strip out any comments, and replace spaces on either end
# with a single space (leaving line breaks alone)
my $spc = $new_match =~ /[ \t]+\/\*.*?\*\/|\/\*.*?\*\/[ \t]+/
? ' '
: '' ;
$new_match =~ s/[ \t]*\/\*(.*?)\*\/[ \t]*/$spc/g ;
# Strip any whitespace off the ends
$new_match =~ s/^\s*(.*?)\s*$/$1/ ;
push( @match_list, $new_match ) ;
}
return @match_list ;
}
####
$VAR1 = [
'ASSET_ID',
'ASSET_DESC',
'ASSET_COST'
];
$VAR1 = [
'SGENQA',
'SGENTEST'
];
$VAR1 = [
'ASSET_ID IS NOT NULL',
'ASSET_DESC IS NOT NULL',
'ASSET_COST > 100'
];
$VAR1 = [
'SYNERGEN.SA_ASSET@SGENQA',
'SYNERGEN.SA_WORK_ORDER@SGENTEST'
];
$VAR1 = [];