Replicated - fixup types and namespace::clean
[dbsrgits/DBIx-Class.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 __PACKAGE__->load_components(qw/InflateColumn/);
11
12 sub register_column {
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 { 
19             my ($value, $obj) = @_;
20             $obj->_inflate_file_column($column, $value);
21         },
22         deflate => sub {
23             my ($value, $obj) = @_;
24             $obj->_save_file_column($column, $value);
25         },
26     });
27 }
28
29 sub _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 }
45
46 sub delete {
47     my ( $self, @rest ) = @_;
48
49     for ( $self->columns ) {
50         if ( $self->column_info($_)->{is_file_column} ) {
51             rmtree( [$self->_file_column_file($_)->dir], 0, 0 );
52             last; # if we've deleted one, we've deleted them all
53         }
54     }
55
56     return $self->next::method(@rest);
57 }
58
59 sub insert {
60     my $self = shift;
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 ) {
66         if ( $self->column_info($_)->{is_file_column} ) {
67             $file_column{$_} = $self->$_;
68             $self->store_column($_ => $self->$_->{filename});
69         }
70     }
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;
80 }
81
82
83 sub _inflate_file_column {
84     my ( $self, $column, $value ) = @_;
85
86     my $fs_file = $self->_file_column_file($column, $value);
87
88     return { handle => $fs_file->open('r'), filename => $value };
89 }
90
91 sub _save_file_column {
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];
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);
102
103     $self->_file_column_callback($value, $self, $column);
104
105     return $value->{filename};
106 }
107
108 =head1 NAME
109
110 DBIx::Class::InflateColumn::File -  map files from the Database to the filesystem.
111
112 =head1 SYNOPSIS
113
114 In your L<DBIx::Class> table class:
115
116     __PACKAGE__->load_components( "PK::Auto", "InflateColumn::File", "Core" );
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
141 In your L<Catalyst::Controller> class:
142
143 FileColumn requires a hash that contains L<IO::File> as handle and the file's
144 name as name.
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
157 And 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     
164 The file will be stored on the filesystem for later retrieval.  Calling delete
165 on your resultset will delete the file from the filesystem.  Retrevial of the
166 record automatically inflates the column back to the set hash with the
167 IO::File handle and filename.
168
169 =head1 DESCRIPTION
170
171 InflateColumn::File
172
173 =head1 METHODS
174
175 =head2 _file_column_callback ($file,$ret,$target)
176
177 method made to be overridden for callback purposes.
178
179 =cut
180
181 sub _file_column_callback {}
182
183 =head1 AUTHOR
184
185 Victor Igumnov
186
187 =head1 LICENSE
188
189 This library is free software, you can redistribute it and/or modify
190 it under the same terms as Perl itself.
191
192 =cut
193
194 1;