1 package DBIx::Class::InflateColumn::File;
5 use base 'DBIx::Class';
12 carp 'InflateColumn::File has entered a deprecation cycle. This component '
13 .'has a number of architectural deficiencies that can quickly drive '
14 .'your filesystem and database out of sync and is not recommended '
15 .'for further use. It will be retained for backwards '
16 .'compatibility, but no new functionality patches will be accepted. '
17 .'Please consider using the much more mature and actively maintained '
18 .'DBIx::Class::InflateColumn::FS. You can set the environment variable '
19 .'DBIC_IC_FILE_NOWARN to a true value to disable this warning.'
20 unless $ENV{DBIC_IC_FILE_NOWARN};
24 __PACKAGE__->load_components(qw/InflateColumn/);
27 my ($self, $column, $info, @rest) = @_;
28 $self->next::method($column, $info, @rest);
29 return unless defined($info->{is_file_column});
31 $self->inflate_column($column => {
33 my ($value, $obj) = @_;
34 $obj->_inflate_file_column($column, $value);
37 my ($value, $obj) = @_;
38 $obj->_save_file_column($column, $value);
43 sub _file_column_file {
44 my ($self, $column, $filename) = @_;
46 my $column_info = $self->result_source->column_info($column);
48 return unless $column_info->{is_file_column};
51 # This call to id() is generally incorrect - will not DTRT on
52 # multicolumn key. However changing this may introduce
53 # backwards-comp regressions, thus leaving as is
54 my $id = $self->id || $self->throw_exception(
55 'id required for filename generation'
58 $filename ||= $self->$column->{filename};
59 return Path::Class::file(
60 $column_info->{file_column_path}, $id, $filename,
65 my ( $self, @rest ) = @_;
67 my $colinfos = $self->result_source->columns_info;
69 for ( keys %$colinfos ) {
70 if ( $colinfos->{$_}{is_file_column} ) {
71 rmtree( [$self->_file_column_file($_)->dir], 0, 0 );
72 last; # if we've deleted one, we've deleted them all
76 return $self->next::method(@rest);
82 # cache our file columns so we can write them to the fs
83 # -after- we have a PK
84 my $colinfos = $self->result_source->columns_info;
87 for ( keys %$colinfos ) {
88 if ( $colinfos->{$_}{is_file_column} ) {
89 $file_column{$_} = $self->$_;
90 $self->store_column($_ => $self->$_->{filename});
94 $self->next::method(@_);
96 # write the files to the fs
97 while ( my ($col, $file) = each %file_column ) {
98 $self->_save_file_column($col, $file);
105 sub _inflate_file_column {
106 my ( $self, $column, $value ) = @_;
108 my $fs_file = $self->_file_column_file($column, $value);
110 return { handle => $fs_file->open('r'), filename => $value };
113 sub _save_file_column {
114 my ( $self, $column, $value ) = @_;
116 return unless ref $value;
118 my $fs_file = $self->_file_column_file($column, $value->{filename});
119 mkpath [$fs_file->dir];
121 # File::Copy doesn't like Path::Class (or any for that matter) objects,
122 # thus ->stringify (http://rt.perl.org/rt3/Public/Bug/Display.html?id=59650)
123 File::Copy::copy($value->{handle}, $fs_file->stringify);
125 $self->_file_column_callback($value, $self, $column);
127 return $value->{filename};
132 DBIx::Class::InflateColumn::File - DEPRECATED (superseded by DBIx::Class::InflateColumn::FS)
134 =head2 Deprecation Notice
136 This component has a number of architectural deficiencies that can quickly
137 drive your filesystem and database out of sync and is not recommended for
138 further use. It will be retained for backwards compatibility, but no new
139 functionality patches will be accepted. Please consider using the much more
140 mature and actively supported DBIx::Class::InflateColumn::FS. You can set
141 the environment variable DBIC_IC_FILE_NOWARN to a true value to disable
146 In your L<DBIx::Class> table class:
148 use base 'DBIx::Class::Core';
150 __PACKAGE__->load_components(qw/InflateColumn::File/);
152 # define your columns
153 __PACKAGE__->add_columns(
156 data_type => "integer",
157 is_auto_increment => 1,
163 data_type => "varchar",
165 file_column_path =>'/tmp/uploaded_files',
166 # or for a Catalyst application
167 # file_column_path => MyApp->path_to('root','static','files'),
168 default_value => undef,
175 In your L<Catalyst::Controller> class:
177 FileColumn requires a hash that contains L<IO::File> as handle and the file's
180 my $entry = $c->model('MyAppDB::Articles')->create({
183 handle => $c->req->upload('myupload')->fh,
184 filename => $c->req->upload('myupload')->basename
188 $c->stash->{entry}=$entry;
191 And Place the following in your TT template
193 Article Subject: [% entry.subject %]
195 <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
196 Body: [% entry.body %]
198 The file will be stored on the filesystem for later retrieval. Calling delete
199 on your resultset will delete the file from the filesystem. Retrevial of the
200 record automatically inflates the column back to the set hash with the
201 IO::File handle and filename.
209 =head2 _file_column_callback ($file,$ret,$target)
211 Method made to be overridden for callback purposes.
215 sub _file_column_callback {}
217 =head1 FURTHER QUESTIONS?
219 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
221 =head1 COPYRIGHT AND LICENSE
223 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
224 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
225 redistribute it and/or modify it under the same terms as the
226 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.