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