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