From: Sven Schöling <s.schoeling@linet-services.de>
Date: Thu, 11 Dec 2014 16:32:59 +0000 (+0100)
Subject: Webdav: Framework um Dokumente im Webdav zu behandeln
X-Git-Tag: release-3.2.0beta~190
X-Git-Url: http://wagnertech.de/git?a=commitdiff_plain;h=dc6d82312f264df3d2bf482836ff4fd2bfe3a462;p=kivitendo-erp.git

Webdav: Framework um Dokumente im Webdav zu behandeln

Soll auf lange Sicht die Funktionen in Common ablösen.
---

diff --git a/SL/Webdav.pm b/SL/Webdav.pm
new file mode 100644
index 000000000..95955127d
--- /dev/null
+++ b/SL/Webdav.pm
@@ -0,0 +1,240 @@
+package SL::Webdav;
+
+use strict;
+use parent qw(Rose::Object);
+
+use Encode qw(decode);
+use File::Spec;
+use SL::Common;
+use SL::Webdav::File;
+use SL::Webdav::Object;
+use SL::Webdav::VersionScheme::Serial;
+use SL::Webdav::VersionScheme::Timestamp;
+
+use Rose::Object::MakeMethods::Generic (
+  scalar => [ qw(type number) ],
+  'scalar --get_set_init' => [ qw(version_scheme) ],
+);
+
+my %type_to_path = (
+  sales_quotation         => 'angebote',
+  sales_order             => 'bestellungen',
+  request_quotation       => 'anfragen',
+  purchase_order          => 'lieferantenbestellungen',
+  sales_delivery_order    => 'verkaufslieferscheine',
+  purchase_delivery_order => 'einkaufslieferscheine',
+  credit_note             => 'gutschriften',
+  invoice                 => 'rechnungen',
+  purchase_invoice        => 'einkaufsrechnungen',
+  part                    => 'waren',
+  service                 => 'dienstleistungen',
+  assembly                => 'erzeugnisse',
+);
+
+sub get_all_files {
+  my ($self) = @_;
+
+  my @objects = $self->get_all_objects;
+  my %files_by_name;
+
+  for my $obj (@objects) {
+    my $filename = join '.', grep $_, $obj->basename, $obj->extension;
+
+    my $file = $files_by_name{$filename} ||= SL::Webdav::File->new(filename => $filename, webdav => $self, loaded => 1);
+    $file->add_objects($obj);
+  }
+
+  return values %files_by_name;
+}
+
+sub get_all_objects {
+  my ($self) = @_;
+
+  my $path = $self->webdav_path;
+  my @objects;
+
+  my $base_path = $ENV{'SCRIPT_NAME'};
+  $base_path =~ s|[^/]+$||;
+  if (opendir my $dir, $path) {
+    foreach my $file (sort { lc $a cmp lc $b } map { decode("UTF-8", $_) } readdir $dir) {
+      next if (($file eq '.') || ($file eq '..'));
+
+      my $fname = $file;
+      $fname  =~ s|.*/||;
+
+      push @objects, SL::Webdav::Object->new(filename => $fname, webdav => $self);
+    }
+
+    closedir $dir;
+
+    return @objects;
+  }
+}
+
+sub get_all_latest {
+  my ($self) = @_;
+
+  my @files = $self->get_all_files;
+  map { ($_->versions)[-1] } @files;
+}
+
+sub _sanitized_number {
+  my $number = $_[0]->number;
+  $number =~ s|[/\\]|_|g;
+  $number;
+}
+
+sub webdav_path {
+  my ($self) = @_;
+
+  die "No client set in \$::auth" unless $::auth->client;
+  die "Need number"               unless $self->number;
+
+  my $type = $type_to_path{$self->type};
+
+  die "Unknown type"              unless $type;
+
+  my $path = File::Spec->catdir("webdav", $::auth->client->{id}, $type, $self->_sanitized_number);
+
+  if (!-d $path) {
+    Common::mkdir_with_parents($path);
+  }
+
+  return $path;
+}
+
+sub init_version_scheme {
+  SL::Webdav::VersionScheme::Timestamp->new;
+}
+
+1;
+
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+SL::Webdav - Webdav manipulation
+
+=head1 SYNOPSIS
+
+  # get list of all documents for this record
+  use SL::Webdav;
+
+  my $webdav = SL::Webdav->new(
+    type     => 'part',
+    number   => $number,
+  );
+
+  # gives you SL::Webdav::File instances
+  my $webdav_files = $webdav->get_all_files;
+
+  # gives you the objects instead
+  my $webdav_objects = $webdav->get_all_objects;
+
+  # gives you only the latest objects
+  my $webdav_objects = $webdav->get_all_latest;
+
+  # physical path to this dir
+  my $path = $webdav->webdav_path;
+
+=head1 DESCRIPTION
+
+This module is a wrapper around the webdav storage mechanism with some simple
+document management functionality.
+
+This is not a replacement for real document management, mostly because the
+underlying webdav storage ist not fully under our control. It's common practice
+to allow people direct samba access to the webdav, so all versioning
+information need to be encoded into the filename of a file, and nonsensical
+filenames must not break assumptions.
+
+This module is intended to be used if you need to scan the folder for
+previously saved files and need to build a list to display for it.
+
+If you need to manipulate the versions of a file, see L<SL::Webdav::File>
+
+If you need to access a file directly for download or metadata, see L<SL::Webdav::Object>
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<get_all_objects>
+
+Returns all L<SL::Webdav::Objects> found.
+
+=item C<get_all_files>
+
+Returns all objects sorted into L<SL::Webdav::File>s.
+
+=item C<get_all_latest>
+
+Returns only the latest object of each L<SL::Webdav::File> found.
+
+=item C<webdav_path>
+
+Returns the physical path to this webdav object.
+
+=back
+
+=head1 VERSIONING SCHEME
+
+You may register a versioning scheme object to hangdle versioning. It is
+expected to implement the following methods:
+
+=over 4
+
+=item C<separator>
+
+Must return a string that will be used to separate basename and version part of
+filenames in generating and parsing.
+
+=item C<extract_regexp>
+
+Must return a regexp that will match a versioning string at the end of a
+filename after the extension has been stripped off. It will be surrounded by
+captures.
+
+=item C<cmp>
+
+Must return a comparison function that will be invoked with two
+L<SL::Webdav::Object> instances.
+
+=item C<first_version>
+
+Must return a string representing the version of the first of a series of objects.
+
+May return undef.
+
+=item C<next_version>
+
+Will be called with the latest L<SL::Webdav::Object> and must return a new version string.
+
+=item C<keep_last_version>
+
+Will be called with the latest L<SL::Webdav::Object>. Truish return value will
+cause the latest object to be overwritten instead of creating a new version.
+
+=back
+
+=head1 BUGS AND CAVEATS
+
+=over 4
+
+=item *
+
+File operations are inconsistently L<File::Spec>ed.
+
+=back
+
+=head1 SEE ALSO
+
+L<SL::Webdav::File>, L<SL::Webdav::Object>
+
+=head1 AUTHOR
+
+Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
+
+=cut
diff --git a/SL/Webdav/File.pm b/SL/Webdav/File.pm
new file mode 100644
index 000000000..8ad78838c
--- /dev/null
+++ b/SL/Webdav/File.pm
@@ -0,0 +1,149 @@
+package SL::Webdav::File;
+
+use strict;
+use parent qw(Rose::Object);
+
+use File::Spec;
+
+use Rose::Object::MakeMethods::Generic (
+  scalar => [ qw(webdav filename loaded) ],
+  array  => [
+    qw(objects),
+    add_objects => { interface => 'push', hash_key => 'objects' },
+  ],
+);
+
+sub versions {
+  $_[0]->load unless $_[0]->loaded;
+  my $cmp = $_[0]->webdav->version_scheme->cmp;
+  sort { $cmp->($a, $b) } $_[0]->objects;
+}
+
+sub latest_version {
+  ($_[0]->versions)[-1]
+}
+
+sub load {
+  my ($self) = @_;
+  my @objects = $self->webdav->get_all_objects;
+  my $ref = SL::Webdav::Object->new(filename => $self->filename, webdav => $self->webdav);
+  my ($ref_basename, undef, $ref_extension) = $ref->parse_filename;
+
+  $self->objects(grep { $_->basename eq $ref_basename && $_->extension eq $ref_extension } @objects);
+  $self->loaded(1);
+}
+
+sub store {
+  my ($self, %params) = @_;
+
+  $self->load unless $self->loaded;
+
+  my $last = $self->latest_version;
+  my $object;
+
+  if (!$last) {
+    my $new_version  = $self->webdav->version_scheme->first_version;
+    $object = SL::Webdav::Object->new(filename => $self->filename, webdav => $self->webdav);
+
+    $self->add_objects($object);
+  } else {
+    if (!$self->webdav->version_scheme->keep_last_version($last)) {
+      $params{new_version} = 1;
+    }
+
+    if ($params{new_version}) {
+      my $new_version  = $self->webdav->version_scheme->next_version($last);
+      my $sep          = $self->webdav->version_scheme->separator;
+      my $new_filename = $last->basename . $sep . $new_version . "." . $last->extension;
+      $object = SL::Webdav::Object->new(filename => $new_filename, webdav => $self->webdav);
+
+      $self->add_objects($object);
+    } else {
+      $object = $last;
+    }
+  }
+
+  open my $fh, '>:raw', $object->full_filedescriptor or die "could not open " . $object->filename . ": $!";
+
+  $fh->print(${ $params{data} });
+
+  close $fh;
+
+  return $object;
+}
+
+1;
+
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+SL::Webdav::File - Webdav file manipulation
+
+=head1 SYNOPSIS
+
+  use SL::Webdav::File;
+
+  my $webdav_file = SL::Webdav::File->new(
+    webdav   => $webdav,  # SL::Webdav instance
+    filename => 'technical_drawing_AB28375.pdf',
+  );
+
+  # get existing versioned files
+  my @webdav_objects = $webdav_file->versions;
+
+  # store new version
+  my $data = SL::Helper::CreatePDF->create_pdf(...);
+  my $webdav_object = $webdav_file->store(data => \$data);
+
+  # force new version
+  my $webdav_object = $webdav_file->store(data => \$data, new_version => 1);
+
+=head1 DESCRIPTION
+
+A file in this context is the collection of all versions of a single file saved
+into the webdav. This module provides methods to access and manipulate these
+objects.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<versions>
+
+Will return all L<SL::Webdav::Object>s found in this file, sorted by version
+according to the version scheme used.
+
+=item C<latest_version>
+
+Returns only the latest version object.
+
+=item C<load>
+
+Loads objects from disk.
+
+=item C<store PARAMS>
+
+Store a new version on disk. C<data> is expected to contain a reference to the
+data to be written in raw encoding.
+
+If param C<new_version> is set, force a new version, even if the versioning
+scheme would keep the old one.
+
+=back
+
+=head1 SEE ALSO
+
+L<SL::Webdav>, L<SL::Webdav::Object>
+
+=head1 BUGS
+
+None yet :)
+
+=head1 AUTHOR
+
+Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
+
+=cut
diff --git a/SL/Webdav/Object.pm b/SL/Webdav/Object.pm
new file mode 100644
index 000000000..4ecf423b5
--- /dev/null
+++ b/SL/Webdav/Object.pm
@@ -0,0 +1,165 @@
+package SL::Webdav::Object;
+
+use strict;
+use parent qw(Rose::Object);
+
+use DateTime;
+
+use Rose::Object::MakeMethods::Generic (
+  scalar => [ qw(filename webdav) ],
+  'scalar --get_set_init' => [ qw(version basename extension) ],
+);
+
+sub init_basename {
+  ($_[0]->parse_filename)[0];
+}
+
+sub init_version {
+  ($_[0]->parse_filename)[1];
+}
+
+sub init_extension {
+  ($_[0]->parse_filename)[2];
+}
+
+sub parse_filename {
+  my ($self) = @_;
+
+  my $name = $self->filename;
+  my $version_re = $self->webdav->version_scheme->extract_regexp;
+  my $sep        = $self->webdav->version_scheme->separator;
+
+  my $extension = $name =~ s/\.(\w+?)$//              ? $1 : '';
+  my $version   = $name =~ s/\Q$sep\E($version_re)$// ? $1 : '';
+  my $basename  = $name;
+
+  return ($basename, $version, $extension);
+}
+
+sub full_filedescriptor {
+  my ($self) = @_;
+
+  File::Spec->catfile($self->webdav->webdav_path, $self->filename);
+}
+
+sub atime {
+  DateTime->from_epoch(epoch => ($_[0]->stat)[8]);
+}
+
+sub mtime {
+  DateTime->from_epoch(epoch => ($_[0]->stat)[9]);
+}
+
+sub data {
+  my ($self) = @_;
+
+  open my $fh, '<:raw', $self->full_filedescriptor or die "could not open " . $self->filename . ": $!";
+
+  local $/ = undef;
+
+  my $data = <$fh>;
+
+  close $fh;
+
+  return \$data;
+}
+
+sub stat {
+  my $file = $_[0]->full_filedescriptor;
+  stat($file);
+}
+
+sub href {
+  my ($self) = @_;
+
+  my $base_path = $ENV{'SCRIPT_NAME'};
+  $base_path =~ s|[^/]+$||;
+
+  my $file         = $self->filename;
+  my $path         = $self->webdav->webdav_path;
+  my $is_directory = -d "$path/$file";
+
+  $file  = join('/', map { $::form->escape($_) } grep { $_ } split m|/+|, "$path/$file");
+  $file .=  '/' if ($is_directory);
+
+  return "$base_path/$file";
+}
+
+1;
+
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+SL::Webdav::Object - Webdav object wrapper
+
+=head1 SYNOPSIS
+
+  use SL::Webdav::Object;
+
+  my $object = SL::Webdav::Object->new(filename => $filename, webdav => $webdav);
+
+  my $data_ref  = $object->data;
+  my $mtime     = $object->mtime;
+
+  my $basename  = $object->basename;
+  my $version   = $object->version;
+  my $extension = $object->extension;
+
+  my $link      = $object->href;
+
+=head1 DESCRIPTION
+
+This is a wrapper around a single object in the webdav. These objects are
+thought about as immutable, and all manipulation will instead happen in the
+associated L<SL::Webdav::File>.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<basename>
+
+Returns the basename with version and extension stripped.
+
+=item C<version>
+
+Returns the version string.
+
+=item C<extension>
+
+Returns the extension.
+
+=item C<atime>
+
+L<DateTime> wrapped stat[8]
+
+=item C<mtime>
+
+L<DateTime> wrapped stat[9]
+
+=item C<data>
+
+Ref to the actual data in raw encoding.
+
+=item C<href>
+
+URL relative to the web base dir for download.
+
+=back
+
+=head1 SEE ALSO
+
+L<SL::Webdav>, L<SL::Webdav::File>
+
+=head1 BUGS
+
+None yet :)
+
+=head1 AUTHOR
+
+Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
+
+=cut
diff --git a/SL/Webdav/VersionScheme/Serial.pm b/SL/Webdav/VersionScheme/Serial.pm
new file mode 100644
index 000000000..fa5f5a9d7
--- /dev/null
+++ b/SL/Webdav/VersionScheme/Serial.pm
@@ -0,0 +1,28 @@
+package SL::Webdav::VersionScheme::Serial;
+
+use strict;
+use parent qw(Rose::Object);
+
+use DateTime;
+
+sub separator { "-" }
+
+sub extract_regexp { qr/\d+/ }
+
+sub cmp { sub { $_[0]->version <=> $_[1]->version } }
+
+sub first_version { }
+
+sub next_version { $_[1]->version + 1 }
+
+sub keep_last_version {
+  my ($self, $last) = @_;
+
+  if ($::lxoffice_conf->{webdav}{new_version_after_minutes}) {
+    return DateTime->now <= $last->mtime + DateTime::Duration->new(minutes => $::lx_office_conf{webdav}{new_version_after_minutes});
+  } else {
+    return 0;
+  }
+}
+
+1;
diff --git a/SL/Webdav/VersionScheme/Timestamp.pm b/SL/Webdav/VersionScheme/Timestamp.pm
new file mode 100644
index 000000000..9919b9e29
--- /dev/null
+++ b/SL/Webdav/VersionScheme/Timestamp.pm
@@ -0,0 +1,26 @@
+package SL::Webdav::VersionScheme::Timestamp;
+
+use strict;
+use parent qw(Rose::Object);
+
+use POSIX;
+
+sub separator { "_" }
+
+sub extract_regexp { qr/\d{8}_\d{6}/ }
+
+sub cmp { sub { $_[0]->version cmp $_[1]->version } }
+
+sub first_version { goto &get_current_formatted_time }
+
+sub next_version { goto &get_current_formatted_time }
+
+sub keep_last_version {
+  0;
+}
+
+sub get_current_formatted_time {
+  return POSIX::strftime('%Y%m%d_%H%M%S', localtime());
+}
+
+1;