[Bast-commits] r9454 - in DBIx-Class-InflateColumn-FS/1.000/trunk:
. lib/DBIx/Class/InflateColumn t t/lib/My/TestSchema
semifor at dev.catalyst.perl.org
semifor at dev.catalyst.perl.org
Fri May 28 20:02:08 GMT 2010
Author: semifor
Date: 2010-05-28 21:02:08 +0100 (Fri, 28 May 2010)
New Revision: 9454
Added:
DBIx-Class-InflateColumn-FS/1.000/trunk/t/multi-create.t
Modified:
DBIx-Class-InflateColumn-FS/1.000/trunk/Changes
DBIx-Class-InflateColumn-FS/1.000/trunk/MANIFEST.SKIP
DBIx-Class-InflateColumn-FS/1.000/trunk/Makefile.PL
DBIx-Class-InflateColumn-FS/1.000/trunk/README
DBIx-Class-InflateColumn-FS/1.000/trunk/lib/DBIx/Class/InflateColumn/FS.pm
DBIx-Class-InflateColumn-FS/1.000/trunk/t/00-load.t
DBIx-Class-InflateColumn-FS/1.000/trunk/t/01-fs_columns.t
DBIx-Class-InflateColumn-FS/1.000/trunk/t/02-uniq.t
DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_coverage.t
DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_spelling.t
DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_syntax.t
DBIx-Class-InflateColumn-FS/1.000/trunk/t/lib/My/TestSchema/Author.pm
DBIx-Class-InflateColumn-FS/1.000/trunk/t/lib/My/TestSchema/Book.pm
Log:
Delete file backing for un-inserted rows on DESTROY
Added TODO tests for multi-create failure, pending a patch to
DBIx::Class::Row.
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/Changes
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/Changes 2010-05-28 15:06:57 UTC (rev 9453)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/Changes 2010-05-28 20:02:08 UTC (rev 9454)
@@ -1,3 +1,7 @@
+0.01006 2010-05-28
+ - Added DESTROY to delete file backing for un-inserted rows
+ - Added TODO tests for multi-create failure pending DBIx::Class::Row patch
+
0.01005 2009-08-10
- bug fix: aliased column names (Moritz Onken)
- skip test to accommodate older DBIC releases without make_column_dirty
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/MANIFEST.SKIP
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/MANIFEST.SKIP 2010-05-28 15:06:57 UTC (rev 9453)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/MANIFEST.SKIP 2010-05-28 20:02:08 UTC (rev 9454)
@@ -15,6 +15,8 @@
# for developers only :)
^TODO$
+^NOTES$
+^.prove$
# Avoid Module::Build generated and utility files.
\bBuild$
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/Makefile.PL
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/Makefile.PL 2010-05-28 15:06:57 UTC (rev 9453)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/Makefile.PL 2010-05-28 20:02:08 UTC (rev 9454)
@@ -14,6 +14,7 @@
test_requires 'DBD::SQLite' => 1.12;
test_requires 'DBICx::TestDatabase' => 0;
+test_requires 'File::Find';
eval {
system 'pod2text lib/DBIx/Class/InflateColumn/FS.pm > README';
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/README
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/README 2010-05-28 15:06:57 UTC (rev 9453)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/README 2010-05-28 20:02:08 UTC (rev 9454)
@@ -3,7 +3,7 @@
Path::Class::File objects
SYNOPSIS
- __PACKAGE__->load_components('InflateColumn::FS Core');
+ __PACKAGE__->load_components(qw/InflateColumn::FS Core/);
__PACKAGE__->add_columns(
id => {
data_type => 'INT',
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/lib/DBIx/Class/InflateColumn/FS.pm
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/lib/DBIx/Class/InflateColumn/FS.pm 2010-05-28 15:06:57 UTC (rev 9453)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/lib/DBIx/Class/InflateColumn/FS.pm 2010-05-28 20:02:08 UTC (rev 9454)
@@ -8,7 +8,7 @@
use File::Copy ();
use Path::Class ();
-our $VERSION = '0.01005';
+our $VERSION = '0.01006';
=head1 NAME
@@ -16,7 +16,7 @@
=head1 SYNOPSIS
- __PACKAGE__->load_components('InflateColumn::FS Core');
+ __PACKAGE__->load_components(qw/InflateColumn::FS Core/);
__PACKAGE__->add_columns(
id => {
data_type => 'INT',
@@ -276,12 +276,27 @@
my $fh2 = $file->openw or die;
File::Copy::copy($fh1, $fh2);
- # force re-inflation on next access
- delete $self->{_inflated_column}{$column};
+ $self->{_inflated_column}{$column} = $file;
}
return $self->{_fs_column_filename}{$column};
}
+sub DESTROY {
+ my $self = shift;
+
+ return if $self->in_storage;
+
+ # If fs columns were deflated, but the row was never stored, we need to delete the
+ # backing files.
+ while ( my ( $col, $data ) = each %{ $self->{_column_data} } ) {
+ my $column_info = $self->result_source->column_info($col);
+ if ( $column_info->{is_fs_column} && defined $data ) {
+ my $accessor = $column_info->{accessor} || $col;
+ $self->$accessor->remove;
+ }
+ }
+}
+
=head2 table
Overridden to provide a hook for specifying the resultset_class. If
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/t/00-load.t
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/t/00-load.t 2010-05-28 15:06:57 UTC (rev 9453)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/t/00-load.t 2010-05-28 20:02:08 UTC (rev 9454)
@@ -1,4 +1,4 @@
-#!perl -wT
+#!perl
use warnings;
use strict;
use Test::More tests => 1;
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/t/01-fs_columns.t
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/t/01-fs_columns.t 2010-05-28 15:06:57 UTC (rev 9453)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/t/01-fs_columns.t 2010-05-28 20:02:08 UTC (rev 9454)
@@ -1,7 +1,8 @@
+#!perl
use warnings;
use strict;
use DBICx::TestDatabase;
-use Test::More tests => 21;
+use Test::More tests => 24;
use Path::Class qw/file/;
use File::Compare;
use lib qw(t/lib);
@@ -114,3 +115,23 @@
ok($schema->resultset('Book')->search(undef, { select => [qw(id)], as => [qw(foo)] })->all);
+
+{
+ # Objects that are never written to storage should have
+ # backing files removed.
+
+ $book = $rs->new({
+ name => 'The Unpublished Chronicles of MST',
+ cover_image => $file,
+ });
+
+ # force object deflation
+ $book->get_columns;
+
+ $storage = $book->cover_image;
+ isnt ( $storage, $file, 'object deflated' );
+ ok ( -e $storage, 'file backing exists' );
+
+ undef $book;
+ ok ( !-e $storage, 'storage deleted for un-inserted row' );
+}
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/t/02-uniq.t
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/t/02-uniq.t 2010-05-28 15:06:57 UTC (rev 9453)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/t/02-uniq.t 2010-05-28 20:02:08 UTC (rev 9454)
@@ -1,3 +1,4 @@
+#!perl
use strict;
use warnings;
use Test::More tests => 5;
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_coverage.t
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_coverage.t 2010-05-28 15:06:57 UTC (rev 9453)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_coverage.t 2010-05-28 20:02:08 UTC (rev 9454)
@@ -1,4 +1,4 @@
-#!perl -wT
+#!perl
use warnings;
use strict;
use Test::More;
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_spelling.t
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_spelling.t 2010-05-28 15:06:57 UTC (rev 9453)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_spelling.t 2010-05-28 20:02:08 UTC (rev 9454)
@@ -1,4 +1,4 @@
-#!perl -w
+#!perl
use strict;
use warnings;
use Test::More;
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_syntax.t
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_syntax.t 2010-05-28 15:06:57 UTC (rev 9453)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_syntax.t 2010-05-28 20:02:08 UTC (rev 9454)
@@ -1,4 +1,4 @@
-#!perl -wT
+#!perl
use strict;
use warnings;
use Test::More;
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/t/lib/My/TestSchema/Author.pm
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/t/lib/My/TestSchema/Author.pm 2010-05-28 15:06:57 UTC (rev 9453)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/t/lib/My/TestSchema/Author.pm 2010-05-28 20:02:08 UTC (rev 9454)
@@ -24,5 +24,6 @@
},
);
__PACKAGE__->set_primary_key(qw/id/);
+__PACKAGE__->has_many(books => 'My::TestSchema::Book', 'author_id');
1;
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/t/lib/My/TestSchema/Book.pm
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/t/lib/My/TestSchema/Book.pm 2010-05-28 15:06:57 UTC (rev 9453)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/t/lib/My/TestSchema/Book.pm 2010-05-28 20:02:08 UTC (rev 9454)
@@ -12,6 +12,11 @@
data_type => 'INT',
is_auto_increment => 1,
},
+ author_id => {
+ data_type => 'INT',
+ is_foreign_key => 1,
+ is_nullable => 1,
+ },
name => {
data_type => 'VARCHAR',
size => 60,
@@ -31,5 +36,6 @@
},
);
__PACKAGE__->set_primary_key(qw/id/);
+__PACKAGE__->belongs_to(author => 'My::TestSchema::Author', 'author_id');
1;
Added: DBIx-Class-InflateColumn-FS/1.000/trunk/t/multi-create.t
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/t/multi-create.t (rev 0)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/t/multi-create.t 2010-05-28 20:02:08 UTC (rev 9454)
@@ -0,0 +1,39 @@
+#!perl
+use warnings;
+use strict;
+use DBICx::TestDatabase;
+use Test::More tests => 2;
+use Path::Class qw/file/;
+use File::Find;
+use lib qw(t/lib);
+
+my $schema = DBICx::TestDatabase->new('My::TestSchema');
+
+# we'll use *this* file as our content
+# TODO: Copy it or create something else so errant tests don't inadvertently
+# delete it!
+my $file = file($0);
+
+my $author = $schema->resultset('Author')->create({
+ name => 'Joseph Heller',
+ books => [
+ { name => 'Catch 22', cover_image => $file },
+ { name => 'Something Happened', cover_image => $file },
+ ],
+});
+
+is ( $author->books->count, 2, 'created 2 books' );
+
+TODO: {
+ local $TODO = 'Requires a patch to DBIx::Class::Row 2010-05-28 (semifor)';
+
+ my $storage_dir = $schema->resultset('Book')
+ ->result_source
+ ->column_info('cover_image')
+ ->{fs_column_path};
+
+ my $file_count = 0;
+ find(sub { -f && ++$file_count }, $storage_dir);
+
+ is ( $file_count, 2, '2 backing files' );
+}
More information about the Bast-commits
mailing list