From: Victor Igumnov Date: Fri, 19 Jan 2007 03:04:48 +0000 (+0000) Subject: committing first version of filecolumn X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4740bdb7248040ab95736af1abe909f1e26d8d44;p=dbsrgits%2FDBIx-Class-Historic.git committing first version of filecolumn --- diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm index 91f6677..efd0727 100644 --- a/lib/DBIx/Class.pm +++ b/lib/DBIx/Class.pm @@ -243,6 +243,8 @@ Todd Lipcon typester: Daisuke Murase +victori: Victor Igumnov + wdh: Will Hawes willert: Sebastian Willert diff --git a/lib/DBIx/Class/FileColumn.pm b/lib/DBIx/Class/FileColumn.pm new file mode 100644 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 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 class: + +FileColumn requires a hash that contains L 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: + File + 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 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 --- 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 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 --- 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 (