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 - DEPRECATED (superseded by DBIx::Class::InflateColumn::FS)
112 =head2 Deprecation Notice
114 This component has a number of architectural deficiencies and is not
115 recommended for further use. It will be retained for backwards
116 compatibility, but no new functionality patches will be accepted.
117 Please consider using the much more mature and actively supported
118 DBIx::Class::InflateColumn::FS
122 In your L<DBIx::Class> table class:
124 use base 'DBIx::Class::Core';
126 __PACKAGE__->load_components(qw/InflateColumn::File/);
128 # define your columns
129 __PACKAGE__->add_columns(
132 data_type => "integer",
133 is_auto_increment => 1,
139 data_type => "varchar",
141 file_column_path =>'/tmp/uploaded_files',
142 # or for a Catalyst application
143 # file_column_path => MyApp->path_to('root','static','files'),
144 default_value => undef,
151 In your L<Catalyst::Controller> class:
153 FileColumn requires a hash that contains L<IO::File> as handle and the file's
156 my $entry = $c->model('MyAppDB::Articles')->create({
159 handle => $c->req->upload('myupload')->fh,
160 filename => $c->req->upload('myupload')->basename
164 $c->stash->{entry}=$entry;
167 And Place the following in your TT template
169 Article Subject: [% entry.subject %]
171 <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
172 Body: [% entry.body %]
174 The file will be stored on the filesystem for later retrieval. Calling delete
175 on your resultset will delete the file from the filesystem. Retrevial of the
176 record automatically inflates the column back to the set hash with the
177 IO::File handle and filename.
185 =head2 _file_column_callback ($file,$ret,$target)
187 method made to be overridden for callback purposes.
191 sub _file_column_callback {}
199 This library is free software, you can redistribute it and/or modify
200 it under the same terms as Perl itself.