makes search_related on extended rels without the optimized version work. involves...
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / InflateColumn / File.pm
1 package DBIx::Class::InflateColumn::File;
2
3 use strict;
4 use warnings;
5 use base 'DBIx::Class';
6 use File::Path;
7 use File::Copy;
8 use Path::Class;
9
10 use Carp::Clan qw/^DBIx::Class/;
11 carp 'InflateColumn::File has entered a deprecation cycle. This component '
12     .'has a number of architectural deficiencies that can quickly drive '
13     .'your filesystem and database out of sync and is not recommended '
14     .'for further use. It will be retained for backwards '
15     .'compatibility, but no new functionality patches will be accepted. '
16     .'Please consider using the much more mature and actively maintained '
17     .'DBIx::Class::InflateColumn::FS. You can set the environment variable '
18     .'DBIC_IC_FILE_NOWARN to a true value to disable  this warning.'
19 unless $ENV{DBIC_IC_FILE_NOWARN};
20
21 __PACKAGE__->load_components(qw/InflateColumn/);
22
23 sub register_column {
24     my ($self, $column, $info, @rest) = @_;
25     $self->next::method($column, $info, @rest);
26     return unless defined($info->{is_file_column});
27
28     $self->inflate_column($column => {
29         inflate => sub { 
30             my ($value, $obj) = @_;
31             $obj->_inflate_file_column($column, $value);
32         },
33         deflate => sub {
34             my ($value, $obj) = @_;
35             $obj->_save_file_column($column, $value);
36         },
37     });
38 }
39
40 sub _file_column_file {
41     my ($self, $column, $filename) = @_;
42
43     my $column_info = $self->column_info($column);
44
45     return unless $column_info->{is_file_column};
46
47     my $id = $self->id || $self->throw_exception(
48         'id required for filename generation'
49     );
50
51     $filename ||= $self->$column->{filename};
52     return Path::Class::file(
53         $column_info->{file_column_path}, $id, $filename,
54     );
55 }
56
57 sub delete {
58     my ( $self, @rest ) = @_;
59
60     for ( $self->columns ) {
61         if ( $self->column_info($_)->{is_file_column} ) {
62             rmtree( [$self->_file_column_file($_)->dir], 0, 0 );
63             last; # if we've deleted one, we've deleted them all
64         }
65     }
66
67     return $self->next::method(@rest);
68 }
69
70 sub insert {
71     my $self = shift;
72
73     # cache our file columns so we can write them to the fs
74     # -after- we have a PK
75     my %file_column;
76     for ( $self->columns ) {
77         if ( $self->column_info($_)->{is_file_column} ) {
78             $file_column{$_} = $self->$_;
79             $self->store_column($_ => $self->$_->{filename});
80         }
81     }
82
83     $self->next::method(@_);
84
85     # write the files to the fs
86     while ( my ($col, $file) = each %file_column ) {
87         $self->_save_file_column($col, $file);
88     }
89
90     return $self;
91 }
92
93
94 sub _inflate_file_column {
95     my ( $self, $column, $value ) = @_;
96
97     my $fs_file = $self->_file_column_file($column, $value);
98
99     return { handle => $fs_file->open('r'), filename => $value };
100 }
101
102 sub _save_file_column {
103     my ( $self, $column, $value ) = @_;
104
105     return unless ref $value;
106
107     my $fs_file = $self->_file_column_file($column, $value->{filename});
108     mkpath [$fs_file->dir];
109
110     # File::Copy doesn't like Path::Class (or any for that matter) objects,
111     # thus ->stringify (http://rt.perl.org/rt3/Public/Bug/Display.html?id=59650)
112     File::Copy::copy($value->{handle}, $fs_file->stringify);
113
114     $self->_file_column_callback($value, $self, $column);
115
116     return $value->{filename};
117 }
118
119 =head1 NAME
120
121 DBIx::Class::InflateColumn::File -  DEPRECATED (superseded by DBIx::Class::InflateColumn::FS)
122
123 =head2 Deprecation Notice
124
125  This component has a number of architectural deficiencies that can quickly
126  drive your filesystem and database out of sync and is not recommended for
127  further use. It will be retained for backwards compatibility, but no new
128  functionality patches will be accepted. Please consider using the much more
129  mature and actively supported DBIx::Class::InflateColumn::FS. You can set
130  the environment variable DBIC_IC_FILE_NOWARN to a true value to disable
131  this warning.
132
133 =head1 SYNOPSIS
134
135 In your L<DBIx::Class> table class:
136
137     use base 'DBIx::Class::Core';
138
139     __PACKAGE__->load_components(qw/InflateColumn::File/);
140
141     # define your columns
142     __PACKAGE__->add_columns(
143         "id",
144         {
145             data_type         => "integer",
146             is_auto_increment => 1,
147             is_nullable       => 0,
148             size              => 4,
149         },
150         "filename",
151         {
152             data_type           => "varchar",
153             is_file_column      => 1,
154             file_column_path    =>'/tmp/uploaded_files',
155             # or for a Catalyst application 
156             # file_column_path  => MyApp->path_to('root','static','files'),
157             default_value       => undef,
158             is_nullable         => 1,
159             size                => 255,
160         },
161     );
162
163
164 In your L<Catalyst::Controller> class:
165
166 FileColumn requires a hash that contains L<IO::File> as handle and the file's
167 name as name.
168
169     my $entry = $c->model('MyAppDB::Articles')->create({ 
170         subject => 'blah',
171         filename => { 
172             handle => $c->req->upload('myupload')->fh, 
173             filename => $c->req->upload('myupload')->basename 
174         },
175         body => '....'
176     });
177     $c->stash->{entry}=$entry;
178
179
180 And Place the following in your TT template
181
182     Article Subject: [% entry.subject %]
183     Uploaded File: 
184     <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
185     Body: [% entry.body %]
186
187 The file will be stored on the filesystem for later retrieval.  Calling delete
188 on your resultset will delete the file from the filesystem.  Retrevial of the
189 record automatically inflates the column back to the set hash with the
190 IO::File handle and filename.
191
192 =head1 DESCRIPTION
193
194 InflateColumn::File
195
196 =head1 METHODS
197
198 =head2 _file_column_callback ($file,$ret,$target)
199
200 Method made to be overridden for callback purposes.
201
202 =cut
203
204 sub _file_column_callback {}
205
206 =head1 AUTHOR
207
208 Victor Igumnov
209
210 =head1 LICENSE
211
212 This library is free software, you can redistribute it and/or modify
213 it under the same terms as Perl itself.
214
215 =cut
216
217 1;