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