X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FInflateColumn%2FFile.pm;h=34db2ed02313f9344dccf19eaff73cac39fe39f5;hb=b83736a7d3235d2f50fe5695550eb3637432d960;hp=1d76befcc06908ecd4d1b26ab1e751f5177558b9;hpb=28d4067a8514340167194b3397931a6cdb93be26;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/InflateColumn/File.pm b/lib/DBIx/Class/InflateColumn/File.pm index 1d76bef..34db2ed 100644 --- a/lib/DBIx/Class/InflateColumn/File.pm +++ b/lib/DBIx/Class/InflateColumn/File.pm @@ -1,143 +1,160 @@ -package DBIx::Class::File; +package DBIx::Class::InflateColumn::File; 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 => $self->_inflate_file_column, - deflate => sub { - my ( $file, @column_names ) = $self->_load_file_column_information; - $self->_save_file_column( $file, $self, @column_names ); - }, - } - ); + 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) = @_; + $obj->_inflate_file_column($column, $value); + }, + deflate => sub { + my ($value, $obj) = @_; + $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 $colinfos = $self->result_source->columns_info; - 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->$_}); + 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 }; +} -method made to be overridden for callback purposes. +sub _save_file_column { + my ( $self, $column, $value ) = @_; -=cut + return unless ref $value; + + my $fs_file = $self->_file_column_file($column, $value->{filename}); + $fs_file->dir->mkpath; + + # 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); -sub _file_column_callback { - my ($self,$file,$ret,$target) = @_; + $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 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", @@ -152,49 +169,67 @@ In your L table class: 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 class: -FileColumn requires a hash that contains L as handle and the file's name as name. +FileColumn requires a hash that contains L 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: File 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. -=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 +by the L. You can +redistribute it and/or modify it under the same terms as the +L. =cut