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