The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

RPETTETT / ClearPress-460 / lib / ClearPress / driver / SQLite.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
—
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

              
#########
# Author:        rmp
# Maintainer:    $Author: zerojinx $
# Created:       2006-10-31
# Last Modified: $Date: 2011-05-04 10:57:27 +0100 (Wed, 04 May 2011) $
# Id:            $Id: SQLite.pm 405 2011-05-04 09:57:27Z zerojinx $
# Source:        $Source$
# $HeadURL: svn+ssh://zerojinx@svn.code.sf.net/p/clearpress/code/trunk/lib/ClearPress/driver/SQLite.pm $
#
package ClearPress::driver::SQLite;
use strict;
use warnings;
use base qw(ClearPress::driver);
use Carp;
use English qw(-no_match_vars);
use Readonly;
our $VERSION = do { my ($r) = q$LastChangedRevision: 405 $ =~ /(\d+)/smx; $r; };
Readonly::Scalar our $TYPES => {
                                'primary key' => 'integer primary key autoincrement',
                                'char(128)'   => 'text',
                               };
sub dbh {
  my $self = shift;
  if(!$self->{dbh}) {
    my $dsn = sprintf q(DBI:SQLite:dbname=%s),
                      $self->{dbname}     || q[];
    eval {
      $self->{dbh} = DBI->connect($dsn, q[], q[],
                                  {RaiseError => 1,
                                   AutoCommit => 0});
    } or do {
      croak qq[Failed to connect to $dsn:\n$EVAL_ERROR];
    };
    #########
    # rollback any junk left behind if this is a cached handle
    #
    $self->{dbh}->rollback();
  }
  return $self->{dbh};
}
sub create {
  my ($self, $query, @args) = @_;
  my $dbh = $self->dbh();
  $dbh->do($query, {}, @args);
  my ($table)  = $query =~ /INTO\s+([[:lower:][:digit:]_]+)/smix;
  my $sequence = q[SELECT seq FROM sqlite_sequence WHERE name=?];
  my $idref    = $dbh->selectall_arrayref($sequence, {}, $table);
  return $idref->[0]->[0];
}
sub types {
  return $TYPES;
}
sub bounded_select {
  my ($self, $query, $len, $start) = @_;
  if(defined $start && defined $len) {
    $query .= qq[ LIMIT $start, $len];
  } elsif(defined $len) {
    $query .= qq[ LIMIT $len];
  }
  return $query;
}
1;
__END__
=head1 NAME
ClearPress::driver::SQLite - SQLite-specific implementation of the database abstraction layer
=head1 VERSION
$LastChangedRevision: 405 $
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 SUBROUTINES/METHODS
=head2 create
=head2 dbh
=head2 create_table
=head2 drop_table
=head2 types - the whole type map
=head2 bounded_select - select limited by number of rows and first-row position
  my $bounded_select = $driver->bounded_select($unbounded_select, $rows, $start_row);
=head1 DIAGNOSTICS
=head1 CONFIGURATION AND ENVIRONMENT
=head1 DEPENDENCIES
=over
=item strict
=item warnings
=item base
=item ClearPress::driver
=back
=head1 INCOMPATIBILITIES
=head1 BUGS AND LIMITATIONS
=head1 AUTHOR
$Author: Roger Pettett$
=head1 LICENSE AND COPYRIGHT
Copyright (C) 2008 Roger Pettett
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.10 or,
at your option, any later version of Perl 5 you may have available.
=cut