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