lib/DBIx/Class/FileColumn.pm

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