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 NAME
 117
 118 DBIx::Class::InflateColumn::File -  map files from the Database to the filesystem.
 119
 120 =head1 SYNOPSIS
 121
 122 In your L<DBIx::Class> table class:
 123
 124     __PACKAGE__->load_components( "PK::Auto", "InflateColumn::File", "Core" );
 125
 126     # define your columns
 127     __PACKAGE__->add_columns(
 128         "id",
 129         {
 130             data_type         => "integer",
 131             is_auto_increment => 1,
 132             is_nullable       => 0,
 133             size              => 4,
 134         },
 135         "filename",
 136         {
 137             data_type           => "varchar",
 138             is_file_column      => 1,
 139             file_column_path    =>'/tmp/uploaded_files',
 140             # or for a Catalyst application
 141             # file_column_path  => MyApp->path_to('root','static','files'),
 142             default_value       => undef,
 143             is_nullable         => 1,
 144             size                => 255,
 145         },
 146     );
 147
 148
 149 In your L<Catalyst::Controller> class:
 150
 151 FileColumn requires a hash that contains L<IO::File> as handle and the file's
 152 name as name.
 153
 154     my $entry = $c->model('MyAppDB::Articles')->create({
 155         subject => 'blah',
 156         filename => {
 157             handle => $c->req->upload('myupload')->fh,
 158             filename => $c->req->upload('myupload')->basename
 159         },
 160         body => '....'
 161     });
 162     $c->stash->{entry}=$entry;
 163
 164
 165 And Place the following in your TT template
 166
 167     Article Subject: [% entry.subject %]
 168     Uploaded File:
 169     <a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
 170     Body: [% entry.body %]
 171
 172 The file will be stored on the filesystem for later retrieval.  Calling delete
 173 on your resultset will delete the file from the filesystem.  Retrevial of the
 174 record automatically inflates the column back to the set hash with the
 175 IO::File handle and filename.
 176
 177 =head1 DESCRIPTION
 178
 179 InflateColumn::File
 180
 181 =head1 METHODS
 182
 183 =head2 _file_column_callback ($file,$ret,$target)
 184
 185 method made to be overridden for callback purposes.
 186
 187 =cut
 188
 189 sub _file_column_callback {
 190     my ($self,$file,$ret,$target) = @_;
 191 }
 192
 193 =head1 AUTHOR
 194
 195 Victor Igumnov
 196
 197 =head1 LICENSE
 198
 199 This library is free software, you can redistribute it and/or modify
 200 it under the same terms as Perl itself.
 201
 202 =cut
 203
 204 1;