lib/DBIx/Class/InflateColumn/File.pm

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