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;