# -*- perl -*- ##---------------------------------------------------------------------------- # Database Object Interface - ~/lib/DB/Object/SQLite/Statement.pm # Version v0.300.1 # Copyright(c) 2019 DEGUEST Pte. Ltd. # Author: Jacques Deguest <@sitael.tokyo.deguest.jp> # Created 2017/07/19 # Modified 2020/05/22 # ##---------------------------------------------------------------------------- # This package's purpose is to automatically terminate the statement object and # separate them from the connection object (DB::Object). # Connection object last longer than statement objects ##---------------------------------------------------------------------------- package DB::Object::SQLite::Statement; BEGIN { use strict; use warnings; use parent qw( DB::Object::SQLite DB::Object::Statement ); use vars qw( $VERSION $DEBUG ); our $DEBUG = 0; our $VERSION = 'v0.300.1'; }; use strict; use warnings; # Inherited from DB::Object::Statement # sub bind_param # sub commit is called by dbh, so it is in DB::Object::Postgres # Customised for Postgres sub distinct { my $self = shift( @_ ); my $what = shift( @_ ); my $query = $self->{query} || return( $self->error( "No query to set as to be ignored." ) ); my $type = uc( ( $query =~ /^\s*(\S+)\s+/ )[ 0 ] ); # ALTER for table alteration statements (DB::Object::Tables my @allowed = qw( SELECT ); my $allowed = CORE::join( '|', @allowed ); if( !scalar( grep{ /^$type$/i } @allowed ) ) { return( $self->error( "You may not flag statement of type \U$type\E to be distinct:\n$query" ) ); } # Incompatible. Do not bother going further return( $self ) if( $query =~ /^[[:blank:]]*(?:$allowed)[[:blank:]]+(?:DISTINCT|ALL)[[:blank:]]+/i ); my $clause = defined( $what ) ? "DISTINCT ON ($what)" : "DISTINCT"; $query =~ s/^([[:blank:]]*)($allowed)([[blank:]]+)/$1$2 $clause /; # my $sth = $self->prepare( $query ) || # $self->{ 'query' } = $query; # saving parameters to bind later on must have been done previously my $sth = $self->_cache_this( $query ) || return( $self->error( "Error while preparing new ignored query:\n$query" ) ); if( !defined( wantarray() ) ) { $sth->execute() || return( $self->error( "Error while executing new ignored query:\n$query" ) ); } return( $sth ); } # Inherited from DB::Object # sub dump # Inherited from DB::Object::Statement # sub execute # Inherited from DB::Object::Statement # sub executed # Inherited from DB::Object::Statement # sub fetchall_arrayref($@) # Inherited from DB::Object::Statement # sub fetchcol($;$) # Inherited from DB::Object::Statement # sub fetchhash(@) # Inherited from DB::Object::Statement # sub fetchrow(@) # Inherited from DB::Object::Statement # sub finish # https://sqlite.org/lang_insert.html # https://sqlite.org/lang_update.html sub ignore { my $self = shift( @_ ); my $query = $self->{query} || return( $self->error( "No query to set as to be ignored." ) ); my $type = uc( ( $query =~ /^[[:blank:]]*(\S+)[[:blank:]]+/ )[ 0 ] ); # ALTER for table alteration statements (DB::Object::Tables my @allowed = qw( INSERT UPDATE ); my $allowed = CORE::join( '|', @allowed ); if( !scalar( grep{ /^$type$/i } @allowed ) ) { return( $self->error( "You may not flag statement of type \U$type\E to be ignored:\n$query" ) ); } # Already done. Do not bother going further return( $self ) if( $query =~ /^[[:blank:]]*(?:$allowed)[[:blank:]]+OR[[:blank:]]+IGNORE[[:blank:]]+/i ); $query =~ s/^([[:blank:]]*)($allowed)([[:blank:]]+)/$1$2 OR IGNORE$3/; my $sth = $self->_cache_this( $query ) || return( $self->error( "Error while preparing new ignored query:\n$query" ) ); if( !defined( wantarray() ) ) { $sth->execute() || return( $self->error( "Error while executing new ignored query:\n$query" ) ); } return( $sth ); } # Inherited from DB::Object::Statement # sub join # Inherited from DB::Object::Statement # sub object sub only { return( shift->error( "SELECT | DELETE | UPDATE ONLY is not supported by SQLite." ) ); } sub priority { return( shift->error( "Priority is not supported in SQLite." ) ); } # rollback is called using the dbh handler and is located in DB::Object::Postgres # Inherited from DB::Object::Statement # sub rows(@) # Inherited from DB::Object::Statement # sub undo sub unprepared_statements { my $self = shift( @_ ); if( $self->{dbh}->{sth} ) { return( $self->{dbh}->{sth}->{sqlite_unprepared_statements} ); } return; } # Does nothing in SQLite. This is a Mysql feature sub wait { return( shift( @_ ) ); } DESTROY { # Do nothing but existing so it is handled by this package # print( STDERR "DESTROY'ing statement $self ($self->{ 'query' })\n" ); }; 1; __END__ =encoding utf-8 =head1 NAME DB::Object::SQLite::Statement - SQLite Statement Object =head1 SYNOPSIS use DB::Object::SQLite::Statement; my $this = DB::Object::SQLite::Statement->new || die( DB::Object::SQLite::Statement->error, "\n" ); =head1 VERSION v0.300.1 =head1 DESCRIPTION This is a SQLite specific statement object class. =head1 METHODS =head2 distinct Provided with an optional column and called upon a C<SELECT> query and this will modify the query to add the keyword C<DISTINCT> $sth->distinct; # produces SELECT DISTINCT.... $sth->distinct( 'name' ); # produces SELECT DISTINCT ON (name).... See L<SQLite documentation for more information|https://sqlite.org/lang_select.html> =head2 dump This is inherited from L<DB::Object::Statement/dump> =head2 ignore This takes no argument and this will modify the queries of type C<insert>, or C<update> to add the keyword C<IGNORE> $sth->ignore; # produces INSERT IGNORE.... If called in void context, this will execute the prepare statement handler immediately. It returns the newly created statement handler. See L<SQLite documentation for more information|https://www.sqlite.org/lang_insert.html> =head2 only This returns an error as C<SELECT FROM ONLY> is not supported by SQLite and will return an error. =head2 priority This is unsupported under SQLite and if used returns an error. =head2 unprepared_statements This returns the natural SQLite statement property C<sqlite_unprepared_statements>, which provides the remaining unprepared statements in case where multiple statements were prepared. See L<DBD::SQLite documentation for more information|DBD::SQLite> =head2 wait This is unsupported under SQLite and it will be silently ignore, returning the current object. =head1 SEE ALSO L<perl> =head1 AUTHOR Jacques Deguest E<lt>F<jack@deguest.jp>E<gt> =head1 COPYRIGHT & LICENSE Copyright (c) 2019-2021 DEGUEST Pte. Ltd. You can use, copy, modify and redistribute this package and associated files under the same terms as Perl itself. =cut