use Text::Parse::SQL;
- my $parser = new Text::Parse::SQL( { 'terminator' => ';', 'remove_block_comments' => 1, } );
+ my $parser = new Text::Parse::SQL( { 'terminator' => ';', 'sql_syntax' => 'Oracle', } );
my $statements = $parser->parse_file( 'create_db.sql' );
=cut
$Revision$
ENDE
$Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s;
-our $VERSION = "0.1." . $Revis;
+our $VERSION = "0.2." . $Revis;
=head1 PROPERTIES
Should block comments be removed? Sometime they are a valid
part of a SQL statement (e.g. Oracle hints).
-Per default they are not removed.
+Per default they were removed, but Oracle hints ( /*+ ... */ ) and MyQL server commands ( /*! ... */ )
+were not removed.
=cut
my %remove_block_comments_of : ATTR( :get<remove_block_comments> :set<remove_block_comments> );
+=head2 sql_syntax
+
+Describes the supported SQL-Syntax. Valid values are currently: 'SQLite', 'mysql' and 'Oracle'
+
+Default: 'mysql'
+
+=cut
+
+ my %sql_syntax_of : ATTR( :get<sql_syntax> );
+
=head2 quote_chars
All valid quoting characters.
-Per default: ' " and `
+Default: q('"`) if sql_syntax == 'mysql', else q('")
=cut
my %quote_chars_of : ATTR( :get<quote_chars> :set<quote_chars> );
+=head2 enable_backslash_escape
+
+Boolean, enables the escaping of quoting characters in quotet strings with backslash.
+
+Default: true, if sql_syntax == 'mysql', else false
+
+=cut
+
+ my %enable_backslash_escape_of : ATTR( :get<enable_backslash_escape> :set<enable_backslash_escape> );
+
+=head2 slash_as_terminator
+
+Boolean, an empty slash (/) in a single line is also used as a terminator.
+
+Default: true, if sql_syntax == 'Oracle', else false
+
+=cut
+
+ my %slash_as_terminator_of : ATTR( :get<slash_as_terminator> :set<slash_as_terminator> );
+
+ my %debug_of : ATTR( :get<debug> :set<debug> );
+
#----------------------------------------------------------------------------------------
+=head1 Readonly Variables
+
+=head2 $supported_syntaxes
+
+A hash reference with all valid supported SQL syntaxes
+
+=cut
+
+ Readonly::Scalar my $supported_syntaxes => {
+ 'mysql' => 'mysql',
+ 'oracle' => 'Oracle',
+ 'sqlite' => 'SQLite',
+ };
+
+ Readonly::Scalar my $regex_blockcomment => {
+ 'mysql' => q{/\*(?!!).*?\*/},
+ 'Oracle' => q{/\*(?!\+).*?\*/},
+ 'SQLite' => q{/\*.*?\*/},
+ };
+
+=head2 $sql_shell_commands
+
+A list of all supported commands for the SQL shelf itself ( sqlplus, mysql a.s.o. )
+
+These commands are terminated with newline, not with th normal terminater ';'. They
+are dependend from the sql_syntax.
+
+If such a command was found, it is given back as normal SQL statement. It's on
+the user of this module to decide, what happens with this statement.
+
+=cut
+
+ Readonly::Scalar my $sql_shell_commands => {
+ 'mysql' => [
+ '\?', 'clear', 'connect', 'delimiter', 'edit',
+ 'ego', 'exit', 'go', 'help', 'nopager',
+ 'notee', 'pager', 'print', 'prompt', 'quit',
+ 'rehash', 'source', 'status', 'system', 'tee',
+ 'use', 'charset', 'warnings', 'nowarning',
+ ],
+ 'Oracle' => [
+ '\@', '\@\@', 'accept', 'append', 'archive\s+log',
+ 'attribute', 'break', 'btitle', 'change', 'clear',
+ 'column', 'compute', 'connect', 'copy', 'define',
+ 'del', 'describe', 'disconnect', 'edit', 'execute',
+ 'exit', 'get', 'help', 'host', 'input',
+ 'list', 'password', 'pause', 'print', 'prompt',
+ 'quit', 'recover', 'remark', 'repfooter', 'repheader',
+ 'run', 'save', 'set', 'show', 'shutdown',
+ 'spool', 'start', 'startup', 'store', 'timing',
+ 'ttitle', 'undefine', 'variable', 'whenever\s+oserror', 'whenever\s+sqlerror',
+ ],
+ 'SQLite' => [
+ '\.backup', '\.bail', '\.databases', '\.dump', '\.echo',
+ '\.exit', '\.explain', '\.genfkey', '\.header', '\.headers',
+ '\.help', '\.import', '\.indices', '\.mode', '\.nullvalue',
+ '\.output', '\.prompt', '\.quit', '\.read', '\.restore',
+ '\.schema', '\.separator', '\.show', '\.tables', '\.timeout',
+ '\.timer', '\.width',
+ ],
+ };
+
+ #---------------------------------------------------------------------------
+
=head1 METHODS
Alls methods.
my ( $self, $ident, $args_ref ) = @_;
$terminator_of{$ident} = ';';
- $remove_block_comments_of{$ident} = 0;
+ $remove_block_comments_of{$ident} = 1;
+ $sql_syntax_of{$ident} = 'mysql';
$quote_chars_of{$ident} = '\'"`';
+ $enable_backslash_escape_of{$ident} = 1;
+ $slash_as_terminator_of{$ident} = 0;
+ $debug_of{$ident} = 0;
return 1;
$terminator_of{$ident} = $args_ref->{'terminator'} if $args_ref->{'terminator'};
$remove_block_comments_of{$ident} = $args_ref->{'remove_block_comments'} if exists $args_ref->{'remove_block_comments'};
+ $debug_of{$ident} = $args_ref->{'debug'} if exists $args_ref->{'debug'};
+
+ $self->set_sql_syntax( $args_ref->{'sql_syntax'} ) if $args_ref->{'sql_syntax'};
+
+ my $syntax = $self->get_sql_syntax();
+
+ # default values dependend on the sql syntax
+ $quote_chars_of{$ident} = $syntax eq 'mysql' ? '\'"`' : '\'"';
+ $enable_backslash_escape_of{$ident} = $syntax eq 'mysql' ? 1 : 0;
+ $slash_as_terminator_of{$ident} = $syntax eq 'Oracle' ? 1 : 0;
+
$quote_chars_of{$ident} = $args_ref->{'quote_chars'} if $args_ref->{'quote_chars'};
+ $enable_backslash_escape_of{$ident} = $args_ref->{'enable_backslash_escape'} if exists $args_ref->{'enable_backslash_escape'};
+ $slash_as_terminator_of{$ident} = $args_ref->{'slash_as_terminator'} if exists $args_ref->{'slash_as_terminator'};
}
}
+ #----------------------------------------------------------------------------------------
+
+=head2 set_sql_syntax( $new_syntax )
+
+Setter function for the property sql_syntax.
+
+=cut
+
+ sub set_sql_syntax {
+
+ my $self = shift;
+ my $new_syntax = shift;
+ my $ident = $self->ident();
+
+ croak( "Invalid call of set_sql_syntax()." ) unless defined $new_syntax;
+ croak( "Invalid parameter in call of set_sql_syntax()." ) unless _STRING($new_syntax);
+
+ my $syntax = $supported_syntaxes->{ lc($new_syntax) };
+ croak( sprintf( "Unsupported syntax '%' in call of set_sql_syntax().", $new_syntax ) ) unless $syntax;
+
+ $sql_syntax_of{$ident} = $syntax;
+ return $syntax;
+
+ }
+
+ #----------------------------------------------------------------------------------------
+
+=head2 get_sql_shell_commands( [$syntax] )
+
+Gives back as an array reference a list of all SQL shell commands of the current SQL syntax.
+
+If the optional parameter $syntax is given, then the shell commands of this syntax are given back.
+
+=cut
+
+ sub get_sql_shell_commands {
+
+ my $self = shift;
+ my $given_syntax = shift;
+
+ my $syntax = $self->get_sql_syntax();
+ if ( $given_syntax ) {
+ $given_syntax = $supported_syntaxes->{ lc($given_syntax) };
+ return [] unless $given_syntax;
+ $syntax = $given_syntax;
+ }
+ return $sql_shell_commands->{$syntax};
+
+ }
+
+ #----------------------------------------------------------------------------------------
+
+=head2 get_regex_blockcomment( [$syntax] )
+
+Gives back analogue get_sql_shell_commands a regex to match a block comment
+in a SQL text.
+
+If the optional parameter $syntax is given, then the regex of this syntax are given back.
+
+=cut
+
+ sub get_regex_blockcomment {
+
+ my $self = shift;
+ my $given_syntax = shift;
+
+ my $syntax = $self->get_sql_syntax();
+ if ( $given_syntax ) {
+ $given_syntax = $supported_syntaxes->{ lc($given_syntax) };
+ return [] unless $given_syntax;
+ $syntax = $given_syntax;
+ }
+ return $regex_blockcomment->{$syntax};
+
+ }
+
+
+
}
#----------------------------------------------------------------------------------------
my $terminator = quotemeta($self->get_terminator());
my $quote_chars = $self->get_quote_chars();
my $cur_quote_char = undef;
+ my $syntax = $self->get_sql_syntax();
+ my $re = undef;
+ my $re_subst = undef;
+ my $debug = $self->get_debug();
+ my $cmd_arr = $self->get_sql_shell_commands();
my @QChars = map { quotemeta($_) } split( //, $quote_chars );
$data .= "\n" unless $data =~ /\n$/;
- while ( $data ) {
+ MAIN_LOOP: while ( $data ) {
- #print $data;
+ sleep 1 if $debug;
- #sleep 1;
+ warn "-------------------------------------------\n" if $debug;
+ warn $data if $debug;
# first remove comments of type '-- ...'
if ( $data =~ /^\s*--(?:\s[^\n]*)?\n/ ) {
- #print "Remove comments ...\n";
+ warn "Remove comments -- ...\n" if $debug;
$data =~ s/^\s*--(?:\s[^\n]*)?\n//;
next;
}
+ # remove comments of type '# ...', if SQL syntax is 'mysql'
+ if ( $syntax eq 'mysql' ) {
+ if ( $data =~ /^\s*#(?:\s[^\n]*)?\n/ ) {
+ warn "Remove comments # ...\n" if $debug;
+ $data =~ s/^\s*#(?:\s[^\n]*)?\n//;
+ next
+ }
+ }
+
# remove heading whitespaces before the first statement
if ( $data =~ /^\s+/ and not $cur_sql ) {
- #print "Remove heading whitespaces ...\n";
+ warn "Remove heading whitespaces ...\n" if $debug;
$data =~ s/^\s+//;
next;
}
- # Remove block comments, if necessary
- if ( $self->get_remove_block_comments() and $data =~ m|/\*.*?\*/|s ) {
- $data =~ s|/\*.*?\*/||s;
+ # Remove block comments (not in quotings), if necessary
+ $re = q{^([^} . quotemeta($quote_chars) . q{]*)} . $self->get_regex_blockcomment();
+ if ( $self->get_remove_block_comments() and $data =~ /$re/s ) {
+ warn "Remove block comments, regex: '" . $re . "': ...\n" if $debug;
+ $data =~ s/$re/$1/s;
next;
}
+ # Extract one line shell commands as a SQL statement
+ CMD_LOOP: for my $cmd ( @$cmd_arr ) {
+ $re = '^(' . $cmd . '[^\n]*)\n';
+ my $found = undef;
+ if ( $data =~ /$re/i ) {
+ warn "Extract SQL shell command, regex: '" . $re . "': ...\n" if $debug;
+ $data =~ s/$re//i;
+ my $extract = $1;
+ warn "Extract: '" . $extract . "'\n" if $debug;
+ if ( $extract =~ /--[^\n]*$/sm ) {
+ warn "Removing comments -- from extract...\n" if $debug;
+ $extract =~ s/--[^\n]*$//smg;
+ }
+ if ( $syntax eq 'mysql' ) {
+ if ( $extract =~ /#[^\n]*$/sm ) {
+ warn "Removing comments # from extract...\n" if $debug;
+ $extract =~ s/#[^\n]*$//smg;
+ }
+ }
+ $extract =~ s/\s*$terminator\s*$//;
+ $cur_sql .= $extract;
+ if ( $cur_sql ) {
+ $cur_sql =~ s/^\s+//;
+ $cur_sql =~ s/\s+$//;
+ push @$result, $cur_sql if $cur_sql;
+ }
+ $cur_sql = '';
+ $found = 1;
+ next MAIN_LOOP;
+ }
+ next if $found;
+ }
+
# move all characters except terminators and quoting characters
# to the current sql statement
- if ( $data =~ /^[^$terminator$quote_chars]+/ ) {
- #print "Move characters except terminators and quoting characters ...\n";
- $data =~ s/^([^$terminator$quote_chars]+)//;
- $cur_sql .= $1;
+ $re = qq{[^$terminator} . quotemeta($quote_chars) . q{]+};
+ if ( $self->get_slash_as_terminator() ) {
+ $re = qq{(?:[^$terminator} . quotemeta($quote_chars) . qq{\\/]+|(?<!\\n)\\/(?![ \\t]*\\n))+};
+ }
+ #warn "Move characters except terminators and quoting characters, regex: '^" . $re . "', ...\n" if $debug;
+ if ( $data =~ /^$re/ ) {
+ warn "Move characters except terminators and quoting characters, regex: '^" . $re . "', ...\n" if $debug;
+ $data =~ s/^($re)//;
+ my $extract = $1;
+ if ( $extract =~ /--[^\n]*\n/sm ) {
+ warn "Removing comments -- from extract...\n" if $debug;
+ $extract =~ s/--[^\n]*\n/\n/smg;
+ }
+ if ( $syntax eq 'mysql' ) {
+ if ( $extract =~ /#[^\n]*\n/sm ) {
+ warn "Removing comments # from extract...\n" if $debug;
+ $extract =~ s/#[^\n]*\n/\n/smg;
+ }
+ }
+ $cur_sql .= $extract;
next;
}
# remove terminator, start a new statement, save the old statement
if ( $data =~ /^\s*[$terminator]\s*/ ) {
- #print "Remove terminator ...\n";
+ warn "Remove terminator ...\n" if $debug;
$data =~ s/^\s*[$terminator]\s*//;
if ( $cur_sql ) {
$cur_sql =~ s/^\s+//;
next;
}
+ # use "\n\s*/\s*\n" as a terminator ( like SQL*Plus from Oracle )
+ if ( $self->get_slash_as_terminator() ) {
+ $re = '^\\/[ \\t]*\\n';
+ warn "Try Remove slash (/) as a terminator, regex: '" . $re . "', ...\n" if $debug;
+ if ( $data =~ /$re/ ) {
+ warn "Remove slash (/) as a terminator, regex: '" . $re . "' ...\n" if $debug;
+ $data =~ s/$re//;
+ if ( $cur_sql ) {
+ $cur_sql =~ s/^\s+//;
+ $cur_sql =~ s/\s+$//;
+ push @$result, $cur_sql if $cur_sql;
+ }
+ $cur_sql = '';
+ next;
+ }
+ }
+
# move quotet text to the current sql statement
for my $c (@QChars) {
- if ( $data =~ /^$c[^$c]*$c/ ) {
- #print "Move quotet text ...\n";
- $data =~ s/^($c[^$c]*$c)//;
+ $re = $self->get_enable_backslash_escape() ? $c . '(?:[^' . $c . ']|\\' . $c . ')*(?<!\\\\)' . $c : $c . '[^' . $c . ']*' . $c;
+ if ( $data =~ /^$re/ ) {
+ warn "Move quotet text, regex: '" . $re . "' ...\n" if $debug;
+ $data =~ s/^($re)//;
$cur_sql .= $1;
next;
}
projects / my-stuff / sql-parse.git / commitdiff