* Matt S Trout <
[hidden email]> [090514 08:49]:
> On Wed, May 13, 2009 at 12:10:18PM -0700, Marc Mims wrote:
> > Ok. So, now how to fix it?
> >
> > I need a unique filename to deflate to, but I only want to create it
> > once. Rather than using the deflated value {_column_data}{$column}, I
> > can create {_fs_column_filename}{$column} and use it, instead. I need
> > to populate {_fs_column_filename} when a row is read from the db. Looks
> > like I can do that by extending inflate_result.
>
> Hmm. Maybe you need to generate an extra accessor group so you can tag the
> Path::Class or whatever object on the way in?
I'm not sure what you have in mind, here. I'll poke you on IRC if the
following is off target.
I refactored my code based on the idea I outlined (quoted above). It
passes all the existing tests, plus one I added to simulate the proposed
change to make_column_dirty:
$book->make_column_dirty('cover_image');
delete $book->{_column_data}{cover_image};
$book->update;
I have attached an svn diff, but it's a bit difficult to read. So, here
are the key methods I've overridden. Does this look like a sane
approach?
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;
}
sub set_column {
my ($self, $column, $new_value) = @_;
#Deletes file storage when an fs_column is set to undef.
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};
}
return $self->next::method($column, $new_value);
}
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 $inflated;
}
-Marc
Index: t/01-fs_columns.t
===================================================================
--- t/01-fs_columns.t (revision 5892)
+++ t/01-fs_columns.t (working copy)
@@ -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')
Index: lib/DBIx/Class/InflateColumn/FS.pm
===================================================================
--- lib/DBIx/Class/InflateColumn/FS.pm (revision 5891)
+++ lib/DBIx/Class/InflateColumn/FS.pm (working copy)
@@ -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
Index: Changes
===================================================================
--- Changes (revision 5891)
+++ Changes (working copy)
@@ -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)
Index: README
===================================================================
--- README (revision 5889)
+++ README (working copy)
@@ -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.
_______________________________________________
List:
http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-classIRC: irc.perl.org#dbix-class
SVN:
http://dev.catalyst.perl.org/repos/bast/DBIx-Class/Searchable Archive:
http://www.grokbase.com/group/dbix-class@...
