discard_changes is also "refresh from storage"
[dbsrgits/DBIx-Class-Historic.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;
8use IO::File;
9
28d4067a 10__PACKAGE__->load_components(qw/InflateColumn/);
4740bdb7 11
4740bdb7 12
28d4067a 13sub 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
34sub 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
52sub _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
72sub _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
96sub _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
116=head1 NAME
117
28d4067a 118DBIx::Class::InflateColumn::File - map files from the Database to the filesystem.
4740bdb7 119
4740bdb7 120=head1 SYNOPSIS
121
122In your L<DBIx::Class> table class:
123
28d4067a 124 __PACKAGE__->load_components( "PK::Auto", "InflateColumn::File", "Core" );
4740bdb7 125
126 # define your columns
127 __PACKAGE__->add_columns(
128 "id",
129 {
130 data_type => "integer",
131 is_auto_increment => 1,
132 is_nullable => 0,
133 size => 4,
134 },
135 "filename",
136 {
137 data_type => "varchar",
138 is_file_column => 1,
139 file_column_path =>'/tmp/uploaded_files',
140 # or for a Catalyst application
141 # file_column_path => MyApp->path_to('root','static','files'),
142 default_value => undef,
143 is_nullable => 1,
144 size => 255,
145 },
146 );
147
148
149In your L<Catalyst::Controller> class:
150
0876072c 151FileColumn requires a hash that contains L<IO::File> as handle and the file's
152name as name.
4740bdb7 153
154 my $entry = $c->model('MyAppDB::Articles')->create({
155 subject => 'blah',
156 filename => {
157 handle => $c->req->upload('myupload')->fh,
158 filename => $c->req->upload('myupload')->basename
159 },
160 body => '....'
161 });
162 $c->stash->{entry}=$entry;
163
164
165And Place the following in your TT template
166
167 Article Subject: [% entry.subject %]
168 Uploaded File:
169 <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
170 Body: [% entry.body %]
171
0876072c 172The file will be stored on the filesystem for later retrieval. Calling delete
173on your resultset will delete the file from the filesystem. Retrevial of the
174record automatically inflates the column back to the set hash with the
175IO::File handle and filename.
176
177=head1 DESCRIPTION
178
179InflateColumn::File
180
181=head1 METHODS
182
183=head2 _file_column_callback ($file,$ret,$target)
184
185method made to be overridden for callback purposes.
186
187=cut
188
189sub _file_column_callback {
190 my ($self,$file,$ret,$target) = @_;
191}
4740bdb7 192
193=head1 AUTHOR
194
195Victor Igumnov
196
197=head1 LICENSE
198
199This library is free software, you can redistribute it and/or modify
200it under the same terms as Perl itself.
201
202=cut
203
2041;