Commit | Line | Data |
5acaa54e |
1 | package DBIx::Class::InflateColumn::File; |
4740bdb7 |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use base 'DBIx::Class'; |
6 | use File::Path; |
7 | use File::Copy; |
26ddc864 |
8 | use Path::Class; |
4740bdb7 |
9 | |
28d4067a |
10 | __PACKAGE__->load_components(qw/InflateColumn/); |
4740bdb7 |
11 | |
28d4067a |
12 | sub register_column { |
26ddc864 |
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 { |
23f067d1 |
19 | my ($value, $obj) = @_; |
26ddc864 |
20 | $obj->_inflate_file_column($column, $value); |
21 | }, |
22 | deflate => sub { |
23f067d1 |
23 | my ($value, $obj) = @_; |
26ddc864 |
24 | $obj->_save_file_column($column, $value); |
25 | }, |
26 | }); |
4740bdb7 |
27 | } |
28 | |
26ddc864 |
29 | sub _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 | } |
4740bdb7 |
45 | |
46 | sub delete { |
47 | my ( $self, @rest ) = @_; |
48 | |
26ddc864 |
49 | for ( $self->columns ) { |
4740bdb7 |
50 | if ( $self->column_info($_)->{is_file_column} ) { |
26ddc864 |
51 | rmtree( [$self->_file_column_file($_)->dir], 0, 0 ); |
52 | last; # if we've deleted one, we've deleted them all |
4740bdb7 |
53 | } |
54 | } |
55 | |
26ddc864 |
56 | return $self->next::method(@rest); |
4740bdb7 |
57 | } |
58 | |
26ddc864 |
59 | sub insert { |
4740bdb7 |
60 | my $self = shift; |
26ddc864 |
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 ) { |
28d4067a |
66 | if ( $self->column_info($_)->{is_file_column} ) { |
26ddc864 |
67 | $file_column{$_} = $self->$_; |
68 | $self->store_column($_ => $self->$_->{filename}); |
4740bdb7 |
69 | } |
70 | } |
26ddc864 |
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; |
4740bdb7 |
80 | } |
81 | |
4740bdb7 |
82 | |
26ddc864 |
83 | sub _inflate_file_column { |
84 | my ( $self, $column, $value ) = @_; |
4740bdb7 |
85 | |
26ddc864 |
86 | my $fs_file = $self->_file_column_file($column, $value); |
4740bdb7 |
87 | |
26ddc864 |
88 | return { handle => $fs_file->open('r'), filename => $value }; |
4740bdb7 |
89 | } |
90 | |
91 | sub _save_file_column { |
26ddc864 |
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 | |
ea78b3e6 |
99 | File::Copy::copy($value->{handle}, $fs_file->stringify); # File::Copy doesn't like Path::Class (or any for that matter) objects |
26ddc864 |
100 | |
101 | $self->_file_column_callback($value, $self, $column); |
102 | |
103 | return $value->{filename}; |
4740bdb7 |
104 | } |
105 | |
106 | =head1 NAME |
107 | |
28d4067a |
108 | DBIx::Class::InflateColumn::File - map files from the Database to the filesystem. |
4740bdb7 |
109 | |
4740bdb7 |
110 | =head1 SYNOPSIS |
111 | |
112 | In your L<DBIx::Class> table class: |
113 | |
28d4067a |
114 | __PACKAGE__->load_components( "PK::Auto", "InflateColumn::File", "Core" ); |
4740bdb7 |
115 | |
116 | # define your columns |
117 | __PACKAGE__->add_columns( |
118 | "id", |
119 | { |
120 | data_type => "integer", |
121 | is_auto_increment => 1, |
122 | is_nullable => 0, |
123 | size => 4, |
124 | }, |
125 | "filename", |
126 | { |
127 | data_type => "varchar", |
128 | is_file_column => 1, |
129 | file_column_path =>'/tmp/uploaded_files', |
130 | # or for a Catalyst application |
131 | # file_column_path => MyApp->path_to('root','static','files'), |
132 | default_value => undef, |
133 | is_nullable => 1, |
134 | size => 255, |
135 | }, |
136 | ); |
137 | |
138 | |
139 | In your L<Catalyst::Controller> class: |
140 | |
0876072c |
141 | FileColumn requires a hash that contains L<IO::File> as handle and the file's |
142 | name as name. |
4740bdb7 |
143 | |
144 | my $entry = $c->model('MyAppDB::Articles')->create({ |
145 | subject => 'blah', |
146 | filename => { |
147 | handle => $c->req->upload('myupload')->fh, |
148 | filename => $c->req->upload('myupload')->basename |
149 | }, |
150 | body => '....' |
151 | }); |
152 | $c->stash->{entry}=$entry; |
153 | |
154 | |
155 | And Place the following in your TT template |
156 | |
157 | Article Subject: [% entry.subject %] |
158 | Uploaded File: |
159 | <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a> |
160 | Body: [% entry.body %] |
161 | |
0876072c |
162 | The file will be stored on the filesystem for later retrieval. Calling delete |
163 | on your resultset will delete the file from the filesystem. Retrevial of the |
164 | record automatically inflates the column back to the set hash with the |
165 | IO::File handle and filename. |
166 | |
167 | =head1 DESCRIPTION |
168 | |
169 | InflateColumn::File |
170 | |
171 | =head1 METHODS |
172 | |
173 | =head2 _file_column_callback ($file,$ret,$target) |
174 | |
175 | method made to be overridden for callback purposes. |
176 | |
177 | =cut |
178 | |
26ddc864 |
179 | sub _file_column_callback {} |
4740bdb7 |
180 | |
181 | =head1 AUTHOR |
182 | |
183 | Victor Igumnov |
184 | |
185 | =head1 LICENSE |
186 | |
187 | This library is free software, you can redistribute it and/or modify |
188 | it under the same terms as Perl itself. |
189 | |
190 | =cut |
191 | |
192 | 1; |