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 use base 'DBIx::Class::Core';
118 __PACKAGE__->load_components(qw/InflateColumn::File/);
120 # define your columns
121 __PACKAGE__->add_columns(
124 data_type => "integer",
125 is_auto_increment => 1,
131 data_type => "varchar",
133 file_column_path =>'/tmp/uploaded_files',
134 # or for a Catalyst application
135 # file_column_path => MyApp->path_to('root','static','files'),
136 default_value => undef,
143 In your L<Catalyst::Controller> class:
145 FileColumn requires a hash that contains L<IO::File> as handle and the file's
148 my $entry = $c->model('MyAppDB::Articles')->create({
151 handle => $c->req->upload('myupload')->fh,
152 filename => $c->req->upload('myupload')->basename
156 $c->stash->{entry}=$entry;
159 And Place the following in your TT template
161 Article Subject: [% entry.subject %]
163 <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
164 Body: [% entry.body %]
166 The file will be stored on the filesystem for later retrieval. Calling delete
167 on your resultset will delete the file from the filesystem. Retrevial of the
168 record automatically inflates the column back to the set hash with the
169 IO::File handle and filename.
177 =head2 _file_column_callback ($file,$ret,$target)
179 Method made to be overridden for callback purposes.
183 sub _file_column_callback {}
191 This library is free software, you can redistribute it and/or modify
192 it under the same terms as Perl itself.