line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::Class::InflateColumn::File; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
1244
|
use strict; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
55
|
|
4
|
2
|
|
|
2
|
|
8
|
use warnings; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
120
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
# check deps |
7
|
|
|
|
|
|
|
BEGIN { |
8
|
2
|
|
|
2
|
|
11
|
require DBIx::Class::Optional::Dependencies; |
9
|
2
|
50
|
|
|
|
15
|
if (my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('ic_file') ) { |
10
|
2
|
|
|
|
|
38
|
die "The following extra modules are required for DBIx::Class::InflateColumn::File: $missing\n"; |
11
|
|
|
|
|
|
|
} |
12
|
|
|
|
|
|
|
} |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use base 'DBIx::Class'; |
15
|
|
|
|
|
|
|
use File::Copy; |
16
|
|
|
|
|
|
|
use DBIx::Class::Carp; |
17
|
|
|
|
|
|
|
use namespace::clean; |
18
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
__PACKAGE__->load_components(qw/InflateColumn/); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub register_column { |
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 => { |
38
|
|
|
|
|
|
|
inflate => sub { |
39
|
|
|
|
|
|
|
my ($value, $obj) = @_; |
40
|
|
|
|
|
|
|
$obj->_inflate_file_column($column, $value); |
41
|
|
|
|
|
|
|
}, |
42
|
|
|
|
|
|
|
deflate => sub { |
43
|
|
|
|
|
|
|
my ($value, $obj) = @_; |
44
|
|
|
|
|
|
|
$obj->_save_file_column($column, $value); |
45
|
|
|
|
|
|
|
}, |
46
|
|
|
|
|
|
|
}); |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub _file_column_file { |
50
|
|
|
|
|
|
|
my ($self, $column, $filename) = @_; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
my $column_info = $self->result_source->columns_info->{$column}; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
return unless $column_info->{is_file_column}; |
55
|
|
|
|
|
|
|
|
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 |
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
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub delete { |
71
|
|
|
|
|
|
|
my ( $self, @rest ) = @_; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
my $colinfos = $self->result_source->columns_info; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
for ( keys %$colinfos ) { |
76
|
|
|
|
|
|
|
if ( $colinfos->{$_}{is_file_column} ) { |
77
|
|
|
|
|
|
|
$self->_file_column_file($_)->dir->rmtree; |
78
|
|
|
|
|
|
|
last; # if we've deleted one, we've deleted them all |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
return $self->next::method(@rest); |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub insert { |
86
|
|
|
|
|
|
|
my $self = shift; |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# cache our file columns so we can write them to the fs |
89
|
|
|
|
|
|
|
# -after- we have a PK |
90
|
|
|
|
|
|
|
my $colinfos = $self->result_source->columns_info; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
my %file_column; |
93
|
|
|
|
|
|
|
for ( keys %$colinfos ) { |
94
|
|
|
|
|
|
|
if ( $colinfos->{$_}{is_file_column} ) { |
95
|
|
|
|
|
|
|
$file_column{$_} = $self->$_; |
96
|
|
|
|
|
|
|
$self->store_column($_ => $self->$_->{filename}); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
} |
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; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub _inflate_file_column { |
112
|
|
|
|
|
|
|
my ( $self, $column, $value ) = @_; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
my $fs_file = $self->_file_column_file($column, $value); |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
return { handle => $fs_file->open('r'), filename => $value }; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub _save_file_column { |
120
|
|
|
|
|
|
|
my ( $self, $column, $value ) = @_; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
return unless ref $value; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
my $fs_file = $self->_file_column_file($column, $value->{filename}); |
125
|
|
|
|
|
|
|
$fs_file->dir->mkpath; |
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); |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
$self->_file_column_callback($value, $self, $column); |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
return $value->{filename}; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head1 NAME |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
DBIx::Class::InflateColumn::File - DEPRECATED (superseded by DBIx::Class::InflateColumn::FS) |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=head2 Deprecation Notice |
141
|
|
|
|
|
|
|
|
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. |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=head1 SYNOPSIS |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
In your L table class: |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
use base 'DBIx::Class::Core'; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
__PACKAGE__->load_components(qw/InflateColumn::File/); |
157
|
|
|
|
|
|
|
|
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', |
172
|
|
|
|
|
|
|
# or for a Catalyst application |
173
|
|
|
|
|
|
|
# file_column_path => MyApp->path_to('root','static','files'), |
174
|
|
|
|
|
|
|
default_value => undef, |
175
|
|
|
|
|
|
|
is_nullable => 1, |
176
|
|
|
|
|
|
|
size => 255, |
177
|
|
|
|
|
|
|
}, |
178
|
|
|
|
|
|
|
); |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
In your L class: |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
FileColumn requires a hash that contains L as handle and the file's |
184
|
|
|
|
|
|
|
name as name. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
my $entry = $c->model('MyAppDB::Articles')->create({ |
187
|
|
|
|
|
|
|
subject => 'blah', |
188
|
|
|
|
|
|
|
filename => { |
189
|
|
|
|
|
|
|
handle => $c->req->upload('myupload')->fh, |
190
|
|
|
|
|
|
|
filename => $c->req->upload('myupload')->basename |
191
|
|
|
|
|
|
|
}, |
192
|
|
|
|
|
|
|
body => '....' |
193
|
|
|
|
|
|
|
}); |
194
|
|
|
|
|
|
|
$c->stash->{entry}=$entry; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
And Place the following in your TT template |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
Article Subject: [% entry.subject %] |
200
|
|
|
|
|
|
|
Uploaded File: |
201
|
|
|
|
|
|
|
File |
202
|
|
|
|
|
|
|
Body: [% entry.body %] |
203
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
Method made to be overridden for callback purposes. |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=cut |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
sub _file_column_callback {} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=head1 FURTHER QUESTIONS? |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
Check the list of L. |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
This module is free software L |
230
|
|
|
|
|
|
|
by the L. You can |
231
|
|
|
|
|
|
|
redistribute it and/or modify it under the same terms as the |
232
|
|
|
|
|
|
|
L. |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=cut |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
1; |