1 package DBIx::Class::InflateColumn::File;
8 require DBIx::Class::Optional::Dependencies;
9 if (my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('ic_file') ) {
10 die "The following extra modules are required for DBIx::Class::InflateColumn::File: $missing\n";
14 use base 'DBIx::Class';
16 use DBIx::Class::Carp;
19 carp 'InflateColumn::File has entered a deprecation cycle. This component '
20 .'has a number of architectural deficiencies that can quickly drive '
21 .'your filesystem and database out of sync and is not recommended '
22 .'for further use. It will be retained for backwards '
23 .'compatibility, but no new functionality patches will be accepted. '
24 .'Please consider using the much more mature and actively maintained '
25 .'DBIx::Class::InflateColumn::FS. You can set the environment variable '
26 .'DBIC_IC_FILE_NOWARN to a true value to disable this warning.'
27 unless $ENV{DBIC_IC_FILE_NOWARN};
30 __PACKAGE__->load_components(qw/InflateColumn/);
33 my ($self, $column, $info, @rest) = @_;
34 $self->next::method($column, $info, @rest);
35 return unless defined($info->{is_file_column});
37 $self->inflate_column($column => {
39 my ($value, $obj) = @_;
40 $obj->_inflate_file_column($column, $value);
43 my ($value, $obj) = @_;
44 $obj->_save_file_column($column, $value);
49 sub _file_column_file {
50 my ($self, $column, $filename) = @_;
52 my $column_info = $self->result_source->column_info($column);
54 return unless $column_info->{is_file_column};
57 # This call to id() is generally incorrect - will not DTRT on
58 # multicolumn key. However changing this may introduce
59 # backwards-comp regressions, thus leaving as is
60 my $id = $self->id || $self->throw_exception(
61 'id required for filename generation'
64 $filename ||= $self->$column->{filename};
65 return Path::Class::file(
66 $column_info->{file_column_path}, $id, $filename,
71 my ( $self, @rest ) = @_;
73 my $colinfos = $self->result_source->columns_info;
75 for ( keys %$colinfos ) {
76 if ( $colinfos->{$_}{is_file_column} ) {
77 $self->_file_column_file($_)->dir->rmtree;
78 last; # if we've deleted one, we've deleted them all
82 return $self->next::method(@rest);
88 # cache our file columns so we can write them to the fs
89 # -after- we have a PK
90 my $colinfos = $self->result_source->columns_info;
93 for ( keys %$colinfos ) {
94 if ( $colinfos->{$_}{is_file_column} ) {
95 $file_column{$_} = $self->$_;
96 $self->store_column($_ => $self->$_->{filename});
100 $self->next::method(@_);
102 # write the files to the fs
103 while ( my ($col, $file) = each %file_column ) {
104 $self->_save_file_column($col, $file);
111 sub _inflate_file_column {
112 my ( $self, $column, $value ) = @_;
114 my $fs_file = $self->_file_column_file($column, $value);
116 return { handle => $fs_file->open('r'), filename => $value };
119 sub _save_file_column {
120 my ( $self, $column, $value ) = @_;
122 return unless ref $value;
124 my $fs_file = $self->_file_column_file($column, $value->{filename});
125 $fs_file->dir->mkpath;
127 # File::Copy doesn't like Path::Class (or any for that matter) objects,
128 # thus ->stringify (http://rt.perl.org/rt3/Public/Bug/Display.html?id=59650)
129 File::Copy::copy($value->{handle}, $fs_file->stringify);
131 $self->_file_column_callback($value, $self, $column);
133 return $value->{filename};
138 DBIx::Class::InflateColumn::File - DEPRECATED (superseded by DBIx::Class::InflateColumn::FS)
140 =head2 Deprecation Notice
142 This component has a number of architectural deficiencies that can quickly
143 drive your filesystem and database out of sync and is not recommended for
144 further use. It will be retained for backwards compatibility, but no new
145 functionality patches will be accepted. Please consider using the much more
146 mature and actively supported DBIx::Class::InflateColumn::FS. You can set
147 the environment variable DBIC_IC_FILE_NOWARN to a true value to disable
152 In your L<DBIx::Class> table class:
154 use base 'DBIx::Class::Core';
156 __PACKAGE__->load_components(qw/InflateColumn::File/);
158 # define your columns
159 __PACKAGE__->add_columns(
162 data_type => "integer",
163 is_auto_increment => 1,
169 data_type => "varchar",
171 file_column_path =>'/tmp/uploaded_files',
172 # or for a Catalyst application
173 # file_column_path => MyApp->path_to('root','static','files'),
174 default_value => undef,
181 In your L<Catalyst::Controller> class:
183 FileColumn requires a hash that contains L<IO::File> as handle and the file's
186 my $entry = $c->model('MyAppDB::Articles')->create({
189 handle => $c->req->upload('myupload')->fh,
190 filename => $c->req->upload('myupload')->basename
194 $c->stash->{entry}=$entry;
197 And Place the following in your TT template
199 Article Subject: [% entry.subject %]
201 <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
202 Body: [% entry.body %]
204 The file will be stored on the filesystem for later retrieval. Calling delete
205 on your resultset will delete the file from the filesystem. Retrevial of the
206 record automatically inflates the column back to the set hash with the
207 IO::File handle and filename.
215 =head2 _file_column_callback ($file,$ret,$target)
217 Method made to be overridden for callback purposes.
221 sub _file_column_callback {}
223 =head1 FURTHER QUESTIONS?
225 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
227 =head1 COPYRIGHT AND LICENSE
229 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
230 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
231 redistribute it and/or modify it under the same terms as the
232 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.