1package DBIx::Class::Storage::DBI::SQLite;
2
3use strict;
4use warnings;
5
6use base qw/DBIx::Class::Storage::DBI/;
7use mro 'c3';
8
9use POSIX 'strftime';
10use File::Copy;
11use File::Spec;
12
13sub backup
14{
15  my ($self, $dir) = @_;
16  $dir ||= './';
17
18  ## Where is the db file?
19  my $dsn = $self->_dbi_connect_info()->[0];
20
21  my $dbname = $1 if($dsn =~ /dbname=([^;]+)/);
22  if(!$dbname)
23  {
24    $dbname = $1 if($dsn =~ /^dbi:SQLite:(.+)$/i);
25  }
26  $self->throw_exception("Cannot determine name of SQLite db file")
27    if(!$dbname || !-f $dbname);
28
29#  print "Found database: $dbname\n";
30#  my $dbfile = file($dbname);
31  my ($vol, $dbdir, $file) = File::Spec->splitpath($dbname);
32#  my $file = $dbfile->basename();
33  $file = strftime("%Y-%m-%d-%H_%M_%S", localtime()) . $file;
34  $file = "B$file" while(-f $file);
35
36  mkdir($dir) unless -f $dir;
37  my $backupfile = File::Spec->catfile($dir, $file);
38
39  my $res = copy($dbname, $backupfile);
40  $self->throw_exception("Backup failed! ($!)") if(!$res);
41
42  return $backupfile;
43}
44
45sub deployment_statements {
46  my $self = shift;;
47  my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_;
48
49  $sqltargs ||= {};
50
51  my $sqlite_version = $self->_get_dbh->{sqlite_version};
52
53  # numify, SQLT does a numeric comparison
54  $sqlite_version =~ s/^(\d+) \. (\d+) (?: \. (\d+))? .*/${1}.${2}/x;
55
56  $sqltargs->{producer_args}{sqlite_version} = $sqlite_version;
57
58  $self->next::method($schema, $type, $version, $dir, $sqltargs, @rest);
59}
60
61sub datetime_parser_type { return "DateTime::Format::SQLite"; }
62
631;
64
65=head1 NAME
66
67DBIx::Class::Storage::DBI::SQLite - Automatic primary key class for SQLite
68
69=head1 SYNOPSIS
70
71  # In your table classes
72  use base 'DBIx::Class::Core';
73  __PACKAGE__->set_primary_key('id');
74
75=head1 DESCRIPTION
76
77This class implements autoincrements for SQLite.
78
79=head1 AUTHORS
80
81Matt S. Trout <mst@shadowcatsystems.co.uk>
82
83=head1 LICENSE
84
85You may distribute this code under the same terms as Perl itself.
86
87=cut
88