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