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