projekt kivitendo

package SL::File::Backend::Filesystem;

use strict;

use parent qw(SL::File::Backend);

use SL::DB::File;

use File::Copy;

use File::Slurp;

use File::Path qw(make_path);

#

# public methods

#

sub delete {

  my ($self, %params) = @_;

  $main::lxdebug->message(LXDebug->DEBUG2(), "del in backend " . $self . "  file " . $params{dbfile});

  $main::lxdebug->message(LXDebug->DEBUG2(), "file id=" . ($params{dbfile}->id * 1));

  die "no dbfile" unless $params{dbfile};

  my $backend_data = $params{dbfile}->backend_data;

  $backend_data    = 0                               if $params{last};

  $backend_data    = $params{dbfile}->backend_data-1 if $params{all_but_notlast};

  if ($backend_data > 0 ) {

    $main::lxdebug->message(LXDebug->DEBUG2(), "backend_data=" .$backend_data);

    for my $version ( 1..$backend_data) {

      my $file_path = $self->_filesystem_path($params{dbfile},$version);

      $main::lxdebug->message(LXDebug->DEBUG2(), "unlink " .$file_path);

      unlink($file_path);

    }

    if ($params{all_but_notlast}) {

      my $from = $self->_filesystem_path($params{dbfile},$params{dbfile}->backend_data);

      my $to   = $self->_filesystem_path($params{dbfile},$params{dbfile}->backend_data);

      die "file not exists" unless -f $from;

      rename($from,$to);

      $params{dbfile}->backend_data(1);

    } else {

      $params{dbfile}->backend_data(0);

      my $dir_path = $self->_filesystem_path($params{dbfile});

      rmdir($dir_path);

      $main::lxdebug->message(LXDebug->DEBUG2(), "unlink " .$dir_path);

    }

  } else {

    my $file_path = $self->_filesystem_path($params{dbfile},$params{dbfile}->backend_data);

    die "file not exists" unless -f $file_path;

    unlink($file_path);

    $params{dbfile}->backend_data($params{dbfile}->backend_data-1);

  }

}

sub rename {

}

sub save {

  my ($self, %params) = @_;

  die 'dbfile not exists' unless $params{dbfile};

  $main::lxdebug->message(LXDebug->DEBUG2(), "in backend " . $self . "  file " . $params{dbfile});

  $main::lxdebug->message(LXDebug->DEBUG2(), "file id=" . $params{dbfile}->id . " path=" . $params{file_path});

  my $dbfile = $params{dbfile};

  die 'no file contents' unless $params{file_path} || $params{file_contents};

  $dbfile->backend_data(0) unless $dbfile->backend_data;

  $dbfile->backend_data($dbfile->backend_data*1+1);

  $dbfile->save->load;

  my $tofile = $self->_filesystem_path($dbfile);

  $main::lxdebug->message(LXDebug->DEBUG2(), "topath=" . $tofile . " from=" . $params{file_path});

  if ($params{file_path} && -f $params{file_path}) {

    File::Copy::copy($params{file_path}, $tofile);

  }

  elsif ($params{file_contents}) {

    open(OUT, "> " . $tofile);

    print OUT $params{file_contents};

    close(OUT);

  }

  return 1;

}

sub get_version_count {

  my ($self, %params) = @_;

  die "no dbfile" unless $params{dbfile};

  return $params{dbfile}->backend_data * 1;

}

sub get_mtime {

  my ($self, %params) = @_;

  die "no dbfile" unless $params{dbfile};

  $main::lxdebug->message(LXDebug->DEBUG2(), "version=" .$params{version});

  die "unknown version" if $params{version} && 

                          ($params{version} < 0 || $params{version} > $params{dbfile}->backend_data) ;

  my $path = $self->_filesystem_path($params{dbfile},$params{version});

  die "no file found in backend" if !-f $path;

  my @st = stat($path);

  my $dt = DateTime->from_epoch(epoch => $st[9])->clone();

  $main::lxdebug->message(LXDebug->DEBUG2(), "dt=" .$dt);

  return $dt;

}

sub get_filepath {

  my ($self, %params) = @_;

  die "no dbfile" unless $params{dbfile};

  my $path = $self->_filesystem_path($params{dbfile},$params{version});

  die "no file" if !-f $path;

  return $path;

}

sub get_content {

  my ($self, %params) = @_;

  my $path = $self->get_filepath(%params);

  return "" unless $path;

  my $contents = File::Slurp::read_file($path);

  return \$contents;

}

sub enabled {

  return 0 unless $::instance_conf->get_doc_files || $::instance_conf->get_doc_files_rootpath;

  $main::lxdebug->message(LXDebug->DEBUG2(), "root path=" . $::instance_conf->get_doc_files_rootpath . " isdir=" .( -d $::instance_conf->get_doc_files_rootpath?"YES":"NO"));

  return 0 unless -d $::instance_conf->get_doc_files_rootpath;

  return 1;

}

#

# internals

#

sub _filesystem_path {

  my ($self, $dbfile, $version) = @_;

  die "No files backend enabled" unless $::instance_conf->get_doc_files || $::instance_conf->get_doc_files_rootpath;

  # use filesystem with depth 3

  $version    = $dbfile->backend_data if !$version || $version < 1 || $version > $dbfile->backend_data;

  my $iddir   = sprintf("%04d", $dbfile->id % 1000);

  my $path    = File::Spec->catdir($::instance_conf->get_doc_files_rootpath, $iddir, $dbfile->id);

  $main::lxdebug->message(LXDebug->DEBUG2(), "file path=" .$path." id=" .$dbfile->id." version=".$version." basename=".$dbfile->id . '_' . $version);

  if (!-d $path) {

    File::Path::make_path($path, { chmod => 0770 });

  }

  return $path if !$version;

  return File::Spec->catdir($path, $dbfile->id . '_' . $version);

}

1;

__END__

=pod

=encoding utf8

=head1 NAME

SL::File::Backend::Filesystem  - Filesystem class for file storage backend

=head1 SYNOPSIS

See the synopsis of L<SL::File::Backend>.

=head1 OVERVIEW

This specific storage backend use a Filesystem which is only accessed by this interface.

This is the big difference to the Webdav backend where the files can be accessed without the control of that backend.

This backend use the database id of the SL::DB::File object as filename. The filesystem has up to 1000 subdirectories

to store the files not to flat in the filesystem. In this Subdirectories for each file an additional subdirectory exists

for the versions of this file.

The Versioning is done via a Versionnumber which is incremented by one for each version.

So the Version 2 of the file with the database id 4 is stored as path {root}/0004/4/4_2.

=head1 METHODS

See methods of L<SL::File::Backend>.

=head1 SEE ALSO

L<SL::File::Backend>

=head1 AUTHOR

Martin Helmling E<lt>martin.helmling@opendynamic.deE<gt>

=cut

use strict;

use Test::More tests => 11;

use lib 't';

use Support::TestSetup;

use Test::Exception;

use SL::File;

use SL::Dev::File;

Support::TestSetup::login();

my $db = SL::DB::Object->new->db;

$db->dbh->do("UPDATE defaults SET doc_files = 't'");

$db->dbh->do("UPDATE defaults SET doc_files_rootpath = '/var/tmp/kivifs'");

my $scannerfile = '/var/tmp/f2';

clear_up();

reset_state();

my $file1 = SL::Dev::File::create_uploaded( file_name => 'file1', file_contents => 'inhalt1 uploaded' );

my $file2 = SL::Dev::File::create_scanned(  file_name => 'file2', file_contents => 'inhalt2 scanned', file_path => $scannerfile );

my $file3 = SL::Dev::File::create_created(  file_name => 'file3', file_contents => 'inhalt3 created'    );

my $file4 = SL::Dev::File::create_created(  file_name => 'file3', file_contents => 'inhalt3 new version');

is( SL::Dev::File->get_all_count(),                    3,"total number of files created is 3");

ok( $file1->file_name                        eq 'file1' ,"file has right name");

my $content1 = $file1->get_content;

ok( $$content1 eq 'inhalt1 uploaded'                    ,"file has right content");

is( -f $scannerfile ? 1 : 0,                           0,"scanned document is moved from scanner");

$file2->delete;

is( -f $scannerfile ? 1 : 0,                           1,"scanned document is moved back to scanner");

my $content2 = File::Slurp::read_file($scannerfile);

ok( $content2 eq 'inhalt2 scanned'                      ,"scanned file has right content");

my @file5 = SL::Dev::File->get_all(file_name => 'file3');

is(   scalar( @file5),                                 1, "one actual file found");

my $content5 = $file5[0]->get_content();

ok( $$content5 eq 'inhalt3 new version'                 ,"file has right actual content");

my @file6 = SL::Dev::File->get_all_versions(file_name => 'file3');

is(   scalar( @file6),                                 2,"two file versions found");

$content5 = $file6[0]->get_content;

ok( $$content5 eq 'inhalt3 new version'                 ,"file has right actual content");

$content5 = $file6[1]->get_content;

ok( $$content5 eq 'inhalt3 created'                     ,"file has right old content");

print "\n\nController:\n";

# now test controller

#$::form->{object_id}  = 1;

#$::form->{object_type}= 'sales_order';

#$::form->{file_type}  = 'document';

$::form->{id}  = $file1->id;

print "id=".$::form->{id}."\n";

use SL::Controller::File;

SL::Controller::File->action_download();

$::form->{object_id}   = 12345678;

$::form->{object_type} = undef;

eval {

  SL::Controller::File->check_object_params();

  1;

} or do {

    print $@;

};

$::form->{object_type} ='xx';

$::form->{file_type} ='yy';

eval {

  SL::Controller::File->check_object_params();

  1;

} or do {

    print $@;

};

clear_up();

done_testing;

sub clear_up {

  SL::Dev::File->delete_all();

  unlink($scannerfile);

};

sub reset_state {

  my %params = @_;

};

1;