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     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
 143 In your L<Catalyst::Controller> class:
 144
 145 FileColumn requires a hash that contains L<IO::File> as handle and the file's
 146 name 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
 159 And 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
 166 The file will be stored on the filesystem for later retrieval.  Calling delete
 167 on your resultset will delete the file from the filesystem.  Retrevial of the
 168 record automatically inflates the column back to the set hash with the
 169 IO::File handle and filename.
 170
 171 =head1 DESCRIPTION
 172
 173 InflateColumn::File
 174
 175 =head1 METHODS
 176
 177 =head2 _file_column_callback ($file,$ret,$target)
 178
 179 Method made to be overridden for callback purposes.
 180
 181 =cut
 182
 183 sub _file_column_callback {}
 184
 185 =head1 AUTHOR
 186
 187 Victor Igumnov
 188
 189 =head1 LICENSE
 190
 191 This library is free software, you can redistribute it and/or modify
 192 it under the same terms as Perl itself.
 193
 194 =cut
 195
 196 1;