Modul Text::Parse::SQL erstmal abgeschlossen

git-svn-id: http://svn.brehm-online.com/svn/my-stuff/sql-parse/trunk@33 ec8d2aa5-1599-4edb-8739-2b3a1bc399aa

diff --git a/lib/Text/Parse/SQL.pm b/lib/Text/Parse/SQL.pm
index d9253292125365d2ccefc38f8a0cac57f82a91cd..7f2d8120e04aadf6412706ad470814ab59214483 100644 (file)
--- a/lib/Text/Parse/SQL.pm
+++ b/lib/Text/Parse/SQL.pm
@@ -31,10 +31,10 @@ use 5.8.0;
 use strict;
 use warnings;
 
-use Carp qw( cluck croak confess);
+use Carp qw( carp cluck croak confess);
 use Class::Std;
 use Readonly;
-use Params::Util qw( _SCALAR _STRING );
+use Params::Util qw( _SCALAR _STRING _HANDLE );
 
 my $Revis = <<'ENDE';
     $Revision$
@@ -161,7 +161,7 @@ sub parse {
        my $result = [];
 
        my $cur_sql = '';
-       my $terminator = $self->get_terminator();
+       my $terminator = quotemeta($self->get_terminator());
        my $quote_chars = $self->get_quote_chars();
        my $cur_quote_char = undef;
 
@@ -197,9 +197,9 @@ sub parse {
 
                # move all characters except terminators and quoting characters
                # to the current sql statement
-               if ( $data =~ /^[^\Q$terminator$quote_chars\E]+/ ) {
+               if ( $data =~ /^[^$terminator$quote_chars]+/ ) {
                        #print "Move characters except terminators and quoting characters ...\n";
-                       $data =~ s/^([^\Q$terminator$quote_chars\E]+)//;
+                       $data =~ s/^([^$terminator$quote_chars]+)//;
                        $cur_sql .= $1;
                        next;
                }
@@ -240,6 +240,52 @@ sub parse {
 
 }
 
+#----------------------------------------------------------------------------------------
+
+=head2 parse_file( $file )
+
+Parses the given file or filehandle.
+
+=cut
+
+sub parse_file {
+
+       my ( $self, $file ) = @_;
+       my $buffer;
+
+       unless ( defined $file ) {
+               carp "Call of parse_file() without an argument.\n";
+               return undef;
+       }
+
+       unless ( ref($file) ) {
+               unless ( -f $file ) {
+                       carp "File '" . $file ."' doesn't exists.\n";
+                       return undef;
+               }
+               unless ( -r $file ) {
+                       carp "File '" . $file ."' isn't readable.\n";
+                       return undef;
+               }
+               local $/ = undef;
+               unless ( open FILE, "<", $file ) {
+                       carp "Error in opening file '" . $file ."' :" . $! . "\n";
+                       return undef;
+               }
+               defined( $buffer = <FILE> ) or return undef;
+               close FILE;
+               return $self->parse($buffer);
+       }
+
+       if ( _HANDLE($file) ) {
+               local $/ = undef;
+               $buffer = <$file>;
+               return $self->parse($buffer);
+       }
+
+       return undef;
+
+}
 
 #----------------------------------------------------------------------------------------
 
@@ -247,6 +293,22 @@ sub parse {
 
 #----------------------------------------------------------------------------------------
 
+=head1 AUTHOR
+
+Fran Brehm E<lt>frank@brehm-online.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2009 Frank Brehm
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+=cut
+
 __END__
 
 # vim: noai : ts=4 fenc=utf-8 filetype=perl :