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