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 IO::File;
   9
  10 __PACKAGE__->load_components(qw/InflateColumn/);
  11
  12
  13 sub register_column {
  14   my ($self, $column, $info, @rest) = @_;
  15   $self->next::method($column, $info, @rest);
  16   return unless defined($info->{is_file_column});
  17     $self->inflate_column(
  18       $column =>
  19         {
  20           inflate => sub {
  21             my ($value, $obj) = @_;
  22             #$self->_inflate_file_column;
  23           },
  24           deflate => sub {
  25             my ($value, $obj) = @_;
  26             #my ( $file, @column_names ) = $self->_load_file_column_information;
  27             #$self->_save_file_column( $file, $self, @column_names );
  28           },
  29         }
  30     );
  31 }
  32
  33
  34 sub delete {
  35     my ( $self, @rest ) = @_;
  36
  37     my @column_names = $self->columns;
  38     for (@column_names) {
  39         if ( $self->column_info($_)->{is_file_column} ) {
  40             my $path =
  41               File::Spec->catdir( $self->column_info($_)->{file_column_path},
  42                 $self->id );
  43             rmtree( [$path], 0, 0 );
  44         }
  45     }
  46
  47     my $ret = $self->next::method(@rest);
  48
  49     return $ret;
  50 }
  51
  52 sub _inflate_file_column {
  53     my $self = shift;
  54
  55     my @column_names = $self->columns;
  56     for(@column_names) {
  57         if ( $self->column_info($_)->{is_file_column} ) {
  58             # make sure everything checks out
  59             unless (defined $self->$_) {
  60                 # if something is wrong set it to undef
  61                 $self->$_(undef);
  62                 next;
  63             }
  64             my $fs_file =
  65               File::Spec->catfile( $self->column_info($_)->{file_column_path},
  66                 $self->id, $self->$_ );
  67             $self->$_({handle => new IO::File($fs_file, "r"), filename => $self->$_});
  68         }
  69     }
  70 }
  71
  72 sub _load_file_column_information {
  73     my $self = shift;
  74
  75     my $file;
  76     my @column_names;
  77
  78     @column_names = $self->columns;
  79     for (@column_names) {
  80         if ( $self->column_info($_)->{is_file_column} ) {
  81             # make sure everything checks out
  82             unless ((defined $self->$_) ||
  83              (defined $self->$_->{filename} && defined $self->$_->{handle})) {
  84                 # if something is wrong set it to undef
  85                 $self->$_(undef);
  86                 next;
  87             }
  88             $file->{$_} = $self->$_;
  89             $self->$_( $self->$_->{filename} );
  90         }
  91     }
  92
  93     return ( $file, @column_names );
  94 }
  95
  96 sub _save_file_column {
  97     my ( $self, $file, $ret, @column_names ) = @_;
  98
  99     for (@column_names) {
 100         if ( $ret->column_info($_)->{is_file_column} ) {
 101             next unless (defined $ret->$_);
 102             my $file_path =
 103               File::Spec->catdir( $ret->column_info($_)->{file_column_path},
 104                 $ret->id );
 105             mkpath [$file_path];
 106
 107             my $outfile =
 108               File::Spec->catfile( $file_path, $file->{$_}->{filename} );
 109             File::Copy::copy( $file->{$_}->{handle}, $outfile );
 110
 111             $self->_file_column_callback($file->{$_},$ret,$_);
 112         }
 113     }
 114 }
 115
 116 =head1 METHODS
 117
 118 =cut
 119
 120
 121 =head2 _file_column_callback ($file,$ret,$target)
 122
 123 method made to be overridden for callback purposes.
 124
 125 =cut
 126
 127 sub _file_column_callback {
 128     my ($self,$file,$ret,$target) = @_;
 129 }
 130
 131 =head1 NAME
 132
 133 DBIx::Class::InflateColumn::File -  map files from the Database to the filesystem.
 134
 135 =head1 DESCRIPTION
 136
 137 InflateColumn::File
 138
 139 =head1 SYNOPSIS
 140
 141 In your L<DBIx::Class> table class:
 142
 143     __PACKAGE__->load_components( "PK::Auto", "InflateColumn::File", "Core" );
 144
 145     # define your columns
 146     __PACKAGE__->add_columns(
 147         "id",
 148         {
 149             data_type         => "integer",
 150             is_auto_increment => 1,
 151             is_nullable       => 0,
 152             size              => 4,
 153         },
 154         "filename",
 155         {
 156             data_type           => "varchar",
 157             is_file_column      => 1,
 158             file_column_path    =>'/tmp/uploaded_files',
 159             # or for a Catalyst application
 160             # file_column_path  => MyApp->path_to('root','static','files'),
 161             default_value       => undef,
 162             is_nullable         => 1,
 163             size                => 255,
 164         },
 165     );
 166
 167
 168 In your L<Catalyst::Controller> class:
 169
 170 FileColumn requires a hash that contains L<IO::File> as handle and the file's name as name.
 171
 172     my $entry = $c->model('MyAppDB::Articles')->create({
 173         subject => 'blah',
 174         filename => {
 175             handle => $c->req->upload('myupload')->fh,
 176             filename => $c->req->upload('myupload')->basename
 177         },
 178         body => '....'
 179     });
 180     $c->stash->{entry}=$entry;
 181
 182
 183 And Place the following in your TT template
 184
 185     Article Subject: [% entry.subject %]
 186     Uploaded File:
 187     <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
 188     Body: [% entry.body %]
 189
 190 The file will be stored on the filesystem for later retrieval.
 191 Calling delete on your resultset will delete the file from the filesystem.
 192 Retrevial of the record automatically inflates the column back to the set hash with the IO::File handle and filename.
 193
 194 =head1 AUTHOR
 195
 196 Victor Igumnov
 197
 198 =head1 LICENSE
 199
 200 This library is free software, you can redistribute it and/or modify
 201 it under the same terms as Perl itself.
 202
 203 =cut
 204
 205 1;