The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package SQL::Bibliosoph::CatalogFile; {
	use Moose;
    use utf8;
	use Carp;
	use Data::Dumper;
    use Package::Constants; 

    our $VERSION = "2.00";

    has file                => ( is => 'rw', isa=>'Str',  required => 1 );
    has read_only           => ( is => 'rw', isa=>'Bool', default => 0 );
    has 'constants_from'    => ( is => 'ro', isa => 'Maybe[Str]');

	#------------------------------------------------------------------

	# Constructor
	sub BUILD {
		my ($self) = @_;

		my $file = $self->file();

		# Is read only?
		if (substr ($file,0,1) eq '<' ) {
			$file = substr($file,1);
			$self->read_only(1);
		}

		croak "File does not exists $file " if ! -e $file;
	}

    #------------------------------------------------------------------
    sub replace_contants {
        my ($self, $pstr)  =@_;

        my $p = $self->constants_from() or return;

        eval {

            # Read constants
            eval "require $p";

            import $p;
            my @cs = Package::Constants->list($p);

            # DO Replace constants
            foreach my $key (@cs) {
                my $value = eval "$key" ;
                $$pstr =~ s/\b$key\b/$value/g;
            }
        };
        if ($@) {
            die "error importing constants from $p : $@";
        }
    }

    #------------------------------------------------------------------

	sub read {
		my ($self) = @_;

		my $file_contents= $self->file_to_str( $self->file() ); 

        $self->replace_contants(\$file_contents);

		my $qs = $self->_parse($file_contents);

		# Read only?
		$self->filter_out_writes(\$qs) if $self->read_only();

		return $qs;
	}

	sub _parse {
		my ($self, $raw) = @_;
		return {} if ! $raw;

#       print STDERR "RAW: $raw\n\n";        
		return {
				map { 
					$_->[0] => $_->[1]
				}
				grep { $_->[0] } 						# Filter out empty element
				map {
					[ 
						map	  { $_ =~ s/^\s+|\s+$//g;$_ } 	# Trim
						split /\]\s*\n/,$_ 				# Separate name & statement
					]	
				}
				grep { $_ } 							# Filter out empty element
				split (/--\s*\[/ , 						# Separate elements
					$raw
				) 
		};
	}

	#------------------------------------------------------------------
	# Filter (in-place) write queries
	sub filter_out_writes {
		my ($self,$queries)= @_;

		$$queries  = {
			map {
				$_ => $$queries->{$_}
			}
			grep {
				$_ && $$queries->{$_} && ! ( $$queries->{$_} =~ /^insert|^update|^delete/i  )
			}
			keys %$$queries
		};
	}

	#------------------------------------------------------------------
	# Reads a file to a string
	sub file_to_str {
		my ($self, $file) = @_;

		my $FH;
		open ($FH,$file) 
			or croak "Could not read \"".$file."\" : $!";

		my @all = <$FH>;
		close ($FH);
		return join ('', 
			grep { ! /^#/ } 		    #filler out comments with #
			grep { ! /^--[^\[]+/ } 		#filler out comments with --
			grep { ! /^[\s\t]*$/ } 		#filler out blanks
			@all
		);
	}
}

1;

__END__

=head1 NAME

SQL::Bibliosoph::CatalogFile - Bibliosoph SQL Statements Parser

=head1 VERSION

2.0

=head1 DESCRIPTION

Reads a SQL library statements file, using the BB format (SEE below)

=head1 BB Format

--[ Query_name1 ] 
SQL statement

The query name must be a simple string, case sensitive, with no spaces. The file can have comment in every line, starting with #. Statements can include bind params denoted with question mark `?`. Optionally, parameters can be numbered: 1?, 2?, 3? ... This allows to reuse paraments, like in:

		SELECT * 
			FROM user
			 WHERE name = 1? OR nick = 1?

The bind parameter number can be preceded by a `#`. This force the parameter to be strictly numeric. This is useful for using bind parameters with the LIMIT clause.

==head1 Examples

=over

=item A simple query, using two bind parament

	--[ GET_T1 ]
	# A very nice commentA
		SELECT		t1.*
		FROM		table1 t1
	# A other comment
        LEFT JOIN   table2 t2
        ON			t1.id = t2.t1_fk
        WHERE		t2.id = ? 
		LIMIT #?

=item An insert statement. This returns the last inserted ID.

	--[ INSERT_USER ]
	# This returns LAST_INSERT_ID if `user` has a auto_increment column
		INSERT 
			INTO user (name,country) 
			VALUES 
			(?, IFNULL(?,'US') )

=item An update statement. Returns modifed rows.

	--[ AGE_USERS ]
	# This returns the modified rows
		UPDATE user
			SET age = age + 1
			WHERE birthday = ? 

=item The select using numeric and ordered params

	--[ GET_USERS ]
	# Example using numeric and ordered params
		SELECT * 
			FROM user 
			WHERE 
				(1? IS NULL OR country = 1? )
				AND (2? IS NULL OR state =  2?)
			LIMIT #3?,#4?

=back

=head1 AUTHORS

SQL::Bibliosoph by Matias Alejo Garcia (matiu at cpan.org) and Lucas Lain (lucas at confronte.com).

=head1 COPYRIGHT

Copyright (c) 2007-2009 Matias Alejo Garcia. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SUPPORT / WARRANTY

The SQL::Bibliosoph is free Open Source software. IT COMES WITHOUT WARRANTY OF ANY KIND.


=head1 SEE ALSO
	
	SQL::Bibliosoph
	SQL::Bibliosoph::CatalogFile

At	http://nits.com.ar/bibliosoph you can find:
	* Examples
	* VIM syntax highlighting definitions for bb files
	* CTAGS examples for indexing bb files.


=head1 ACKNOWLEDGEMENTS

To Confronte.com and its associates to support the development of this module.