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