use strict;
use warnings;
+
+# check deps
+BEGIN {
+ require DBIx::Class::Optional::Dependencies;
+ if (my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('ic_file') ) {
+ die "The following extra modules are required for DBIx::Class::InflateColumn::File: $missing\n";
+ }
+}
+
use base 'DBIx::Class';
-use File::Path;
use File::Copy;
-use IO::File;
+use DBIx::Class::Carp;
+use namespace::clean;
-__PACKAGE__->load_components(qw/InflateColumn/);
+carp 'InflateColumn::File has entered a deprecation cycle. This component '
+ .'has a number of architectural deficiencies that can quickly drive '
+ .'your filesystem and database out of sync and is not recommended '
+ .'for further use. It will be retained for backwards '
+ .'compatibility, but no new functionality patches will be accepted. '
+ .'Please consider using the much more mature and actively maintained '
+ .'DBIx::Class::InflateColumn::FS. You can set the environment variable '
+ .'DBIC_IC_FILE_NOWARN to a true value to disable this warning.'
+unless $ENV{DBIC_IC_FILE_NOWARN};
+__PACKAGE__->load_components(qw/InflateColumn/);
+
sub register_column {
- my ($self, $column, $info, @rest) = @_;
- $self->next::method($column, $info, @rest);
- return unless defined($info->{is_file_column});
- $self->inflate_column(
- $column =>
- {
- inflate => sub {
+ my ($self, $column, $info, @rest) = @_;
+ $self->next::method($column, $info, @rest);
+ return unless defined($info->{is_file_column});
+
+ $self->inflate_column($column => {
+ inflate => sub {
my ($value, $obj) = @_;
- #$self->_inflate_file_column;
- },
- deflate => sub {
+ $obj->_inflate_file_column($column, $value);
+ },
+ deflate => sub {
my ($value, $obj) = @_;
- #my ( $file, @column_names ) = $self->_load_file_column_information;
- #$self->_save_file_column( $file, $self, @column_names );
- },
- }
- );
+ $obj->_save_file_column($column, $value);
+ },
+ });
}
+sub _file_column_file {
+ my ($self, $column, $filename) = @_;
-sub delete {
- my ( $self, @rest ) = @_;
+ my $column_info = $self->result_source->columns_info->{$column};
- my @column_names = $self->columns;
- for (@column_names) {
- if ( $self->column_info($_)->{is_file_column} ) {
- my $path =
- File::Spec->catdir( $self->column_info($_)->{file_column_path},
- $self->id );
- rmtree( [$path], 0, 0 );
- }
- }
+ return unless $column_info->{is_file_column};
- my $ret = $self->next::method(@rest);
+ # DO NOT CHANGE
+ # This call to id() is generally incorrect - will not DTRT on
+ # multicolumn key. However changing this may introduce
+ # backwards-comp regressions, thus leaving as is
+ my $id = $self->id || $self->throw_exception(
+ 'id required for filename generation'
+ );
- return $ret;
+ $filename ||= $self->$column->{filename};
+ return Path::Class::file(
+ $column_info->{file_column_path}, $id, $filename,
+ );
}
-sub _inflate_file_column {
- my $self = shift;
+sub delete {
+ my ( $self, @rest ) = @_;
- my @column_names = $self->columns;
- for(@column_names) {
- if ( $self->column_info($_)->{is_file_column} ) {
- # make sure everything checks out
- unless (defined $self->$_) {
- # if something is wrong set it to undef
- $self->$_(undef);
- next;
- }
- my $fs_file =
- File::Spec->catfile( $self->column_info($_)->{file_column_path},
- $self->id, $self->$_ );
- $self->$_({handle => new IO::File($fs_file, "r"), filename => $self->$_});
+ my $colinfos = $self->result_source->columns_info;
+
+ for ( keys %$colinfos ) {
+ if ( $colinfos->{$_}{is_file_column} ) {
+ $self->_file_column_file($_)->dir->rmtree;
+ last; # if we've deleted one, we've deleted them all
}
}
+
+ return $self->next::method(@rest);
}
-sub _load_file_column_information {
+sub insert {
my $self = shift;
- my $file;
- my @column_names;
-
- @column_names = $self->columns;
- for (@column_names) {
- if ( $self->column_info($_)->{is_file_column} ) {
- # make sure everything checks out
- unless ((defined $self->$_) ||
- (defined $self->$_->{filename} && defined $self->$_->{handle})) {
- # if something is wrong set it to undef
- $self->$_(undef);
- next;
- }
- $file->{$_} = $self->$_;
- $self->$_( $self->$_->{filename} );
+ # cache our file columns so we can write them to the fs
+ # -after- we have a PK
+ my $colinfos = $self->result_source->columns_info;
+
+ my %file_column;
+ for ( keys %$colinfos ) {
+ if ( $colinfos->{$_}{is_file_column} ) {
+ $file_column{$_} = $self->$_;
+ $self->store_column($_ => $self->$_->{filename});
}
}
- return ( $file, @column_names );
-}
+ $self->next::method(@_);
-sub _save_file_column {
- my ( $self, $file, $ret, @column_names ) = @_;
-
- for (@column_names) {
- if ( $ret->column_info($_)->{is_file_column} ) {
- next unless (defined $ret->$_);
- my $file_path =
- File::Spec->catdir( $ret->column_info($_)->{file_column_path},
- $ret->id );
- mkpath [$file_path];
-
- my $outfile =
- File::Spec->catfile( $file_path, $file->{$_}->{filename} );
- File::Copy::copy( $file->{$_}->{handle}, $outfile );
-
- $self->_file_column_callback($file->{$_},$ret,$_);
- }
+ # write the files to the fs
+ while ( my ($col, $file) = each %file_column ) {
+ $self->_save_file_column($col, $file);
}
+
+ return $self;
}
-=head1 METHODS
-=cut
+sub _inflate_file_column {
+ my ( $self, $column, $value ) = @_;
+ my $fs_file = $self->_file_column_file($column, $value);
-=head2 _file_column_callback ($file,$ret,$target)
+ return { handle => $fs_file->open('r'), filename => $value };
+}
+
+sub _save_file_column {
+ my ( $self, $column, $value ) = @_;
-method made to be overridden for callback purposes.
+ return unless ref $value;
-=cut
+ my $fs_file = $self->_file_column_file($column, $value->{filename});
+ $fs_file->dir->mkpath;
-sub _file_column_callback {
- my ($self,$file,$ret,$target) = @_;
+ # File::Copy doesn't like Path::Class (or any for that matter) objects,
+ # thus ->stringify (http://rt.perl.org/rt3/Public/Bug/Display.html?id=59650)
+ File::Copy::copy($value->{handle}, $fs_file->stringify);
+
+ $self->_file_column_callback($value, $self, $column);
+
+ return $value->{filename};
}
=head1 NAME
-DBIx::Class::InflateColumn::File - map files from the Database to the filesystem.
+DBIx::Class::InflateColumn::File - DEPRECATED (superseded by DBIx::Class::InflateColumn::FS)
-=head1 DESCRIPTION
+=head2 Deprecation Notice
-InflateColumn::File
+ This component has a number of architectural deficiencies that can quickly
+ drive your filesystem and database out of sync and is not recommended for
+ further use. It will be retained for backwards compatibility, but no new
+ functionality patches will be accepted. Please consider using the much more
+ mature and actively supported DBIx::Class::InflateColumn::FS. You can set
+ the environment variable DBIC_IC_FILE_NOWARN to a true value to disable
+ this warning.
=head1 SYNOPSIS
In your L<DBIx::Class> table class:
- __PACKAGE__->load_components( "PK::Auto", "InflateColumn::File", "Core" );
-
+ use base 'DBIx::Class::Core';
+
+ __PACKAGE__->load_components(qw/InflateColumn::File/);
+
# define your columns
__PACKAGE__->add_columns(
"id",
data_type => "varchar",
is_file_column => 1,
file_column_path =>'/tmp/uploaded_files',
- # or for a Catalyst application
+ # or for a Catalyst application
# file_column_path => MyApp->path_to('root','static','files'),
default_value => undef,
is_nullable => 1,
size => 255,
},
);
-
+
In your L<Catalyst::Controller> class:
-FileColumn requires a hash that contains L<IO::File> as handle and the file's name as name.
+FileColumn requires a hash that contains L<IO::File> as handle and the file's
+name as name.
- my $entry = $c->model('MyAppDB::Articles')->create({
+ my $entry = $c->model('MyAppDB::Articles')->create({
subject => 'blah',
- filename => {
- handle => $c->req->upload('myupload')->fh,
- filename => $c->req->upload('myupload')->basename
+ filename => {
+ handle => $c->req->upload('myupload')->fh,
+ filename => $c->req->upload('myupload')->basename
},
body => '....'
});
$c->stash->{entry}=$entry;
-
+
And Place the following in your TT template
-
+
Article Subject: [% entry.subject %]
- Uploaded File:
+ Uploaded File:
<a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
Body: [% entry.body %]
-
-The file will be stored on the filesystem for later retrieval.
-Calling delete on your resultset will delete the file from the filesystem.
-Retrevial of the record automatically inflates the column back to the set hash with the IO::File handle and filename.
-=head1 AUTHOR
+The file will be stored on the filesystem for later retrieval. Calling delete
+on your resultset will delete the file from the filesystem. Retrevial of the
+record automatically inflates the column back to the set hash with the
+IO::File handle and filename.
+
+=head1 DESCRIPTION
+
+InflateColumn::File
+
+=head1 METHODS
+
+=head2 _file_column_callback ($file,$ret,$target)
+
+Method made to be overridden for callback purposes.
+
+=cut
+
+sub _file_column_callback {}
+
+=head1 FURTHER QUESTIONS?
-Victor Igumnov
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
-=head1 LICENSE
+=head1 COPYRIGHT AND LICENSE
-This library is free software, you can redistribute it and/or modify
-it under the same terms as Perl itself.
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
=cut
projects / dbsrgits/DBIx-Class.git / blobdiff