[Bast-commits] r6301 - in DBIx-Class-InflateColumn-FS/1.000/trunk:
. lib/DBIx/Class/InflateColumn t
semifor at dev.catalyst.perl.org
semifor at dev.catalyst.perl.org
Mon May 18 17:45:56 GMT 2009
Author: semifor
Date: 2009-05-18 17:45:56 +0000 (Mon, 18 May 2009)
New Revision: 6301
Modified:
DBIx-Class-InflateColumn-FS/1.000/trunk/Changes
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/01-fs_columns.t
Log:
Don't rely on {_column_data} for deflate values; added {_fs_column_filename} instead.
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/Changes
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/Changes 2009-05-18 17:32:42 UTC (rev 6300)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/Changes 2009-05-18 17:45:56 UTC (rev 6301)
@@ -1,3 +1,6 @@
+0.01004 2009-05-14
+ - don't rely on {_column_data} for deflate values
+
0.01003 2009-04-17
- use DBIx::Class::UUIDColumns for get_uuid rather than inheriting from it
- fixed infinite recursion on create with fs_new_on_update column(s)
Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/README
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/README 2009-05-18 17:32:42 UTC (rev 6300)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/README 2009-05-18 17:45:56 UTC (rev 6301)
@@ -45,6 +45,7 @@
updated.
METHODS
+ inflate_result
register_column
fs_file_name
Provides the file naming algorithm. Override this method to change it.
@@ -62,9 +63,12 @@
delete
Deletes the associated file system storage when a row is deleted.
- update
- Deletes the associated file system storage when a column is set to null.
+ set_column
+ Deletes file storage when an fs_column is set to undef.
+ set_inflated_column
+ Re-inflates after setting an fs_column.
+
_inflate_fs_column
Inflates a file column to a Path::Class::File object.
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 2009-05-18 17:32:42 UTC (rev 6300)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/lib/DBIx/Class/InflateColumn/FS.pm 2009-05-18 17:45:56 UTC (rev 6301)
@@ -3,12 +3,12 @@
use strict;
use warnings;
use DBIx::Class::UUIDColumns;
-use File::Spec;
-use File::Path;
+use File::Spec ();
+use File::Path ();
use File::Copy ();
-use Path::Class;
+use Path::Class ();
-our $VERSION = '0.01003';
+our $VERSION = '0.01004';
=head1 NAME
@@ -63,6 +63,25 @@
=cut
+=head2 inflate_result
+
+=cut
+
+sub inflate_result {
+ my ($class, $source, $me, $prefetch) = @_;
+
+ my $new = $class->next::method($source, $me, $prefetch);
+
+ while ( my($column, $data) = each %{$new->{_column_data}} ) {
+ if ( $source->column_info($column)->{is_fs_column} && defined $data ) {
+ $new->{_fs_column_filename}{$column} = $data;
+ }
+ }
+
+ return $new;
+}
+
+
=head2 register_column
=cut
@@ -99,23 +118,18 @@
}
sub _fs_column_storage {
- my ( $self, $column, $deflate ) = @_;
+ my ( $self, $column ) = @_;
my $column_info = $self->result_source->column_info($column);
$self->throw_exception("$column is not an fs_column")
unless $column_info->{is_fs_column};
- if ( (!$column_info->{fs_new_on_update} || !$deflate) && ( my $filename = $self->{_column_data}{$column} ) ) {
- return Path::Class::File->new($column_info->{fs_column_path}, $filename);
- }
- else {
- $filename = $self->fs_file_name($column, $column_info);
- return Path::Class::File->new(
- $column_info->{fs_column_path},
- $self->_fs_column_dirs($filename),
- $filename
- );
- }
+ $self->{_fs_column_filename}{$column} ||= do {
+ my $filename = $self->fs_file_name($column, $column_info);
+ File::Spec->catfile($self->_fs_column_dirs($filename), $filename);
+ };
+
+ return Path::Class::File->new($column_info->{fs_column_path}, $self->{_fs_column_filename}{$column});
}
=head2 _fs_column_dirs
@@ -146,27 +160,18 @@
foreach my $col ( keys %$col_data ) {
my $column_info = $self->result_source->column_info($col);
- if ( $column_info->{is_fs_column}
- && defined $col_data->{$col} ) { # nothing special required for NULLs
- $col_data->{$col} = undef;
+ if ( $column_info->{is_fs_column} && defined $col_data->{$col} ) { # nothing special required for NULLs
+ delete $col_data->{$col};
# pass the original file to produce a copy on deflate
- my $accessor = $column_info->{accessor} || $col;
- $changes->{$col} ||= $self->$accessor;
+ $changes->{$col} = $self->get_inflated_column($col);
}
}
my $temp = bless { _column_data => $col_data }, ref $self;
$temp->result_source($self->result_source);
- my $copy = $temp->next::method($changes);
-
- # force reinflation of fs colmuns on next access
- delete $copy->{_inflated_column}{$_}
- for grep { $self->result_source->column_info($_)->{is_fs_column} }
- keys %$col_data;
-
- return $copy;
+ return $temp->next::method($changes);
}
=head2 delete
@@ -178,49 +183,52 @@
sub delete {
my ( $self, @rest ) = @_;
- for ( $self->columns ) {
- if ( $self->result_source->column_info($_)->{is_fs_column} ) {
- next unless $self->$_;
- $self->$_->remove;
+ for my $column ( $self->columns ) {
+ my $column_info = $self->result_source->column_info($column);
+ if ( $column_info->{is_fs_column} ) {
+ my $accessor = $column_info->{accessor} || $column;
+ $self->$accessor && $self->$accessor->remove;
}
}
return $self->next::method(@rest);
}
-=head2 update
+=head2 set_column
-Deletes the associated file system storage when a column is set to null.
+Deletes file storage when an fs_column is set to undef.
=cut
-sub update {
- my ($self, $upd) = @_;
+sub set_column {
+ my ($self, $column, $new_value) = @_;
- my %changed = ($self->get_dirty_columns, %{$upd || {}});
+ if ( !defined $new_value && $self->result_source->column_info($column)->{is_fs_column}
+ && $self->{_fs_column_filename}{$column} ) {
+ $self->_fs_column_storage($column)->remove;
+ delete $self->{_fs_column_filename}{$column};
+ }
- # cache existing fs_colums before update so we can delete storge
- # afterwards if necessary
- my $s = $self->result_source;
- my %fs_column =
- map { ($_, $self->$_) }
- grep { $s->column_info($_)->{is_fs_column} }
- keys %changed;
+ return $self->next::method($column, $new_value);
+}
- # attempt super update, first, so it can throw on DB errors
- # and perform other checks
- $self->next::method($upd);
+=head2 set_inflated_column
- while ( my ($column, $value) = each %changed ) {
- if ( $s->column_info($column)->{is_fs_column} ) {
- # remove the storage if the column was set to NULL
- $fs_column{$column}->remove if !defined $value;
+Re-inflates after setting an fs_column.
- # force reinflation on next access
- delete $self->{_inflated_column}{$column};
- }
+=cut
+
+sub set_inflated_column {
+ my ($self, $column, $inflated) = @_;
+
+ $self->next::method($column, $inflated);
+
+ # reinflate
+ if ( defined $inflated && ref $inflated && ref $inflated ne 'SCALAR'
+ && $self->result_source->column_info($column)->{is_fs_column} ) {
+ $inflated = $self->{_inflated_column}{$column} = $self->_fs_column_storage($column);
}
- return $self;
+ return $inflated;
}
=head2 _inflate_fs_column
@@ -233,6 +241,7 @@
my ( $self, $column, $value ) = @_;
return unless defined $value;
+ $self->{_fs_column_filename}{$column} = $value;
return $self->_fs_column_storage($column);
}
@@ -246,18 +255,20 @@
sub _deflate_fs_column {
my ( $self, $column, $value ) = @_;
-
- # already deflated?
- return $value unless ref $value;
- my $fs_new_on_update = $self->result_source->column_info($column)->{fs_new_on_update};
- my $file = $self->_fs_column_storage($column, 1);
-
- if ( $fs_new_on_update && (my $oldfile = $self->{_column_data}{$column}) ) {
- my $column_info = $self->result_source->column_info($column);
- Path::Class::File->new($column_info->{fs_column_path}, $oldfile)->remove;
+
+ my $column_info = $self->result_source->column_info($column);
+
+ # kill the old storage, rather than overwrite, if fs_new_on_update
+ if ( $column_info->{fs_new_on_update} && $self->{_fs_column_filename}{$column} ) {
+ my $oldfile = $self->_fs_column_storage($column);
+ if ( $oldfile ne $value ) {
+ $oldfile->remove;
+ delete $self->{_fs_column_filename}{$column};
+ }
}
- if ( $fs_new_on_update || $value ne $file ) {
+ my $file = $self->_fs_column_storage($column);
+ if ( $value ne $file ) {
File::Path::mkpath([$file->dir]);
# get a filehandle if we were passed a Path::Class::File
@@ -268,8 +279,7 @@
# force re-inflation on next access
delete $self->{_inflated_column}{$column};
}
- my $basename = $file->basename;
- return File::Spec->catfile($self->_fs_column_dirs($basename), $basename);
+ return $self->{_fs_column_filename}{$column};
}
=head2 table
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 2009-05-18 17:32:42 UTC (rev 6300)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/t/01-fs_columns.t 2009-05-18 17:45:56 UTC (rev 6301)
@@ -2,7 +2,7 @@
use warnings;
use strict;
use DBICx::TestDatabase;
-use Test::More tests => 19;
+use Test::More tests => 20;
use Path::Class qw/file/;
use File::Compare;
use lib qw(t/lib);
@@ -99,3 +99,12 @@
$book->update({ cover_image => $file, cover_image_2 => $file });
is( $book->cover_image, $cover_image, 'backing filename did not change' );
isnt( $book->cover_image_2, $cover_image_2, 'backing filename did change for fs_new_on_update column' );
+
+
+# ensure FS works with the proposed change for DBIC: make_column_dirty to delete {_column_data}{$column}
+$storage = $book->cover_image;
+
+$book->make_column_dirty('cover_image');
+delete $book->{_column_data}{cover_image};
+$book->update;
+is( $book->cover_image, $storage, 'file backikng filename unchanged')
More information about the Bast-commits
mailing list