1 package DBIx::Class::InflateColumn::File;
5 use base 'DBIx::Class';
11 carp 'InflateColumn::File has entered a deprecation cycle. This component '
12 .'has a number of architectural deficiencies that can quickly drive '
13 .'your filesystem and database out of sync and is not recommended '
14 .'for further use. It will be retained for backwards '
15 .'compatibility, but no new functionality patches will be accepted. '
16 .'Please consider using the much more mature and actively maintained '
17 .'DBIx::Class::InflateColumn::FS. You can set the environment variable '
18 .'DBIC_IC_FILE_NOWARN to a true value to disable this warning.'
19 unless $ENV{DBIC_IC_FILE_NOWARN};
22 __PACKAGE__->load_components(qw/InflateColumn/);
25 my ($self, $column, $info, @rest) = @_;
26 $self->next::method($column, $info, @rest);
27 return unless defined($info->{is_file_column});
29 $self->inflate_column($column => {
31 my ($value, $obj) = @_;
32 $obj->_inflate_file_column($column, $value);
35 my ($value, $obj) = @_;
36 $obj->_save_file_column($column, $value);
41 sub _file_column_file {
42 my ($self, $column, $filename) = @_;
44 my $column_info = $self->result_source->column_info($column);
46 return unless $column_info->{is_file_column};
49 # This call to id() is generally incorrect - will not DTRT on
50 # multicolumn key. However changing this may introduce
51 # backwards-comp regressions, thus leaving as is
52 my $id = $self->id || $self->throw_exception(
53 'id required for filename generation'
56 $filename ||= $self->$column->{filename};
57 return Path::Class::file(
58 $column_info->{file_column_path}, $id, $filename,
63 my ( $self, @rest ) = @_;
65 my $colinfos = $self->result_source->columns_info;
67 for ( keys %$colinfos ) {
68 if ( $colinfos->{$_}{is_file_column} ) {
69 $self->_file_column_file($_)->dir->rmtree;
70 last; # if we've deleted one, we've deleted them all
74 return $self->next::method(@rest);
80 # cache our file columns so we can write them to the fs
81 # -after- we have a PK
82 my $colinfos = $self->result_source->columns_info;
85 for ( keys %$colinfos ) {
86 if ( $colinfos->{$_}{is_file_column} ) {
87 $file_column{$_} = $self->$_;
88 $self->store_column($_ => $self->$_->{filename});
92 $self->next::method(@_);
94 # write the files to the fs
95 while ( my ($col, $file) = each %file_column ) {
96 $self->_save_file_column($col, $file);
103 sub _inflate_file_column {
104 my ( $self, $column, $value ) = @_;
106 my $fs_file = $self->_file_column_file($column, $value);
108 return { handle => $fs_file->open('r'), filename => $value };
111 sub _save_file_column {
112 my ( $self, $column, $value ) = @_;
114 return unless ref $value;
116 my $fs_file = $self->_file_column_file($column, $value->{filename});
117 $fs_file->dir->mkpath;
119 # File::Copy doesn't like Path::Class (or any for that matter) objects,
120 # thus ->stringify (http://rt.perl.org/rt3/Public/Bug/Display.html?id=59650)
121 File::Copy::copy($value->{handle}, $fs_file->stringify);
123 $self->_file_column_callback($value, $self, $column);
125 return $value->{filename};
130 DBIx::Class::InflateColumn::File - DEPRECATED (superseded by DBIx::Class::InflateColumn::FS)
132 =head2 Deprecation Notice
134 This component has a number of architectural deficiencies that can quickly
135 drive your filesystem and database out of sync and is not recommended for
136 further use. It will be retained for backwards compatibility, but no new
137 functionality patches will be accepted. Please consider using the much more
138 mature and actively supported DBIx::Class::InflateColumn::FS. You can set
139 the environment variable DBIC_IC_FILE_NOWARN to a true value to disable
144 In your L<DBIx::Class> table class:
146 use base 'DBIx::Class::Core';
148 __PACKAGE__->load_components(qw/InflateColumn::File/);
150 # define your columns
151 __PACKAGE__->add_columns(
154 data_type => "integer",
155 is_auto_increment => 1,
161 data_type => "varchar",
163 file_column_path =>'/tmp/uploaded_files',
164 # or for a Catalyst application
165 # file_column_path => MyApp->path_to('root','static','files'),
166 default_value => undef,
173 In your L<Catalyst::Controller> class:
175 FileColumn requires a hash that contains L<IO::File> as handle and the file's
178 my $entry = $c->model('MyAppDB::Articles')->create({
181 handle => $c->req->upload('myupload')->fh,
182 filename => $c->req->upload('myupload')->basename
186 $c->stash->{entry}=$entry;
189 And Place the following in your TT template
191 Article Subject: [% entry.subject %]
193 <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
194 Body: [% entry.body %]
196 The file will be stored on the filesystem for later retrieval. Calling delete
197 on your resultset will delete the file from the filesystem. Retrevial of the
198 record automatically inflates the column back to the set hash with the
199 IO::File handle and filename.
207 =head2 _file_column_callback ($file,$ret,$target)
209 Method made to be overridden for callback purposes.
213 sub _file_column_callback {}
215 =head1 FURTHER QUESTIONS?
217 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
219 =head1 COPYRIGHT AND LICENSE
221 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
222 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
223 redistribute it and/or modify it under the same terms as the
224 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.