The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package SQL::Bibliosoph::Query; {
	use Moose;
	use DBI;
    use Data::Dumper;
    use Time::HiRes qw(gettimeofday tv_interval);
    use feature qw(say);

    use SQL::Bibliosoph::Dummy;
    use SQL::Bibliosoph::Exceptions;

    our $VERSION = "2.00";

    has benchmark  => ( is => 'rw', isa=>'Num', default => 0);
    has debug      => ( is => 'rw', isa=>'Bool', default => 0);
    has quiet      => ( is => 'rw', isa=>'Bool', default => 0);
    has dbh        => ( is => 'rw', isa => 'DBI::db',  required=> 1);
    has delayed    => ( is => 'rw', isa => 'Bool', default=> 0);

    has name       => ( is => 'rw', default=> 'unnamed');
    has st         => ( is => 'rw');
    has sth        => ( is => 'rw');
    has bind_links => ( is => 'rw', default => sub { return []; } );
    has bind_params=> ( is => 'rw');

    has throw_errors=> ( is => 'rw', default => 1);



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

        $self->prepare() unless $self->delayed();
	}

	#------------------------------------------------------------------
    
	sub prepare {
        my ($self) = @_;

		my $st = $self->st;

		# Process bb language
		my $numeric_fields  = $self->parse(\$st);

        #say 'Preparing "' . $self->name() ;

		$self->sth( $self->dbh()->prepare_cached($st) )
            or SQL::Bibliosoph::Exception::QuerySyntaxError->throw(
                desc => "error preparing :  $st"
        );

		# Set numeric bind variables
		foreach (@$numeric_fields) {
			$self->sth()->bind_param($_,100,DBI::SQL_INTEGER);
		}

        $self->delayed(0);
    }

	#------------------------------------------------------------------
	sub select_many {
		my ($self, $values, $splice) = @_;

        $self->prepare() if $self->delayed();

		return $self->pexecute($values)->fetchall_arrayref($splice)
	}

	#------------------------------------------------------------------
    # with sql_calc_found_rows
	sub select_many2 {
		my ($self, $values,$splice) = @_;

        $self->prepare() if $self->delayed();

		return ( 
            $self->pexecute($values)->fetchall_arrayref($splice),
            $self->dbh()->selectrow_array('SELECT FOUND_ROWS()'),
        )
	}

	#------------------------------------------------------------------
	# It's good to return [] if not found in order to allow
	# to do @{xxxx} in the caller
	sub select_row {
		my ($self,$values) = @_;

        $self->prepare() if $self->delayed();



		return $self->pexecute($values)->fetchrow_arrayref() || [];
	}

	#------------------------------------------------------------------
    # Returns a hash ref
	sub select_row_hash {
		my ($self, $values) = @_;

        $self->prepare() if $self->delayed();

		return $self->pexecute($values)->fetchrow_hashref() || {};
	}

	#------------------------------------------------------------------
	sub select_do {
		my ($self, $values) = @_;

        $self->prepare() if $self->delayed();

		return $self->pexecute($values);
	}

	#------------------------------------------------------------------
	# Private
	#------------------------------------------------------------------
	
	# Replaces #? bind variables to ?
	# and retuns 
	sub parse {
		my ($self,$st)  = @_;
		my @nums;

		my @m = ($$st =~ m/(\#?\d*?\?)/g );
        my $numbered =0;

		my $total=0;
		foreach (@m)  {

			# Numeric field?
			/\#/ && do {
				push @nums, $total+1;
			};

			# Linked field?
			/(\d+)/ && do {

                $self->bind_links()->[$total]= int($1);
                $numbered++;
			};
			$total++;
		}
		$self->bind_params($total);

        SQL::Bibliosoph::Exception::QuerySyntaxError->throw(
            desc => "Bad statament use ALL numbered bind variables, or NONE, but don't mix them in $$st"
        ) if $numbered && $numbered != $total;

		# Replaces nums
		$$st =~ s/\#?\d*?\?/?/g;

		return \@nums;
	}

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

	sub pexecute {
		my ($self,$values) = @_;

        my $start_time = [ gettimeofday ] if $self->benchmark();



		# Completes the input array
		if (@$values < $self->bind_params()) {
			$values->[$self->bind_params()-1] = undef;
		}
        #say "EXE ", $self->dump(), 'VAUES', Dumper($values);

		# Use links
		eval {
			# Has Numeric Links? ( i.e. 3? )
            my $l = $self->bind_links();
			if ( @$l>0 ) {
				#say("start:".Dumper($values), Dumper($l));

				my @v;
				foreach (@$l) {
					push @v, $values->[$_-1];
				}
                #say "EXE1 ". Dumper(@v);

				$self->sth()->execute (@v);
			}

			# No links, direct param mapping ( ? ? )
			else {
                #say "EXE2 ", Dumper($values);
				$self->sth()->execute( 
                        @$values[ 0 .. $self->bind_params() - 1 ],
                );
			}
		};

        if ( $@ ) {

            my $e = __PACKAGE__ 
                    ." ERROR  $@ in statement  '"
                    .  $self->name() 
                    . "': \"" 
                    . $self->st() 
                    . '\"'
                    ;

            if (
                $self->throw_errors() == 2
                || ($self->throw_errors() == 1 && $e !~ /\sDuplicate entry\s/ )
            ) {
               # $sth->err and $DBI::err will be true if error was from DBI
               SQL::Bibliosoph::Exception::QuerySyntaxError->throw (
                   desc => $e,
               ) unless $self->quiet() ; # print the error
            }
            else {
                print STDERR $e;        
                return SQL::Bibliosoph::Dummy->new();
            }
        }

        if ( my $min_t = $self->benchmark() ) {

            my $t = tv_interval( $start_time ) ;

            # Only if it takes more that 1ms...
            print STDERR "\t[". $t *1000 . " ms] " if $t > $min_t;
        }
        print STDERR "\n" if $self->debug(); 

		return $self->sth();
	}

}

1;

__END__

=head1 NAME

SQL::Bibliosoph::Query - A SQL Prepared statement 

=head1 VERSION

2.0

=head1 DESCRIPTION

	Implements one prepared statement

=head1 METHODS
		
=head2 new

	Constructor: Parameters are:

=item dbh 

	a DB handler

=item st 

The SQL statement string, using BB syntax (SEE SQL::Bibliosoph::CatalogFile)

=item name

The SQL statement name. (only for debugging information, on statement error).

=head2 destroy

Release the prepared statement.

=head1 AUTHORS

SQL::Bibliosoph by Matias Alejo Garcia (matias at confronte.com) 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.