1 package DBIx::Class::FileColumn;
5 use base 'DBIx::Class';
12 my $ret = $self->next::method(@_);
14 $self->_inflate_file_column($ret);
19 my ( $self, @rest ) = @_;
21 my ( $file, @column_names ) = $self->_load_file_column_information;
22 my $ret = $self->next::method(@rest);
23 $self->_save_file_column( $file, $ret, @column_names );
28 my ($self, @rest ) = @_;
30 my ( $file, @column_names ) = $self->_load_file_column_information;
31 my $ret = $self->next::method(@rest);
32 $self->_save_file_column( $file, $ret, @column_names );
37 my ( $self, @rest ) = @_;
39 my @column_names = $self->columns;
41 if ( $self->column_info($_)->{is_file_column} ) {
43 File::Spec->catdir( $self->column_info($_)->{file_column_path},
45 rmtree( [$path], 0, 0 );
49 my $ret = $self->next::method(@rest);
54 sub _inflate_file_column {
58 my @column_names = $self->columns;
60 if ( $ret->column_info($_)->{is_file_column} ) {
61 # make sure everything checks out
62 unless (defined $ret->$_) {
63 # if something is wrong set it to undef
68 File::Spec->catfile( $ret->column_info($_)->{file_column_path},
70 $ret->$_({handle => new IO::File($fs_file, "r"), filename => $ret->$_});
75 sub _load_file_column_information {
81 @column_names = $self->columns;
83 if ( $self->column_info($_)->{is_file_column} ) {
84 # make sure everything checks out
85 unless ((defined $self->$_) ||
86 (defined $self->$_->{filename} && defined $self->$_->{handle})) {
87 # if something is wrong set it to undef
91 $file->{$_} = $self->$_;
92 $self->$_( $self->$_->{filename} );
96 return ( $file, @column_names );
99 sub _save_file_column {
100 my ( $self, $file, $ret, @column_names ) = @_;
102 for (@column_names) {
103 if ( $ret->column_info($_)->{is_file_column} ) {
104 next unless (defined $ret->$_);
106 File::Spec->catdir( $ret->column_info($_)->{file_column_path},
111 File::Spec->catfile( $file_path, $file->{$_}->{filename} );
112 File::Copy::copy( $file->{$_}->{handle}, $outfile );
114 $self->_file_column_callback($file->{$_},$ret,$_);
124 =head2 _file_column_callback ($file,$ret,$target)
126 method made to be overridden for callback purposes.
130 sub _file_column_callback {
131 my ($self,$file,$ret,$target) = @_;
136 DBIx::Class::FileColumn - FileColumn map files from the Database to the filesystem.
144 In your L<DBIx::Class> table class:
146 __PACKAGE__->load_components( "PK::Auto", "FileColumn", "Core" );
148 # define your columns
149 __PACKAGE__->add_columns(
152 data_type => "integer",
153 is_auto_increment => 1,
159 data_type => "varchar",
161 file_column_path =>'/tmp/uploaded_files',
162 # or for a Catalyst application
163 # file_column_path => MyApp->path_to('root','static','files'),
164 default_value => undef,
171 In your L<Catalyst::Controller> class:
173 FileColumn requires a hash that contains L<IO::File> as handle and the file's name as name.
175 my $entry = $c->model('MyAppDB::Articles')->create({
178 handle => $c->req->upload('myupload')->fh,
179 filename => $c->req->upload('myupload')->basename
183 $c->stash->{entry}=$entry;
186 And Place the following in your TT template
188 Article Subject: [% entry.subject %]
190 <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
191 Body: [% entry.body %]
193 The file will be stored on the filesystem for later retrieval.
194 Calling delete on your resultset will delete the file from the filesystem.
195 Retrevial of the record automatically inflates the column back to the set hash with the IO::File handle and filename.
203 This library is free software, you can redistribute it and/or modify
204 it under the same terms as Perl itself.