[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