Revision dc6d8231
Von Sven Schöling vor mehr als 10 Jahren hinzugefügt
| SL/Webdav.pm | ||
|---|---|---|
|
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
|
||
| SL/Webdav/File.pm | ||
|---|---|---|
|
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
|
||
| SL/Webdav/Object.pm | ||
|---|---|---|
|
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
|
||
| SL/Webdav/VersionScheme/Serial.pm | ||
|---|---|---|
|
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;
|
||
| SL/Webdav/VersionScheme/Timestamp.pm | ||
|---|---|---|
|
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;
|
||
Auch abrufbar als: Unified diff
Webdav: Framework um Dokumente im Webdav zu behandeln
Soll auf lange Sicht die Funktionen in Common ablösen.