[Bast-commits] r3920 - in DBIx-Class/0.08/branches/file_column: lib/DBIx/Class/InflateColumn t t/lib/DBICTest/Schema

semifor at dev.catalyst.perl.org semifor at dev.catalyst.perl.org
Mon Jan 7 19:06:06 GMT 2008


Author: semifor
Date: 2008-01-07 19:06:05 +0000 (Mon, 07 Jan 2008)
New Revision: 3920

Modified:
   DBIx-Class/0.08/branches/file_column/lib/DBIx/Class/InflateColumn/File.pm
   DBIx-Class/0.08/branches/file_column/t/96file_column.t
   DBIx-Class/0.08/branches/file_column/t/lib/DBICTest/Schema/FileColumn.pm
Log:
Restore InflateColumn::File functionality.

Modified: DBIx-Class/0.08/branches/file_column/lib/DBIx/Class/InflateColumn/File.pm
===================================================================
--- DBIx-Class/0.08/branches/file_column/lib/DBIx/Class/InflateColumn/File.pm	2008-01-07 18:48:56 UTC (rev 3919)
+++ DBIx-Class/0.08/branches/file_column/lib/DBIx/Class/InflateColumn/File.pm	2008-01-07 19:06:05 UTC (rev 3920)
@@ -5,112 +5,102 @@
 use base 'DBIx::Class';
 use File::Path;
 use File::Copy;
-use IO::File;
+use Path::Class;
 
 __PACKAGE__->load_components(qw/InflateColumn/);
 
-
 sub register_column {
-  my ($self, $column, $info, @rest) = @_;
-  $self->next::method($column, $info, @rest);
-  return unless defined($info->{is_file_column});
-    $self->inflate_column(
-      $column =>
-        {
-          inflate => sub { 
+    my ($self, $column, $info, @rest) = @_;
+    $self->next::method($column, $info, @rest);
+    return unless defined($info->{is_file_column});
+
+    $self->inflate_column($column => {
+        inflate => sub { 
             my ($value, $obj) = @_;
-            #$self->_inflate_file_column;
-          },
-          deflate => sub {
+            $obj->_inflate_file_column($column, $value);
+        },
+        deflate => sub {
             my ($value, $obj) = @_;
-            #my ( $file, @column_names ) = $self->_load_file_column_information;
-            #$self->_save_file_column( $file, $self, @column_names );
-          },
-        }
-    );
+            $obj->_save_file_column($column, $value);
+        },
+    });
 }
 
+sub _file_column_file {
+    my ($self, $column, $filename) = @_;
 
+    my $column_info = $self->column_info($column);
+
+    return unless $column_info->{is_file_column};
+
+    my $id = $self->id || $self->throw_exception(
+        'id required for filename generation'
+    );
+
+    $filename ||= $self->$column->{filename};
+    return Path::Class::file(
+        $column_info->{file_column_path}, $id, $filename,
+    );
+}
+
 sub delete {
     my ( $self, @rest ) = @_;
 
-    my @column_names = $self->columns;
-    for (@column_names) {
+    for ( $self->columns ) {
         if ( $self->column_info($_)->{is_file_column} ) {
-            my $path =
-              File::Spec->catdir( $self->column_info($_)->{file_column_path},
-                $self->id );
-            rmtree( [$path], 0, 0 );
+            rmtree( [$self->_file_column_file($_)->dir], 0, 0 );
+            last; # if we've deleted one, we've deleted them all
         }
     }
 
-    my $ret = $self->next::method(@rest);
-
-    return $ret;
+    return $self->next::method(@rest);
 }
 
-sub _inflate_file_column {
+sub insert {
     my $self = shift;
-
-    my @column_names = $self->columns;
-    for(@column_names) {
+ 
+    # cache our file columns so we can write them to the fs
+    # -after- we have a PK
+    my %file_column;
+    for ( $self->columns ) {
         if ( $self->column_info($_)->{is_file_column} ) {
-            # make sure everything checks out
-            unless (defined $self->$_) {
-                # if something is wrong set it to undef
-                $self->$_(undef);
-                next;
-            }
-            my $fs_file =
-              File::Spec->catfile( $self->column_info($_)->{file_column_path}, 
-                $self->id, $self->$_ );
-            $self->$_({handle => new IO::File($fs_file, "r"), filename => $self->$_});
+            $file_column{$_} = $self->$_;
+            $self->store_column($_ => $self->$_->{filename});
         }
     }
+
+    $self->next::method(@_);
+
+    # write the files to the fs
+    while ( my ($col, $file) = each %file_column ) {
+        $self->_save_file_column($col, $file);
+    }
+
+    return $self;
 }
 
-sub _load_file_column_information {
-    my $self = shift;
 
-    my $file;
-    my @column_names;
+sub _inflate_file_column {
+    my ( $self, $column, $value ) = @_;
 
-    @column_names = $self->columns;
-    for (@column_names) {
-        if ( $self->column_info($_)->{is_file_column} ) {
-            # make sure everything checks out
-            unless ((defined $self->$_) ||
-             (defined $self->$_->{filename} && defined $self->$_->{handle})) {
-                # if something is wrong set it to undef
-                $self->$_(undef);
-                next;
-            }
-            $file->{$_} = $self->$_;
-            $self->$_( $self->$_->{filename} );
-        }
-    }
+    my $fs_file = $self->_file_column_file($column, $value);
 
-    return ( $file, @column_names );
+    return { handle => $fs_file->open('r'), filename => $value };
 }
 
 sub _save_file_column {
-    my ( $self, $file, $ret, @column_names ) = @_;
+    my ( $self, $column, $value ) = @_;
 
-    for (@column_names) {
-        if ( $ret->column_info($_)->{is_file_column} ) {
-            next unless (defined $ret->$_);
-            my $file_path =
-              File::Spec->catdir( $ret->column_info($_)->{file_column_path},
-                $ret->id );
-            mkpath [$file_path];
-            
-            my $outfile =
-              File::Spec->catfile( $file_path, $file->{$_}->{filename} );
-            File::Copy::copy( $file->{$_}->{handle}, $outfile );
-        
-            $self->_file_column_callback($file->{$_},$ret,$_);
-        }
-    }
+    return unless ref $value;
+
+    my $fs_file = $self->_file_column_file($column, $value->{filename});
+    mkpath [$fs_file->dir];
+    
+    File::Copy::copy($value->{handle}, $fs_file);
+
+    $self->_file_column_callback($value, $self, $column);
+
+    return $value->{filename};
 }
 
 =head1 NAME
@@ -186,9 +176,7 @@
 
 =cut
 
-sub _file_column_callback {
-    my ($self,$file,$ret,$target) = @_;
-}
+sub _file_column_callback {}
 
 =head1 AUTHOR
 

Modified: DBIx-Class/0.08/branches/file_column/t/96file_column.t
===================================================================
--- DBIx-Class/0.08/branches/file_column/t/96file_column.t	2008-01-07 18:48:56 UTC (rev 3919)
+++ DBIx-Class/0.08/branches/file_column/t/96file_column.t	2008-01-07 19:06:05 UTC (rev 3920)
@@ -5,11 +5,63 @@
 use lib qw(t/lib);
 use DBICTest;
 use IO::File;
+use File::Compare;
+use Path::Class qw/file/;
 
 my $schema = DBICTest->init_schema();
 
-plan tests => 1;
+plan tests => 9;
 
-my $fh = new IO::File('t/96file_column.t','r');
-eval { $schema->resultset('FileColumn')->create({file => {handle => $fh, filename =>'96file_column.t'}})};
-cmp_ok($@,'eq','','FileColumn checking if file handled properly.');
+my $rs = $schema->resultset('FileColumn');
+my $fname = '96file_column.t';
+my $source_file = file('t', $fname);
+my $fh = $source_file->open('r') or die "failed to open $source_file: $!\n";
+my $fc = eval {
+    $rs->create({ file => { handle => $fh, filename => $fname } })
+};
+is ( $@, '', 'created' );
+
+$fh->close;
+
+my $storage = file(
+    $fc->column_info('file')->{file_column_path},
+    $fc->id,
+    $fc->file->{filename},
+);
+ok ( -e $storage, 'storage exists' );
+
+# read it back
+$fc = $rs->find({ id => $fc->id });
+
+is ( $fc->file->{filename}, $fname, 'filename matches' );
+ok ( compare($storage, $source_file) == 0, 'file contents matches' );
+
+# update
+my $new_fname = 'File.pm';
+my $new_source_file = file(qw/lib DBIx Class InflateColumn File.pm/);
+my $new_storage = file(
+    $fc->column_info('file')->{file_column_path},
+    $fc->id,
+    $new_fname,
+);
+$fh = $new_source_file->open('r') or die "failed to open $new_source_file: $!\n";
+
+$fc->file({ handle => $fh, filename => $new_fname });
+$fc->update;
+
+TODO: {
+    local $TODO = 'design change required';
+    ok ( ! -e $storage, 'old storage does not exist' );
+};
+
+ok ( -e $new_storage, 'new storage exists' );
+
+# read it back
+$fc = $rs->find({ id => $fc->id });
+
+is ( $fc->file->{filename}, $new_fname, 'new filname matches' );
+ok ( compare($new_storage, $new_source_file) == 0, 'new content matches' );
+
+$fc->delete;
+
+ok ( ! -e $storage, 'storage deleted' );

Modified: DBIx-Class/0.08/branches/file_column/t/lib/DBICTest/Schema/FileColumn.pm
===================================================================
--- DBIx-Class/0.08/branches/file_column/t/lib/DBICTest/Schema/FileColumn.pm	2008-01-07 18:48:56 UTC (rev 3919)
+++ DBIx-Class/0.08/branches/file_column/t/lib/DBICTest/Schema/FileColumn.pm	2008-01-07 19:06:05 UTC (rev 3920)
@@ -4,6 +4,7 @@
 use strict;
 use warnings;
 use base qw/DBIx::Class::Core/;
+use File::Temp qw/tempdir/;
 
 __PACKAGE__->load_components(qw/InflateColumn::File/);
 
@@ -11,7 +12,12 @@
 
 __PACKAGE__->add_columns(
   id => { data_type => 'integer', is_auto_increment => 1 },
-  file => { data_type => 'varchar', is_file_column => 1, file_column_path => '/tmp', size=>255 }
+  file => {
+    data_type        => 'varchar',
+    is_file_column   => 1,
+    file_column_path => tempdir(CLEANUP => 1),
+    size             => 255
+  }
 );
 
 __PACKAGE__->set_primary_key('id');




More information about the Bast-commits mailing list