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};
50 my $id = $self->id || $self->throw_exception(
51 'id required for filename generation'
54 $filename ||= $self->$column->{filename};
55 return Path::Class::file(
56 $column_info->{file_column_path}, $id, $filename,
61 my ( $self, @rest ) = @_;
63 my $colinfos = $self->result_source->columns_info;
65 for ( keys %$colinfos ) {
66 if ( $colinfos->{$_}{is_file_column} ) {
67 rmtree( [$self->_file_column_file($_)->dir], 0, 0 );
68 last; # if we've deleted one, we've deleted them all
72 return $self->next::method(@rest);
78 # cache our file columns so we can write them to the fs
79 # -after- we have a PK
80 my $colinfos = $self->result_source->columns_info;
83 for ( keys %$colinfos ) {
84 if ( $colinfos->{$_}{is_file_column} ) {
85 $file_column{$_} = $self->$_;
86 $self->store_column($_ => $self->$_->{filename});
90 $self->next::method(@_);
92 # write the files to the fs
93 while ( my ($col, $file) = each %file_column ) {
94 $self->_save_file_column($col, $file);
101 sub _inflate_file_column {
102 my ( $self, $column, $value ) = @_;
104 my $fs_file = $self->_file_column_file($column, $value);
106 return { handle => $fs_file->open('r'), filename => $value };
109 sub _save_file_column {
110 my ( $self, $column, $value ) = @_;
112 return unless ref $value;
114 my $fs_file = $self->_file_column_file($column, $value->{filename});
115 mkpath [$fs_file->dir];
117 # File::Copy doesn't like Path::Class (or any for that matter) objects,
118 # thus ->stringify (http://rt.perl.org/rt3/Public/Bug/Display.html?id=59650)
119 File::Copy::copy($value->{handle}, $fs_file->stringify);
121 $self->_file_column_callback($value, $self, $column);
123 return $value->{filename};
128 DBIx::Class::InflateColumn::File - DEPRECATED (superseded by DBIx::Class::InflateColumn::FS)
130 =head2 Deprecation Notice
132 This component has a number of architectural deficiencies that can quickly
133 drive your filesystem and database out of sync and is not recommended for
134 further use. It will be retained for backwards compatibility, but no new
135 functionality patches will be accepted. Please consider using the much more
136 mature and actively supported DBIx::Class::InflateColumn::FS. You can set
137 the environment variable DBIC_IC_FILE_NOWARN to a true value to disable
142 In your L<DBIx::Class> table class:
144 use base 'DBIx::Class::Core';
146 __PACKAGE__->load_components(qw/InflateColumn::File/);
148 # define your columns
149 __PACKAGE__->add_columns(
152 data_type => "integer",
153 is_auto_increment => 1,
159 data_type => "varchar",
161 file_column_path =>'/tmp/uploaded_files',
162 # or for a Catalyst application
163 # file_column_path => MyApp->path_to('root','static','files'),
164 default_value => undef,
171 In your L<Catalyst::Controller> class:
173 FileColumn requires a hash that contains L<IO::File> as handle and the file's
176 my $entry = $c->model('MyAppDB::Articles')->create({
179 handle => $c->req->upload('myupload')->fh,
180 filename => $c->req->upload('myupload')->basename
184 $c->stash->{entry}=$entry;
187 And Place the following in your TT template
189 Article Subject: [% entry.subject %]
191 <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
192 Body: [% entry.body %]
194 The file will be stored on the filesystem for later retrieval. Calling delete
195 on your resultset will delete the file from the filesystem. Retrevial of the
196 record automatically inflates the column back to the set hash with the
197 IO::File handle and filename.
205 =head2 _file_column_callback ($file,$ret,$target)
207 Method made to be overridden for callback purposes.
211 sub _file_column_callback {}
219 This library is free software, you can redistribute it and/or modify
220 it under the same terms as Perl itself.