makes search_related on extended rels without the optimized version work. involves...
[dbsrgits/DBIx-Class-Historic.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;
26ddc864 8use Path::Class;
4740bdb7 9
3814fdad 10use Carp::Clan qw/^DBIx::Class/;
11carp 'InflateColumn::File has entered a deprecation cycle. This component '
12 .'has a number of architectural deficiencies that can quickly drive '
13 .'your filesystem and database out of sync and is not recommended '
14 .'for further use. It will be retained for backwards '
15 .'compatibility, but no new functionality patches will be accepted. '
16 .'Please consider using the much more mature and actively maintained '
17 .'DBIx::Class::InflateColumn::FS. You can set the environment variable '
18 .'DBIC_IC_FILE_NOWARN to a true value to disable this warning.'
19unless $ENV{DBIC_IC_FILE_NOWARN};
20
28d4067a 21__PACKAGE__->load_components(qw/InflateColumn/);
4740bdb7 22
28d4067a 23sub register_column {
26ddc864 24 my ($self, $column, $info, @rest) = @_;
25 $self->next::method($column, $info, @rest);
26 return unless defined($info->{is_file_column});
27
28 $self->inflate_column($column => {
29 inflate => sub {
23f067d1 30 my ($value, $obj) = @_;
26ddc864 31 $obj->_inflate_file_column($column, $value);
32 },
33 deflate => sub {
23f067d1 34 my ($value, $obj) = @_;
26ddc864 35 $obj->_save_file_column($column, $value);
36 },
37 });
4740bdb7 38}
39
26ddc864 40sub _file_column_file {
41 my ($self, $column, $filename) = @_;
42
43 my $column_info = $self->column_info($column);
44
45 return unless $column_info->{is_file_column};
46
47 my $id = $self->id || $self->throw_exception(
48 'id required for filename generation'
49 );
50
51 $filename ||= $self->$column->{filename};
52 return Path::Class::file(
53 $column_info->{file_column_path}, $id, $filename,
54 );
55}
4740bdb7 56
57sub delete {
58 my ( $self, @rest ) = @_;
59
26ddc864 60 for ( $self->columns ) {
4740bdb7 61 if ( $self->column_info($_)->{is_file_column} ) {
26ddc864 62 rmtree( [$self->_file_column_file($_)->dir], 0, 0 );
63 last; # if we've deleted one, we've deleted them all
4740bdb7 64 }
65 }
66
26ddc864 67 return $self->next::method(@rest);
4740bdb7 68}
69
26ddc864 70sub insert {
4740bdb7 71 my $self = shift;
d4daee7b 72
26ddc864 73 # cache our file columns so we can write them to the fs
74 # -after- we have a PK
75 my %file_column;
76 for ( $self->columns ) {
28d4067a 77 if ( $self->column_info($_)->{is_file_column} ) {
26ddc864 78 $file_column{$_} = $self->$_;
79 $self->store_column($_ => $self->$_->{filename});
4740bdb7 80 }
81 }
26ddc864 82
83 $self->next::method(@_);
84
85 # write the files to the fs
86 while ( my ($col, $file) = each %file_column ) {
87 $self->_save_file_column($col, $file);
88 }
89
90 return $self;
4740bdb7 91}
92
4740bdb7 93
26ddc864 94sub _inflate_file_column {
95 my ( $self, $column, $value ) = @_;
4740bdb7 96
26ddc864 97 my $fs_file = $self->_file_column_file($column, $value);
4740bdb7 98
26ddc864 99 return { handle => $fs_file->open('r'), filename => $value };
4740bdb7 100}
101
102sub _save_file_column {
26ddc864 103 my ( $self, $column, $value ) = @_;
104
105 return unless ref $value;
106
107 my $fs_file = $self->_file_column_file($column, $value->{filename});
108 mkpath [$fs_file->dir];
f6ace689 109
110 # File::Copy doesn't like Path::Class (or any for that matter) objects,
111 # thus ->stringify (http://rt.perl.org/rt3/Public/Bug/Display.html?id=59650)
112 File::Copy::copy($value->{handle}, $fs_file->stringify);
26ddc864 113
114 $self->_file_column_callback($value, $self, $column);
115
116 return $value->{filename};
4740bdb7 117}
118
119=head1 NAME
120
5847820e 121DBIx::Class::InflateColumn::File - DEPRECATED (superseded by DBIx::Class::InflateColumn::FS)
122
123=head2 Deprecation Notice
124
3814fdad 125 This component has a number of architectural deficiencies that can quickly
126 drive your filesystem and database out of sync and is not recommended for
127 further use. It will be retained for backwards compatibility, but no new
128 functionality patches will be accepted. Please consider using the much more
129 mature and actively supported DBIx::Class::InflateColumn::FS. You can set
130 the environment variable DBIC_IC_FILE_NOWARN to a true value to disable
131 this warning.
4740bdb7 132
4740bdb7 133=head1 SYNOPSIS
134
135In your L<DBIx::Class> table class:
136
d88ecca6 137 use base 'DBIx::Class::Core';
138
139 __PACKAGE__->load_components(qw/InflateColumn::File/);
d4daee7b 140
4740bdb7 141 # define your columns
142 __PACKAGE__->add_columns(
143 "id",
144 {
145 data_type => "integer",
146 is_auto_increment => 1,
147 is_nullable => 0,
148 size => 4,
149 },
150 "filename",
151 {
152 data_type => "varchar",
153 is_file_column => 1,
154 file_column_path =>'/tmp/uploaded_files',
155 # or for a Catalyst application
156 # file_column_path => MyApp->path_to('root','static','files'),
157 default_value => undef,
158 is_nullable => 1,
159 size => 255,
160 },
161 );
d4daee7b 162
4740bdb7 163
164In your L<Catalyst::Controller> class:
165
0876072c 166FileColumn requires a hash that contains L<IO::File> as handle and the file's
167name as name.
4740bdb7 168
169 my $entry = $c->model('MyAppDB::Articles')->create({
170 subject => 'blah',
171 filename => {
172 handle => $c->req->upload('myupload')->fh,
173 filename => $c->req->upload('myupload')->basename
174 },
175 body => '....'
176 });
177 $c->stash->{entry}=$entry;
d4daee7b 178
4740bdb7 179
180And Place the following in your TT template
d4daee7b 181
4740bdb7 182 Article Subject: [% entry.subject %]
183 Uploaded File:
184 <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
185 Body: [% entry.body %]
d4daee7b 186
0876072c 187The file will be stored on the filesystem for later retrieval. Calling delete
188on your resultset will delete the file from the filesystem. Retrevial of the
189record automatically inflates the column back to the set hash with the
190IO::File handle and filename.
191
192=head1 DESCRIPTION
193
194InflateColumn::File
195
196=head1 METHODS
197
198=head2 _file_column_callback ($file,$ret,$target)
199
48580715 200Method made to be overridden for callback purposes.
0876072c 201
202=cut
203
26ddc864 204sub _file_column_callback {}
4740bdb7 205
206=head1 AUTHOR
207
208Victor Igumnov
209
210=head1 LICENSE
211
212This library is free software, you can redistribute it and/or modify
213it under the same terms as Perl itself.
214
215=cut
216
2171;