committing first version of filecolumn

diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index 91f6677..efd0727 100644 (file)
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -243,6 +243,8 @@ Todd Lipcon
 
 typester: Daisuke Murase <typester@cpan.org>
 
+victori: Victor Igumnov <victori@cpan.org>
+
 wdh: Will Hawes
 
 willert: Sebastian Willert <willert@cpan.org>

diff --git a/lib/DBIx/Class/FileColumn.pm b/lib/DBIx/Class/FileColumn.pm
new file mode 100644 (file)
index 0000000..ece881c
--- /dev/null
+++ b/lib/DBIx/Class/FileColumn.pm
@@ -0,0 +1,191 @@
+package DBIx::Class::FileColumn;
+
+use strict;
+use warnings;
+use base 'DBIx::Class';
+use File::Path;
+use File::Copy;
+use IO::File;
+
+sub inflate_result {
+    my $self = shift;
+    my $ret = $self->next::method(@_);
+    
+    $self->_inflate_file_column($ret);
+    return $ret;
+}
+
+sub insert {
+    my ( $self, @rest ) = @_;
+
+    my ( $file, @column_names ) = $self->_load_file_column_information;
+    my $ret = $self->next::method(@rest);
+    $self->_save_file_column( $file, $ret, @column_names );
+    return $ret;
+}
+
+sub update {
+    my ($self, @rest ) = @_;
+    
+    my ( $file, @column_names ) = $self->_load_file_column_information;
+    my $ret = $self->next::method(@rest);
+    $self->_save_file_column( $file, $ret, @column_names );
+    return $ret;  
+}
+
+sub delete {
+    my ( $self, @rest ) = @_;
+
+    my @column_names = $self->columns;
+    for (@column_names) {
+        if ( $self->column_info($_)->{is_file_column} ) {
+            my $path =
+              File::Spec->catdir( $self->column_info($_)->{file_column_path},
+                $self->id );
+            rmtree( [$path], 0, 0 );
+        }
+    }
+
+    my $ret = $self->next::method(@rest);
+
+    return $ret;
+}
+
+sub _inflate_file_column {
+    my $self = shift;
+    my $ret  = shift;
+
+    my @column_names = $self->columns;
+    for(@column_names) {
+        if ( $ret->column_info($_)->{is_file_column} ) {
+            # make sure everything checks out
+            unless (defined $ret->$_) {
+                # if something is wrong set it to undef
+                $ret->$_(undef);
+                next;
+            }
+            my $fs_file =
+              File::Spec->catfile( $ret->column_info($_)->{file_column_path}, 
+                $ret->id, $ret->$_ );
+            $ret->$_({handle => new IO::File($fs_file, "r"), filename => $ret->$_});
+        }
+    }
+}
+
+sub _load_file_column_information {
+    my $self = shift;
+
+    my $file;
+    my @column_names;
+
+    @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} );
+        }
+    }
+
+    return ( $file, @column_names );
+}
+
+sub _save_file_column {
+    my ( $self, $file, $ret, @column_names ) = @_;
+
+    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 );
+        }
+    }
+}
+
+=head1 NAME
+
+DBIx::Class::FileColumn - FileColumn map files from the Database to the filesystem.
+
+=head1 DESCRIPTION
+
+FileColumn
+
+=head1 SYNOPSIS
+
+In your L<DBIx::Class> table class:
+
+    __PACKAGE__->load_components( "PK::Auto", "FileColumn", "Core" );
+    
+    # define your columns
+    __PACKAGE__->add_columns(
+        "id",
+        {
+            data_type         => "integer",
+            is_auto_increment => 1,
+            is_nullable       => 0,
+            size              => 4,
+        },
+        "filename",
+        {
+            data_type           => "varchar",
+            is_file_column      => 1,
+            file_column_path    =>'/tmp/uploaded_files',
+            # or for a Catalyst application 
+            # file_column_path  => MyApp->path_to('root','static','files'),
+            default_value       => undef,
+            is_nullable         => 1,
+            size                => 255,
+        },
+    );
+    
+
+In your L<Catalyst::Controller> class:
+
+FileColumn requires a hash that contains L<IO::File> as handle and the file's name as name.
+
+    my $entry = $c->model('MyAppDB::Articles')->create({ 
+        subject => 'blah',
+        filename => { 
+            handle => $c->req->upload('myupload')->fh, 
+            filename => $c->req->upload('myupload')->basename 
+        },
+        body => '....'
+    });
+    $c->stash->{entry}=$entry;
+    
+
+And Place the following in your TT template
+    
+    Article Subject: [% entry.subject %]
+    Uploaded File: 
+    <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
+    Body: [% entry.body %]
+    
+The file will be stored on the filesystem for later retrieval.
+Calling delete on your resultset will delete the file from the filesystem.
+Retrevial of the record automatically inflates the column back to the set hash with the IO::File handle and filename.
+
+=head1 AUTHOR
+
+Victor Igumnov
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;

diff --git a/t/96file_column.pm b/t/96file_column.pm
new file mode 100644 (file)
index 0000000..25d9149
--- /dev/null
+++ b/t/96file_column.pm
@@ -0,0 +1,18 @@
+use strict;
+use warnings;  
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use IO::File;
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 2;
+
+
+eval { $schema->resultset('FileColumn')->create({file=>'wrong set'}) };
+ok($@, 'FileColumn checking for checks against bad sets');
+my $fh = new IO::File('t/96file_column.pm','r');
+eval { $schema->resultset('FileColumn')->create({file => {handle => $fh, filename =>'96file_column.pm'}})};
+ok(!$@,'FileColumn checking if file handled properly.');

diff --git a/t/lib/DBICTest/Schema.pm b/t/lib/DBICTest/Schema.pm
index f8b2cd9..7ebd040 100644 (file)
--- a/t/lib/DBICTest/Schema.pm
+++ b/t/lib/DBICTest/Schema.pm
@@ -9,6 +9,7 @@ __PACKAGE__->load_classes(qw/
   Artist
   Employee
   CD
+  FileColumn
   Link
   Bookmark
   #dummy

diff --git a/t/lib/DBICTest/Schema/FileColumn.pm b/t/lib/DBICTest/Schema/FileColumn.pm
new file mode 100644 (file)
index 0000000..22d3a1a
--- /dev/null
+++ b/t/lib/DBICTest/Schema/FileColumn.pm
@@ -0,0 +1,19 @@
+package 
+DBICTest::Schema::FileColumn;
+
+use strict;
+use warnings;
+use base qw/DBIx::Class::Core/;
+
+__PACKAGE__->load_components(qw/FileColumn/);
+
+__PACKAGE__->table('file_columns');
+
+__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 }
+);
+
+__PACKAGE__->set_primary_key('id');
+
+1;

diff --git a/t/lib/sqlite.sql b/t/lib/sqlite.sql
index a5f4084..c9de968 100644 (file)
--- a/t/lib/sqlite.sql
+++ b/t/lib/sqlite.sql
@@ -129,6 +129,14 @@ CREATE TABLE link (
 );
 
 --
+-- Table: file_columns
+--
+CREATE TABLE file_columns (
+  id INTEGER PRIMARY KEY NOT NULL,
+  file varchar(255)
+);
+
+--
 -- Table: tags
 --
 CREATE TABLE tags (