Replicated - fixup types and namespace::clean
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / InflateColumn / File.pm
CommitLineData
5acaa54e 1package DBIx::Class::InflateColumn::File;
4740bdb7 2
3use strict;
4use warnings;
5use base 'DBIx::Class';
6use File::Path;
7use File::Copy;
26ddc864 8use Path::Class;
4740bdb7 9
28d4067a 10__PACKAGE__->load_components(qw/InflateColumn/);
4740bdb7 11
28d4067a 12sub 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 29sub _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
46sub 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 59sub 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 83sub _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
91sub _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];
f6ace689 98
99 # File::Copy doesn't like Path::Class (or any for that matter) objects,
100 # thus ->stringify (http://rt.perl.org/rt3/Public/Bug/Display.html?id=59650)
101 File::Copy::copy($value->{handle}, $fs_file->stringify);
26ddc864 102
103 $self->_file_column_callback($value, $self, $column);
104
105 return $value->{filename};
4740bdb7 106}
107
108=head1 NAME
109
28d4067a 110DBIx::Class::InflateColumn::File - map files from the Database to the filesystem.
4740bdb7 111
4740bdb7 112=head1 SYNOPSIS
113
114In your L<DBIx::Class> table class:
115
28d4067a 116 __PACKAGE__->load_components( "PK::Auto", "InflateColumn::File", "Core" );
4740bdb7 117
118 # define your columns
119 __PACKAGE__->add_columns(
120 "id",
121 {
122 data_type => "integer",
123 is_auto_increment => 1,
124 is_nullable => 0,
125 size => 4,
126 },
127 "filename",
128 {
129 data_type => "varchar",
130 is_file_column => 1,
131 file_column_path =>'/tmp/uploaded_files',
132 # or for a Catalyst application
133 # file_column_path => MyApp->path_to('root','static','files'),
134 default_value => undef,
135 is_nullable => 1,
136 size => 255,
137 },
138 );
139
140
141In your L<Catalyst::Controller> class:
142
0876072c 143FileColumn requires a hash that contains L<IO::File> as handle and the file's
144name as name.
4740bdb7 145
146 my $entry = $c->model('MyAppDB::Articles')->create({
147 subject => 'blah',
148 filename => {
149 handle => $c->req->upload('myupload')->fh,
150 filename => $c->req->upload('myupload')->basename
151 },
152 body => '....'
153 });
154 $c->stash->{entry}=$entry;
155
156
157And Place the following in your TT template
158
159 Article Subject: [% entry.subject %]
160 Uploaded File:
161 <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
162 Body: [% entry.body %]
163
0876072c 164The file will be stored on the filesystem for later retrieval. Calling delete
165on your resultset will delete the file from the filesystem. Retrevial of the
166record automatically inflates the column back to the set hash with the
167IO::File handle and filename.
168
169=head1 DESCRIPTION
170
171InflateColumn::File
172
173=head1 METHODS
174
175=head2 _file_column_callback ($file,$ret,$target)
176
177method made to be overridden for callback purposes.
178
179=cut
180
26ddc864 181sub _file_column_callback {}
4740bdb7 182
183=head1 AUTHOR
184
185Victor Igumnov
186
187=head1 LICENSE
188
189This library is free software, you can redistribute it and/or modify
190it under the same terms as Perl itself.
191
192=cut
193
1941;