SL/File/Backend/Webdav.pm

   1 package SL::File::Backend::Webdav;
   2
   3 use strict;
   4
   5 use parent qw(SL::File::Backend);
   6 use SL::DB::File;
   7
   8 #use SL::Webdav;
   9 use File::Copy;
  10 use File::Slurp;
  11 use File::Basename;
  12 use File::Path qw(make_path);
  13 use File::MimeInfo::Magic;
  14
  15 #
  16 # public methods
  17 #
  18
  19 sub delete {
  20   my ($self, %params) = @_;
  21   $main::lxdebug->message(LXDebug->DEBUG2(), "del in backend " . $self . "  file " . $params{dbfile});
  22   $main::lxdebug->message(LXDebug->DEBUG2(), "file id=" . $params{dbfile}->id * 1);
  23   return 0 unless $params{dbfile};
  24   my ($file_path, undef, undef) = $self->webdav_path($params{dbfile});
  25   unlink($file_path);
  26   return 1;
  27 }
  28
  29 sub rename {
  30   my ($self, %params) = @_;
  31   return 0 unless $params{dbfile};
  32   my (undef, $oldwebdavname) = split(/:/, $params{dbfile}->location, 2);
  33   my ($tofile, $basepath, $basename) = $self->webdav_path($params{dbfile});
  34   my $fromfile = File::Spec->catfile($basepath, $oldwebdavname);
  35   $main::lxdebug->message(LXDebug->DEBUG2(), "renamefrom=" . $fromfile . " to=" . $tofile);
  36   move($fromfile, $tofile);
  37 }
  38
  39 sub save {
  40   my ($self, %params) = @_;
  41   die 'dbfile not exists' unless $params{dbfile};
  42   $main::lxdebug->message(LXDebug->DEBUG2(), "in backend " . $self . "  file " . $params{dbfile});
  43   $main::lxdebug->message(LXDebug->DEBUG2(), "file id=" . $params{dbfile}->id);
  44   my $dbfile = $params{dbfile};
  45   die 'no file contents' unless $params{file_path} || $params{file_contents};
  46
  47   if ($params{dbfile}->id * 1 == 0) {
  48
  49     # new element: need id for file
  50     $params{dbfile}->save;
  51   }
  52   my ($tofile, undef, $basename) = $self->webdav_path($params{dbfile});
  53   if ($params{file_path} && -f $params{file_path}) {
  54     copy($params{file_path}, $tofile);
  55   }
  56   elsif ($params{file_contents}) {
  57     open(OUT, "> " . $tofile);
  58     print OUT $params{file_contents};
  59     close(OUT);
  60   }
  61   return 1;
  62 }
  63
  64 sub get_version_count {
  65   my ($self, %params) = @_;
  66   die "no dbfile" unless $params{dbfile};
  67   ## TODO
  68   return 1;
  69 }
  70
  71 sub get_mtime {
  72   my ($self, %params) = @_;
  73   die "no dbfile" unless $params{dbfile};
  74   $main::lxdebug->message(LXDebug->DEBUG2(), "version=" .$params{version});
  75   my ($path, undef, undef) = $self->webdav_path($params{dbfile});
  76   die "no file found in backend" if !-f $path;
  77   my @st = stat($path);
  78   my $dt = DateTime->from_epoch(epoch => $st[9])->clone();
  79   $main::lxdebug->message(LXDebug->DEBUG2(), "dt=" .$dt);
  80   return $dt;
  81 }
  82
  83 sub get_filepath {
  84   my ($self, %params) = @_;
  85   die "no dbfile" unless $params{dbfile};
  86   my ($path, undef, undef) = $self->webdav_path($params{dbfile});
  87   die "no file" if !-f $path;
  88   return $path;
  89 }
  90
  91 sub get_content {
  92   my ($self, %params) = @_;
  93   my $path = $self->get_filepath(%params);
  94   return "" unless $path;
  95   my $contents = File::Slurp::read_file($path);
  96   return \$contents;
  97 }
  98
  99 sub sync_from_backend {
 100   my ($self, %params) = @_;
 101   return unless $params{file_type};
 102
 103   $self->sync_all_locations(%params);
 104
 105 }
 106
 107 sub enabled {
 108   return 0 unless $::instance_conf->get_doc_webdav;
 109   return 1;
 110 }
 111
 112 #
 113 # internals
 114 #
 115
 116 my %type_to_path = (
 117   sales_quotation         => 'angebote',
 118   sales_order             => 'bestellungen',
 119   request_quotation       => 'anfragen',
 120   purchase_order          => 'lieferantenbestellungen',
 121   sales_delivery_order    => 'verkaufslieferscheine',
 122   purchase_delivery_order => 'einkaufslieferscheine',
 123   credit_note             => 'gutschriften',
 124   invoice                 => 'rechnungen',
 125   purchase_invoice        => 'einkaufsrechnungen',
 126   part                    => 'waren',
 127   service                 => 'dienstleistungen',
 128   assembly                => 'erzeugnisse',
 129   letter                  => 'briefe',
 130   general_ledger          => 'dialogbuchungen',
 131   accounts_payable        => 'kreditorenbuchungen',
 132 );
 133
 134 my %type_to_model = (
 135   sales_quotation         => 'Order',
 136   sales_order             => 'Order',
 137   request_quotation       => 'Order',
 138   purchase_order          => 'Order',
 139   sales_delivery_order    => 'DeliveryOrder',
 140   purchase_delivery_order => 'DeliveryOrder',
 141   credit_note             => 'Invoice',
 142   invoice                 => 'Invoice',
 143   purchase_invoice        => 'PurchaseInvoice',
 144   part                    => 'Part',
 145   service                 => 'Part',
 146   assembly                => 'Part',
 147   letter                  => 'Letter',
 148   general_ledger          => 'GLTransaction',
 149   accounts_payable        => 'GLTransaction',
 150 );
 151
 152 my %model_to_number = (
 153   Order           => 'ordnumber',
 154   DeliveryOrder   => 'ordnumber',
 155   Invoice         => 'invnumber',
 156   PurchaseInvoice => 'invnumber',
 157   Part            => 'partnumber',
 158   Letter          => 'letternumber',
 159   GLTransaction   => 'reference'
 160 );
 161
 162 sub webdav_path {
 163   my ($self, $dbfile) = @_;
 164
 165   #die "No webdav backend enabled" unless $::instance_conf->get_webdav;
 166
 167   my $type = $type_to_path{ $dbfile->object_type };
 168
 169   die "Unknown type" unless $type;
 170
 171   my $number = $dbfile->backend_data;
 172   if ($number eq '') {
 173     $number = $self->_get_number_from_model($dbfile);
 174     $dbfile->backend_data($number);
 175     $dbfile->save;
 176   }
 177   $main::lxdebug->message(LXDebug->DEBUG2(), "file_name=" . $dbfile->file_name ." number=".$number);
 178
 179   my @fileparts = split(/_/, $dbfile->file_name);
 180   my $number_ext = pop @fileparts;
 181   my ($maynumber, $ext) = split(/\./, $number_ext, 2);
 182   push @fileparts, $maynumber if $maynumber ne $number;
 183
 184   my $basename = join('_', @fileparts);
 185
 186   my $path = File::Spec->catdir($self->get_rootdir, "webdav", $::auth->client->{id}, $type, $number);
 187   if (!-d $path) {
 188     File::Path::make_path($path, { chmod => 0770 });
 189   }
 190   my $fname = $basename . '_' . $number . '_' . $dbfile->itime->strftime('%Y%m%d_%H%M%S');
 191   $fname .= '.' . $ext if $ext;
 192
 193   $main::lxdebug->message(LXDebug->DEBUG2(), "webdav path=" . $path . " filename=" . $fname);
 194
 195   return (File::Spec->catfile($path, $fname), $path, $fname);
 196 }
 197
 198 sub get_rootdir {
 199   my ($self) = @_;
 200
 201   #TODO immer noch das alte Problem:
 202   #je nachdem von woher der Aufruf kommt ist man in ./users oder .
 203   my $rootdir  = POSIX::getcwd();
 204   my $basename = basename($rootdir);
 205   my $dirname  = dirname($rootdir);
 206   $rootdir = $dirname if $basename eq 'users';
 207   return $rootdir;
 208 }
 209
 210 sub _get_number_from_model {
 211   my ($self, $dbfile) = @_;
 212
 213   my $class = 'SL::DB::' . $type_to_model{ $dbfile->object_type };
 214   eval "require $class";
 215   my $obj = $class->new(id => $dbfile->object_id)->load;
 216   die 'no object found' unless $obj;
 217   my $numberattr = $model_to_number{ $type_to_model{ $dbfile->object_type } };
 218   return $obj->$numberattr;
 219 }
 220
 221 #
 222 # TODO not fully imlemented and tested
 223 #
 224 sub sync_all_locations {
 225   my ($self, %params) = @_;
 226
 227   my %dateparms = (dateformat => 'yyyymmdd');
 228
 229   foreach my $type (keys %type_to_path) {
 230
 231     my @query = (
 232       file_type => $params{file_type},
 233       object_type    => $type
 234     );
 235     my @oldfiles = @{ SL::DB::Manager::File->get_all(
 236         query => [
 237           file_type => $params{file_type},
 238           object_type    => $type
 239         ]
 240       )
 241     };
 242
 243     my $path = File::Spec->catdir($self->get_rootdir, "webdav", $::auth->client->{id},$type_to_path{$type});
 244
 245     if (opendir my $dir, $path) {
 246       foreach my $file (sort { lc $a cmp lc $b }
 247         map { decode("UTF-8", $_) } readdir $dir)
 248       {
 249         next if (($file eq '.') || ($file eq '..'));
 250
 251         my $fname = $file;
 252         $fname =~ s|.*/||;
 253
 254         my ($filename, $number, $date, $time_ext) = split(/_/, $fname);
 255         my ($time, $ext) = split(/\./, $time_ext, 2);
 256
 257         $time = substr($time, 0, 2) . ':' . substr($time, 2, 2) . ':' . substr($time, 4, 2);
 258
 259         #my @found = grep { $_->backend_data eq $fname } @oldfiles;
 260         #if (scalar(@found) > 0) {
 261         #  @oldfiles = grep { $_ != @found[0] } @oldfiles;
 262         #}
 263         #else {
 264           my $dbfile = SL::DB::File->new();
 265           my $class  = 'SL::DB::Manager::' . $type_to_model{$type};
 266           my $obj =
 267             $class->find_by(
 268             $model_to_number{ $type_to_model{$type} } => $number);
 269           if ($obj) {
 270
 271             my $mime_type = File::MimeInfo::Magic::magic(File::Spec->catfile($path, $fname));
 272             if (!$mime_type) {
 273               # if filename has the suffix "pdf", but is really no pdf set mimetype for no suffix
 274               $mime_type = File::MimeInfo::Magic::mimetype($fname);
 275               $mime_type = 'application/octet-stream' if $mime_type eq 'application/pdf' || !$mime_type;
 276             }
 277
 278             $dbfile->assign_attributes(
 279               object_id   => $obj->id,
 280               object_type => $type,
 281               source      => $params{file_type} eq 'document' ? 'created' : 'uploaded',
 282               file_type   => $params{file_type},
 283               file_name   => $filename . '_' . $number . '_' . $ext,
 284               mime_type   => $mime_type,
 285               itime       => $::locale->parse_date_to_object($date . ' ' . $time, %dateparms),
 286             );
 287             $dbfile->save;
 288           }
 289         #}
 290
 291         closedir $dir;
 292       }
 293     }
 294   }
 295 }
 296
 297 1;
 298
 299 __END__
 300
 301 =pod
 302
 303 =encoding utf8
 304
 305 =head1 NAME
 306
 307 SL::File::Backend::Filesystem  - Filesystem class for file storage backend
 308
 309 =head1 SYNOPSIS
 310
 311 See the synopsis of L<SL::File::Backend>.
 312
 313 =head1 OVERVIEW
 314
 315 This specific storage backend use a Filesystem which is only accessed by this interface.
 316 This is the big difference to the Webdav backend where the files can be accessed without the control of that backend.
 317 This backend use the database id of the SL::DB::File object as filename. The filesystem has up to 1000 subdirectories
 318 to store the files not to flat in the filesystem.
 319
 320
 321 =head1 METHODS
 322
 323 See methods of L<SL::File::Backend>.
 324
 325 =head1 SEE ALSO
 326
 327 L<SL::File::Backend>
 328
 329 =head1 TODO
 330
 331 The synchronization must be tested and a periodical task is needed to synchronize in some time periods.
 332
 333 =head1 AUTHOR
 334
 335 Martin Helmling E<lt>martin.helmling@opendynamic.deE<gt>
 336
 337 =cut
 338
 339