fix master debug output for ::Replicated
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / SQLite.pm
CommitLineData
843f8ecd 1package DBIx::Class::Storage::DBI::SQLite;
2
3use strict;
4use warnings;
c9d2e0a2 5use POSIX 'strftime';
6use File::Copy;
79923569 7use File::Spec;
843f8ecd 8
d2f21b37 9use base qw/DBIx::Class::Storage::DBI/;
843f8ecd 10
d4f16b21 11sub _dbh_last_insert_id {
12 my ($self, $dbh, $source, $col) = @_;
13 $dbh->func('last_insert_rowid');
843f8ecd 14}
15
c9d2e0a2 16sub backup
17{
8795fefb 18 my ($self, $dir) = @_;
19 $dir ||= './';
c9d2e0a2 20
21 ## Where is the db file?
12c9beea 22 my $dsn = $self->_dbi_connect_info()->[0];
c9d2e0a2 23
24 my $dbname = $1 if($dsn =~ /dbname=([^;]+)/);
25 if(!$dbname)
26 {
27 $dbname = $1 if($dsn =~ /^dbi:SQLite:(.+)$/i);
28 }
29 $self->throw_exception("Cannot determine name of SQLite db file")
30 if(!$dbname || !-f $dbname);
31
32# print "Found database: $dbname\n";
79923569 33# my $dbfile = file($dbname);
8795fefb 34 my ($vol, $dbdir, $file) = File::Spec->splitpath($dbname);
79923569 35# my $file = $dbfile->basename();
a32c360c 36 $file = strftime("%Y-%m-%d-%H_%M_%S", localtime()) . $file;
c9d2e0a2 37 $file = "B$file" while(-f $file);
8795fefb 38
39 mkdir($dir) unless -f $dir;
40 my $backupfile = File::Spec->catfile($dir, $file);
41
42 my $res = copy($dbname, $backupfile);
c9d2e0a2 43 $self->throw_exception("Backup failed! ($!)") if(!$res);
44
8795fefb 45 return $backupfile;
c9d2e0a2 46}
47
40f75181 48sub datetime_parser_type { return "DateTime::Format::SQLite"; }
49
843f8ecd 501;
51
75d07914 52=head1 NAME
843f8ecd 53
8e766a13 54DBIx::Class::Storage::DBI::SQLite - Automatic primary key class for SQLite
843f8ecd 55
56=head1 SYNOPSIS
57
58 # In your table classes
77254782 59 __PACKAGE__->load_components(qw/PK::Auto Core/);
843f8ecd 60 __PACKAGE__->set_primary_key('id');
61
62=head1 DESCRIPTION
63
64This class implements autoincrements for SQLite.
65
66=head1 AUTHORS
67
68Matt S. Trout <mst@shadowcatsystems.co.uk>
69
70=head1 LICENSE
71
72You may distribute this code under the same terms as Perl itself.
73
74=cut