X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FSQLite.pm;h=e29c2ee8faec08ab0e51540bd7ae57b77bd8b70c;hb=b1d16ffdff4dbbca024dd9b62350ed4c9486091c;hp=1bbfd1d9198707e7121ad6dc85a693a11c318815;hpb=79923569c274d180c6591b859ad76c97f975a602;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm index 1bbfd1d..e29c2ee 100644 --- a/lib/DBIx/Class/Storage/DBI/SQLite.pm +++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm @@ -15,10 +15,11 @@ sub _dbh_last_insert_id { sub backup { - my ($self) = @_; + my ($self, $dir) = @_; + $dir ||= './'; ## Where is the db file? - my $dsn = $self->connect_info()->[0]; + my $dsn = $self->_dbi_connect_info()->[0]; my $dbname = $1 if($dsn =~ /dbname=([^;]+)/); if(!$dbname) @@ -30,22 +31,40 @@ sub backup # print "Found database: $dbname\n"; # my $dbfile = file($dbname); - my ($vol, $dir, $file) = File::Spec->splitpath($dbname); + my ($vol, $dbdir, $file) = File::Spec->splitpath($dbname); # my $file = $dbfile->basename(); - $file = strftime("%y%m%d%h%M%s", localtime()) . $file; + $file = strftime("%Y-%m-%d-%H_%M_%S", localtime()) . $file; $file = "B$file" while(-f $file); - - my $res = copy($dbname, $file); + + mkdir($dir) unless -f $dir; + my $backupfile = File::Spec->catfile($dir, $file); + + my $res = copy($dbname, $backupfile); $self->throw_exception("Backup failed! ($!)") if(!$res); - return $file; + return $backupfile; +} + +sub disconnect { + + # As described in this node http://www.perlmonks.org/?node_id=666210 + # there seems to be no sane way to ->disconnect a SQLite database with + # cached statement handles. As per mst we just zap the cache and + # proceed as normal. + + my $self = shift; + if ($self->connected) { + $self->_dbh->{CachedKids} = {}; + $self->next::method (@_); + } } + 1; =head1 NAME -DBIx::Class::PK::Auto::SQLite - Automatic primary key class for SQLite +DBIx::Class::Storage::DBI::SQLite - Automatic primary key class for SQLite =head1 SYNOPSIS