1 package DBIx::Class::InflateColumn::File;
5 use base 'DBIx::Class';
10 __PACKAGE__->load_components(qw/InflateColumn/);
13 my ($self, $column, $info, @rest) = @_;
14 $self->next::method($column, $info, @rest);
15 return unless defined($info->{is_file_column});
17 $self->inflate_column($column => {
19 my ($value, $obj) = @_;
20 $obj->_inflate_file_column($column, $value);
23 my ($value, $obj) = @_;
24 $obj->_save_file_column($column, $value);
29 sub _file_column_file {
30 my ($self, $column, $filename) = @_;
32 my $column_info = $self->column_info($column);
34 return unless $column_info->{is_file_column};
36 my $id = $self->id || $self->throw_exception(
37 'id required for filename generation'
40 $filename ||= $self->$column->{filename};
41 return Path::Class::file(
42 $column_info->{file_column_path}, $id, $filename,
47 my ( $self, @rest ) = @_;
49 for ( $self->columns ) {
50 if ( $self->column_info($_)->{is_file_column} ) {
51 rmtree( [$self->_file_column_file($_)->dir], 0, 0 );
52 last; # if we've deleted one, we've deleted them all
56 return $self->next::method(@rest);
62 # cache our file columns so we can write them to the fs
63 # -after- we have a PK
65 for ( $self->columns ) {
66 if ( $self->column_info($_)->{is_file_column} ) {
67 $file_column{$_} = $self->$_;
68 $self->store_column($_ => $self->$_->{filename});
72 $self->next::method(@_);
74 # write the files to the fs
75 while ( my ($col, $file) = each %file_column ) {
76 $self->_save_file_column($col, $file);
83 sub _inflate_file_column {
84 my ( $self, $column, $value ) = @_;
86 my $fs_file = $self->_file_column_file($column, $value);
88 return { handle => $fs_file->open('r'), filename => $value };
91 sub _save_file_column {
92 my ( $self, $column, $value ) = @_;
94 return unless ref $value;
96 my $fs_file = $self->_file_column_file($column, $value->{filename});
97 mkpath [$fs_file->dir];
99 # File::Copy doesn't like Path::Class (or any for that matter) objects,
100 # thus ->stringify (http://rt.perl.org/rt3/Public/Bug/Display.html?id=59650)
101 File::Copy::copy($value->{handle}, $fs_file->stringify);
103 $self->_file_column_callback($value, $self, $column);
105 return $value->{filename};
110 DBIx::Class::InflateColumn::File - map files from the Database to the filesystem.
114 In your L<DBIx::Class> table class:
116 __PACKAGE__->load_components( "PK::Auto", "InflateColumn::File", "Core" );
118 # define your columns
119 __PACKAGE__->add_columns(
122 data_type => "integer",
123 is_auto_increment => 1,
129 data_type => "varchar",
131 file_column_path =>'/tmp/uploaded_files',
132 # or for a Catalyst application
133 # file_column_path => MyApp->path_to('root','static','files'),
134 default_value => undef,
141 In your L<Catalyst::Controller> class:
143 FileColumn requires a hash that contains L<IO::File> as handle and the file's
146 my $entry = $c->model('MyAppDB::Articles')->create({
149 handle => $c->req->upload('myupload')->fh,
150 filename => $c->req->upload('myupload')->basename
154 $c->stash->{entry}=$entry;
157 And Place the following in your TT template
159 Article Subject: [% entry.subject %]
161 <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
162 Body: [% entry.body %]
164 The file will be stored on the filesystem for later retrieval. Calling delete
165 on your resultset will delete the file from the filesystem. Retrevial of the
166 record automatically inflates the column back to the set hash with the
167 IO::File handle and filename.
175 =head2 _file_column_callback ($file,$ret,$target)
177 method made to be overridden for callback purposes.
181 sub _file_column_callback {}
189 This library is free software, you can redistribute it and/or modify
190 it under the same terms as Perl itself.