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::Copy;
   7 use Path::Class;
   8 use DBIx::Class::Carp;
   9 use namespace::clean;
  10
  11 carp 'InflateColumn::File has entered a deprecation cycle. This component '
  12     .'has a number of architectural deficiencies that can quickly drive '
  13     .'your filesystem and database out of sync and is not recommended '
  14     .'for further use. It will be retained for backwards '
  15     .'compatibility, but no new functionality patches will be accepted. '
  16     .'Please consider using the much more mature and actively maintained '
  17     .'DBIx::Class::InflateColumn::FS. You can set the environment variable '
  18     .'DBIC_IC_FILE_NOWARN to a true value to disable  this warning.'
  19 unless $ENV{DBIC_IC_FILE_NOWARN};
  20
  21
  22 __PACKAGE__->load_components(qw/InflateColumn/);
  23
  24 sub register_column {
  25     my ($self, $column, $info, @rest) = @_;
  26     $self->next::method($column, $info, @rest);
  27     return unless defined($info->{is_file_column});
  28
  29     $self->inflate_column($column => {
  30         inflate => sub {
  31             my ($value, $obj) = @_;
  32             $obj->_inflate_file_column($column, $value);
  33         },
  34         deflate => sub {
  35             my ($value, $obj) = @_;
  36             $obj->_save_file_column($column, $value);
  37         },
  38     });
  39 }
  40
  41 sub _file_column_file {
  42     my ($self, $column, $filename) = @_;
  43
  44     my $column_info = $self->result_source->column_info($column);
  45
  46     return unless $column_info->{is_file_column};
  47
  48     # DO NOT CHANGE
  49     # This call to id() is generally incorrect - will not DTRT on
  50     # multicolumn key. However changing this may introduce
  51     # backwards-comp regressions, thus leaving as is
  52     my $id = $self->id || $self->throw_exception(
  53         'id required for filename generation'
  54     );
  55
  56     $filename ||= $self->$column->{filename};
  57     return Path::Class::file(
  58         $column_info->{file_column_path}, $id, $filename,
  59     );
  60 }
  61
  62 sub delete {
  63     my ( $self, @rest ) = @_;
  64
  65     my $colinfos = $self->result_source->columns_info;
  66
  67     for ( keys %$colinfos ) {
  68         if ( $colinfos->{$_}{is_file_column} ) {
  69             $self->_file_column_file($_)->dir->rmtree;
  70             last; # if we've deleted one, we've deleted them all
  71         }
  72     }
  73
  74     return $self->next::method(@rest);
  75 }
  76
  77 sub insert {
  78     my $self = shift;
  79
  80     # cache our file columns so we can write them to the fs
  81     # -after- we have a PK
  82     my $colinfos = $self->result_source->columns_info;
  83
  84     my %file_column;
  85     for ( keys %$colinfos ) {
  86         if ( $colinfos->{$_}{is_file_column} ) {
  87             $file_column{$_} = $self->$_;
  88             $self->store_column($_ => $self->$_->{filename});
  89         }
  90     }
  91
  92     $self->next::method(@_);
  93
  94     # write the files to the fs
  95     while ( my ($col, $file) = each %file_column ) {
  96         $self->_save_file_column($col, $file);
  97     }
  98
  99     return $self;
 100 }
 101
 102
 103 sub _inflate_file_column {
 104     my ( $self, $column, $value ) = @_;
 105
 106     my $fs_file = $self->_file_column_file($column, $value);
 107
 108     return { handle => $fs_file->open('r'), filename => $value };
 109 }
 110
 111 sub _save_file_column {
 112     my ( $self, $column, $value ) = @_;
 113
 114     return unless ref $value;
 115
 116     my $fs_file = $self->_file_column_file($column, $value->{filename});
 117     $fs_file->dir->mkpath;
 118
 119     # File::Copy doesn't like Path::Class (or any for that matter) objects,
 120     # thus ->stringify (http://rt.perl.org/rt3/Public/Bug/Display.html?id=59650)
 121     File::Copy::copy($value->{handle}, $fs_file->stringify);
 122
 123     $self->_file_column_callback($value, $self, $column);
 124
 125     return $value->{filename};
 126 }
 127
 128 =head1 NAME
 129
 130 DBIx::Class::InflateColumn::File -  DEPRECATED (superseded by DBIx::Class::InflateColumn::FS)
 131
 132 =head2 Deprecation Notice
 133
 134  This component has a number of architectural deficiencies that can quickly
 135  drive your filesystem and database out of sync and is not recommended for
 136  further use. It will be retained for backwards compatibility, but no new
 137  functionality patches will be accepted. Please consider using the much more
 138  mature and actively supported DBIx::Class::InflateColumn::FS. You can set
 139  the environment variable DBIC_IC_FILE_NOWARN to a true value to disable
 140  this warning.
 141
 142 =head1 SYNOPSIS
 143
 144 In your L<DBIx::Class> table class:
 145
 146     use base 'DBIx::Class::Core';
 147
 148     __PACKAGE__->load_components(qw/InflateColumn::File/);
 149
 150     # define your columns
 151     __PACKAGE__->add_columns(
 152         "id",
 153         {
 154             data_type         => "integer",
 155             is_auto_increment => 1,
 156             is_nullable       => 0,
 157             size              => 4,
 158         },
 159         "filename",
 160         {
 161             data_type           => "varchar",
 162             is_file_column      => 1,
 163             file_column_path    =>'/tmp/uploaded_files',
 164             # or for a Catalyst application
 165             # file_column_path  => MyApp->path_to('root','static','files'),
 166             default_value       => undef,
 167             is_nullable         => 1,
 168             size                => 255,
 169         },
 170     );
 171
 172
 173 In your L<Catalyst::Controller> class:
 174
 175 FileColumn requires a hash that contains L<IO::File> as handle and the file's
 176 name as name.
 177
 178     my $entry = $c->model('MyAppDB::Articles')->create({
 179         subject => 'blah',
 180         filename => {
 181             handle => $c->req->upload('myupload')->fh,
 182             filename => $c->req->upload('myupload')->basename
 183         },
 184         body => '....'
 185     });
 186     $c->stash->{entry}=$entry;
 187
 188
 189 And Place the following in your TT template
 190
 191     Article Subject: [% entry.subject %]
 192     Uploaded File:
 193     <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
 194     Body: [% entry.body %]
 195
 196 The file will be stored on the filesystem for later retrieval.  Calling delete
 197 on your resultset will delete the file from the filesystem.  Retrevial of the
 198 record automatically inflates the column back to the set hash with the
 199 IO::File handle and filename.
 200
 201 =head1 DESCRIPTION
 202
 203 InflateColumn::File
 204
 205 =head1 METHODS
 206
 207 =head2 _file_column_callback ($file,$ret,$target)
 208
 209 Method made to be overridden for callback purposes.
 210
 211 =cut
 212
 213 sub _file_column_callback {}
 214
 215 =head1 FURTHER QUESTIONS?
 216
 217 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 218
 219 =head1 COPYRIGHT AND LICENSE
 220
 221 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
 222 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
 223 redistribute it and/or modify it under the same terms as the
 224 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 225
 226 =cut
 227
 228 1;