1package DBIx::Class::InflateColumn::File; 2 3use strict; 4use warnings; 5use base 'DBIx::Class'; 6use File::Path; 7use File::Copy; 8use Path::Class; 9 10__PACKAGE__->load_components(qw/InflateColumn/); 11 12sub register_column { 13 my ($self, $column, $info, @rest) = @_; 14 $self->next::method($column, $info, @rest); 15 return unless defined($info->{is_file_column}); 16 17 $self->inflate_column($column => { 18 inflate => sub { 19 my ($value, $obj) = @_; 20 $obj->_inflate_file_column($column, $value); 21 }, 22 deflate => sub { 23 my ($value, $obj) = @_; 24 $obj->_save_file_column($column, $value); 25 }, 26 }); 27} 28 29sub _file_column_file { 30 my ($self, $column, $filename) = @_; 31 32 my $column_info = $self->column_info($column); 33 34 return unless $column_info->{is_file_column}; 35 36 my $id = $self->id || $self->throw_exception( 37 'id required for filename generation' 38 ); 39 40 $filename ||= $self->$column->{filename}; 41 return Path::Class::file( 42 $column_info->{file_column_path}, $id, $filename, 43 ); 44} 45 46sub delete { 47 my ( $self, @rest ) = @_; 48 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 53 } 54 } 55 56 return $self->next::method(@rest); 57} 58 59sub insert { 60 my $self = shift; 61 62 # cache our file columns so we can write them to the fs 63 # -after- we have a PK 64 my %file_column; 65 for ( $self->columns ) { 66 if ( $self->column_info($_)->{is_file_column} ) { 67 $file_column{$_} = $self->$_; 68 $self->store_column($_ => $self->$_->{filename}); 69 } 70 } 71 72 $self->next::method(@_); 73 74 # write the files to the fs 75 while ( my ($col, $file) = each %file_column ) { 76 $self->_save_file_column($col, $file); 77 } 78 79 return $self; 80} 81 82 83sub _inflate_file_column { 84 my ( $self, $column, $value ) = @_; 85 86 my $fs_file = $self->_file_column_file($column, $value); 87 88 return { handle => $fs_file->open('r'), filename => $value }; 89} 90 91sub _save_file_column { 92 my ( $self, $column, $value ) = @_; 93 94 return unless ref $value; 95 96 my $fs_file = $self->_file_column_file($column, $value->{filename}); 97 mkpath [$fs_file->dir]; 98 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); 102 103 $self->_file_column_callback($value, $self, $column); 104 105 return $value->{filename}; 106} 107 108=head1 NAME 109 110DBIx::Class::InflateColumn::File - map files from the Database to the filesystem. 111 112=head1 SYNOPSIS 113 114In your L<DBIx::Class> table class: 115 116 use base 'DBIx::Class::Core'; 117 118 __PACKAGE__->load_components(qw/InflateColumn::File/); 119 120 # define your columns 121 __PACKAGE__->add_columns( 122 "id", 123 { 124 data_type => "integer", 125 is_auto_increment => 1, 126 is_nullable => 0, 127 size => 4, 128 }, 129 "filename", 130 { 131 data_type => "varchar", 132 is_file_column => 1, 133 file_column_path =>'/tmp/uploaded_files', 134 # or for a Catalyst application 135 # file_column_path => MyApp->path_to('root','static','files'), 136 default_value => undef, 137 is_nullable => 1, 138 size => 255, 139 }, 140 ); 141 142 143In your L<Catalyst::Controller> class: 144 145FileColumn requires a hash that contains L<IO::File> as handle and the file's 146name as name. 147 148 my $entry = $c->model('MyAppDB::Articles')->create({ 149 subject => 'blah', 150 filename => { 151 handle => $c->req->upload('myupload')->fh, 152 filename => $c->req->upload('myupload')->basename 153 }, 154 body => '....' 155 }); 156 $c->stash->{entry}=$entry; 157 158 159And Place the following in your TT template 160 161 Article Subject: [% entry.subject %] 162 Uploaded File: 163 <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a> 164 Body: [% entry.body %] 165 166The file will be stored on the filesystem for later retrieval. Calling delete 167on your resultset will delete the file from the filesystem. Retrevial of the 168record automatically inflates the column back to the set hash with the 169IO::File handle and filename. 170 171=head1 DESCRIPTION 172 173InflateColumn::File 174 175=head1 METHODS 176 177=head2 _file_column_callback ($file,$ret,$target) 178 179Method made to be overridden for callback purposes. 180 181=cut 182 183sub _file_column_callback {} 184 185=head1 AUTHOR 186 187Victor Igumnov 188 189=head1 LICENSE 190 191This library is free software, you can redistribute it and/or modify 192it under the same terms as Perl itself. 193 194=cut 195 1961; 197