[Bast-commits] r5889 - in DBIx-Class-InflateColumn-FS/1.000/trunk: . lib/DBIx/Class/InflateColumn t

[semifor at dev.catalyst.perl.org]

Author: semifor
Date: 2009-04-17 00:33:40 +0100 (Fri, 17 Apr 2009)
New Revision: 5889

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
   DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_spelling.t
Log:
Added copy method

Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/Changes
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/Changes	2009-04-15 13:47:53 UTC (rev 5888)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/Changes	2009-04-16 23:33:40 UTC (rev 5889)
@@ -1,3 +1,6 @@
+0.01003 2009-04-16
+    - added copy method
+
 0.01002 2009-03-17
     - fs_new_on_update: new file name on update (Moritz Onken)
     - fix: ->delete with multiple fs_columns (Moritz Onken)

Modified: DBIx-Class-InflateColumn-FS/1.000/trunk/README
===================================================================
--- DBIx-Class-InflateColumn-FS/1.000/trunk/README	2009-04-15 13:47:53 UTC (rev 5888)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/README	2009-04-16 23:33:40 UTC (rev 5889)
@@ -56,6 +56,9 @@
     Returns the sub-directory components for a given file name. Override it
     to provide a deeper directory tree or change the algorithm.
 
+  copy
+    Copies a row object, duplicating the files backing fs columns.
+
   delete
     Deletes the associated file system storage when a row is deleted.
 

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-04-15 13:47:53 UTC (rev 5888)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/lib/DBIx/Class/InflateColumn/FS.pm	2009-04-16 23:33:40 UTC (rev 5889)
@@ -5,10 +5,10 @@
 use base 'DBIx::Class::UUIDColumns';
 use File::Spec;
 use File::Path;
-use File::Copy;
+use File::Copy ();
 use Path::Class;
 
-our $VERSION = '0.01002';
+our $VERSION = '0.01003';
 
 =head1 NAME
 
@@ -132,6 +132,45 @@
     return $filename =~ /(..)/;
 }
 
+=head2 copy
+
+Copies a row object, duplicating the files backing fs columns.
+
+=cut
+
+sub copy {
+    my ($self, $changes) = @_;
+
+    $changes ||= {};
+    my $col_data     = { %{$self->{_column_data}}     };
+    my $inflated_col = { %{$self->{_inflated_column}} };
+
+    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
+             && !exists $changes->{$col} ) {
+            $col_data->{$col} = undef;
+            
+            # pass the original file to produce a copy on deflate
+            my $accessor = $column_info->{accessor} || $col;
+            $changes->{$col} = $self->$accessor;
+
+            delete $inflated_col->{$col};
+        }
+    }
+
+    my $copy = bless { %$self, _column_data => $col_data, _inflated_column => $inflated_col }, ref $self;
+    $copy = $copy->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;
+}
+
 =head2 delete
 
 Deletes the associated file system storage when a row is deleted.

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-04-15 13:47:53 UTC (rev 5888)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/t/01-fs_columns.t	2009-04-16 23:33:40 UTC (rev 5889)
@@ -2,7 +2,7 @@
 use warnings;
 use strict;
 use DBICx::TestDatabase;
-use Test::More tests => 13;
+use Test::More tests => 15;
 use Path::Class qw/file/;
 use File::Compare;
 use lib qw(t/lib);
@@ -73,3 +73,7 @@
 $book->update({ id => 999 });
 $book->discard_changes;
 ok( -e $book->cover_image, 'storage renamed on PK change' );
+
+my $copy = $book->copy;
+isnt( $copy->cover_image, $book->cover_image, 'copy has its own file backing' );
+ok( compare($copy->cover_image, $book->cover_image) == 0, 'copy contents correct' );

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	2009-04-15 13:47:53 UTC (rev 5888)
+++ DBIx-Class-InflateColumn-FS/1.000/trunk/t/99-pod_spelling.t	2009-04-16 23:33:40 UTC (rev 5889)
@@ -17,6 +17,7 @@
 __DATA__
 BLOBs
 FS
+fs
 IRC
 Marc
 Mims