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: " . $path unless -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 found in Backend: " . $path unless -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 $::instance_conf->get_doc_webdav;
 109 }
 110
 111 #
 112 # internals
 113 #
 114
 115 my %type_to_path = (
 116   sales_quotation         => 'angebote',
 117   sales_order             => 'bestellungen',
 118   request_quotation       => 'anfragen',
 119   purchase_order          => 'lieferantenbestellungen',
 120   sales_delivery_order    => 'verkaufslieferscheine',
 121   purchase_delivery_order => 'einkaufslieferscheine',
 122   credit_note             => 'gutschriften',
 123   invoice                 => 'rechnungen',
 124   purchase_invoice        => 'einkaufsrechnungen',
 125   part                    => 'waren',
 126   service                 => 'dienstleistungen',
 127   assembly                => 'erzeugnisse',
 128   letter                  => 'briefe',
 129   general_ledger          => 'dialogbuchungen',
 130   gl_transaction          => 'dialogbuchungen',
 131   accounts_payable        => 'kreditorenbuchungen',
 132   shop_image              => 'shopbilder',
 133   customer                => 'kunden',
 134   vendor                  => 'lieferanten',
 135 );
 136
 137 my %type_to_model = (
 138   sales_quotation         => 'Order',
 139   sales_order             => 'Order',
 140   request_quotation       => 'Order',
 141   purchase_order          => 'Order',
 142   sales_delivery_order    => 'DeliveryOrder',
 143   purchase_delivery_order => 'DeliveryOrder',
 144   credit_note             => 'Invoice',
 145   invoice                 => 'Invoice',
 146   purchase_invoice        => 'PurchaseInvoice',
 147   part                    => 'Part',
 148   service                 => 'Part',
 149   assembly                => 'Part',
 150   letter                  => 'Letter',
 151   general_ledger          => 'GLTransaction',
 152   gl_transaction          => 'GLTransaction',
 153   accounts_payable        => 'GLTransaction',
 154   shop_image              => 'Part',
 155   customer                => 'Customer',
 156   vendor                  => 'Vendor',
 157 );
 158
 159 my %model_to_number = (
 160   Order           => 'ordnumber',
 161   DeliveryOrder   => 'ordnumber',
 162   Invoice         => 'invnumber',
 163   PurchaseInvoice => 'invnumber',
 164   Part            => 'partnumber',
 165   Letter          => 'letternumber',
 166   GLTransaction   => 'reference',
 167   ShopImage       => 'partnumber',
 168   Customer        => 'customernumber',
 169   Vendor          => 'vendornumber',
 170 );
 171
 172 sub webdav_path {
 173   my ($self, $dbfile) = @_;
 174
 175   #die "No webdav backend enabled" unless $::instance_conf->get_webdav;
 176
 177   my $type = $type_to_path{ $dbfile->object_type };
 178
 179   die "Unknown type" unless $type;
 180
 181   my $number = $dbfile->backend_data;
 182   if ($number eq '') {
 183     $number = $self->_get_number_from_model($dbfile);
 184     $dbfile->backend_data($number);
 185     $dbfile->save;
 186   }
 187   $main::lxdebug->message(LXDebug->DEBUG2(), "file_name=" . $dbfile->file_name ." number=".$number);
 188
 189   my $path = File::Spec->catdir($self->get_rootdir, "webdav", $::auth->client->{id}, $type, $number);
 190   if (!-d $path) {
 191     File::Path::make_path($path, { chmod => 0770 });
 192   }
 193   # simply add the timestring before the last .
 194   # fails for .tar.gz but the number extraction algorithm failed for all
 195   # '123 Storno zu 456' cases and doubled the name like:
 196   # Rechnung_123_Storno_zu_456_202113104 Storno zu 456_20211123_113023
 197   # TODO extension should be part of the File Model (filetype)
 198   my ($filename, $ext) = split(/\.([^\.]+)$/, $dbfile->file_name);
 199   my $fname = $filename . '_' . $dbfile->itime->strftime('%Y%m%d_%H%M%S');
 200   $fname .= '.' . $ext if $ext;
 201
 202   $main::lxdebug->message(LXDebug->DEBUG2(), "webdav path=" . $path . " filename=" . $fname);
 203
 204   return (File::Spec->catfile($path, $fname), $path, $fname);
 205 }
 206
 207 sub get_rootdir {
 208   my ($self) = @_;
 209
 210   #TODO immer noch das alte Problem:
 211   #je nachdem von woher der Aufruf kommt ist man in ./users oder .
 212   my $rootdir  = POSIX::getcwd();
 213   my $basename = basename($rootdir);
 214   my $dirname  = dirname($rootdir);
 215   $rootdir = $dirname if $basename eq 'users';
 216   return $rootdir;
 217 }
 218
 219 sub _get_number_from_model {
 220   my ($self, $dbfile) = @_;
 221
 222   my $class = 'SL::DB::' . $type_to_model{ $dbfile->object_type };
 223   eval "require $class";
 224   my $obj = $class->new(id => $dbfile->object_id)->load;
 225   die 'no object found' unless $obj;
 226   my $numberattr = $model_to_number{ $type_to_model{ $dbfile->object_type } };
 227   return $obj->$numberattr;
 228 }
 229
 230 #
 231 # TODO not fully imlemented and tested
 232 #
 233 sub sync_all_locations {
 234   my ($self, %params) = @_;
 235
 236   my %dateparms = (dateformat => 'yyyymmdd');
 237
 238   foreach my $type (keys %type_to_path) {
 239
 240     my @query = (
 241       file_type => $params{file_type},
 242       object_type    => $type
 243     );
 244     my @oldfiles = @{ SL::DB::Manager::File->get_all(
 245         query => [
 246           file_type => $params{file_type},
 247           object_type    => $type
 248         ]
 249       )
 250     };
 251
 252     my $path = File::Spec->catdir($self->get_rootdir, "webdav", $::auth->client->{id},$type_to_path{$type});
 253
 254     if (opendir my $dir, $path) {
 255       foreach my $file (sort { lc $a cmp lc $b }
 256         map { decode("UTF-8", $_) } readdir $dir)
 257       {
 258         next if (($file eq '.') || ($file eq '..'));
 259
 260         my $fname = $file;
 261         $fname =~ s|.*/||;
 262
 263         my ($filename, $number, $date, $time_ext) = split(/_/, $fname);
 264         my ($time, $ext) = split(/\./, $time_ext, 2);
 265
 266         $time = substr($time, 0, 2) . ':' . substr($time, 2, 2) . ':' . substr($time, 4, 2);
 267
 268         #my @found = grep { $_->backend_data eq $fname } @oldfiles;
 269         #if (scalar(@found) > 0) {
 270         #  @oldfiles = grep { $_ != @found[0] } @oldfiles;
 271         #}
 272         #else {
 273           my $dbfile = SL::DB::File->new();
 274           my $class  = 'SL::DB::Manager::' . $type_to_model{$type};
 275           my $obj =
 276             $class->find_by(
 277             $model_to_number{ $type_to_model{$type} } => $number);
 278           if ($obj) {
 279
 280             my $mime_type = File::MimeInfo::Magic::magic(File::Spec->catfile($path, $fname));
 281             if (!$mime_type) {
 282               # if filename has the suffix "pdf", but is really no pdf set mimetype for no suffix
 283               $mime_type = File::MimeInfo::Magic::mimetype($fname);
 284               $mime_type = 'application/octet-stream' if $mime_type eq 'application/pdf' || !$mime_type;
 285             }
 286
 287             $dbfile->assign_attributes(
 288               object_id   => $obj->id,
 289               object_type => $type,
 290               source      => $params{file_type} eq 'document' ? 'created' : 'uploaded',
 291               file_type   => $params{file_type},
 292               file_name   => $filename . '_' . $number . '_' . $ext,
 293               mime_type   => $mime_type,
 294               itime       => $::locale->parse_date_to_object($date . ' ' . $time, %dateparms),
 295             );
 296             $dbfile->save;
 297           }
 298         #}
 299
 300         closedir $dir;
 301       }
 302     }
 303   }
 304 }
 305
 306 1;
 307
 308 __END__
 309
 310 =pod
 311
 312 =encoding utf8
 313
 314 =head1 NAME
 315
 316 SL::File::Backend::Filesystem  - Filesystem class for file storage backend
 317
 318 =head1 SYNOPSIS
 319
 320 See the synopsis of L<SL::File::Backend>.
 321
 322 =head1 OVERVIEW
 323
 324 This specific storage backend use a Filesystem which is only accessed by this interface.
 325 This is the big difference to the Webdav backend where the files can be accessed without the control of that backend.
 326 This backend use the database id of the SL::DB::File object as filename. The filesystem has up to 1000 subdirectories
 327 to store the files not to flat in the filesystem.
 328
 329
 330 =head1 METHODS
 331
 332 See methods of L<SL::File::Backend>.
 333
 334 =head1 SEE ALSO
 335
 336 L<SL::File::Backend>
 337
 338 =head1 TODO
 339
 340 The synchronization must be tested and a periodical task is needed to synchronize in some time periods.
 341
 342 =head1 AUTHOR
 343
 344 Martin Helmling E<lt>martin.helmling@opendynamic.deE<gt>
 345
 346 =cut
 347
 348